diff options
author | Javier Miranda <miranda@adacore.com> | 2006-02-15 10:38:00 +0100 |
---|---|---|
committer | Arnaud Charlet <charlet@gcc.gnu.org> | 2006-02-15 10:38:00 +0100 |
commit | a05e99a2693109e7a2b4fffe853890946cd0320d (patch) | |
tree | 20310562d97b1530165e6f9980e07e7470bf0d34 /gcc/ada/a-tags.ads | |
parent | 80d4224f5b0b90b4f3da875043512003342d6f01 (diff) | |
download | gcc-a05e99a2693109e7a2b4fffe853890946cd0320d.zip gcc-a05e99a2693109e7a2b4fffe853890946cd0320d.tar.gz gcc-a05e99a2693109e7a2b4fffe853890946cd0320d.tar.bz2 |
exp_ch3.adb (Component_Needs_Simple_Initialization): Add check for availability of RE_Interface_Tag.
2006-02-13 Javier Miranda <miranda@adacore.com>
Gary Dismukes <dismukes@adacore.com>
* exp_ch3.adb (Component_Needs_Simple_Initialization): Add check for
availability of RE_Interface_Tag.
(Build_Initialization_Call): Fix wrong access to the discriminant value.
(Freeze_Record_Type): Do not generate the tables associated with
timed and conditional dispatching calls through synchronized
interfaces if compiling under No_Dispatching_Calls restriction.
When compiling for Ada 2005, for a nonabstract
type with a null extension, call Make_Controlling_Function_Wrappers
and insert the wrapper function declarations and bodies (the latter
being appended as freeze actions).
(Predefined_Primitive_Bodies): Do not generate the bodies of the
predefined primitives associated with timed and conditional
dispatching calls through synchronized interfaces if we are
compiling under No_Dispatching_Calls.
(Build_Init_Procedure): Use RTE_Available to check if a run-time
service is available before generating a call.
(Make_Controlling_Function_Wrappers): New procedure.
(Expand_N_Full_Type_Declaration): Create a class-wide master for
access-to-limited-interfaces because they can be used to reference
tasks that implement such limited interface.
(Build_Offset_To_Top_Functions): Build the tree corresponding to the
procedure spec and body of the Offset_To_Top function that is generated
when the parent of a type with discriminants has secondary dispatch
tables.
(Init_Secondary_Tags): Handle the case in which the parent of the type
containing secondary dispatch tables has discriminants to generate the
correct arguments to call Set_Offset_To_Top.
(Build_Record_Init_Proc): Add call to Build_Offset_To_Top_Functions.
* a-tags.ads, a-tags.adb: (Check_Index): Removed.
Add Wide_[Wide_]Expanded_Name.
(Get_Predefined_Prim_Op_Address): New subprogram that provides exactly
the same functionality of Get_Prim_Op_Address but applied to predefined
primitive operations because the pointers to the predefined primitives
are now saved in a separate table.
(Parent_Size): Modified to get access to the separate table of primitive
operations or the parent type.
(Set_Predefined_Prim_Op_Address): New subprogram that provides the same
functionality of Set_Prim_Op_Address but applied to predefined primitive
operations.
(Set_Signature): New subprogram used to store the signature of a DT.
(Displace): If the Offset_To_Top value is not static then call the
function generated by the expander to get such value; otherwise use
the value stored in the table of interfaces.
(Offset_To_Top): The type of the actual has been changed to Address to
give the correct support to tagged types with discriminants. In this
case this value is stored just immediately after the tag field.
(Set_Offset_To_Top): Two new formals have been added to indicate if the
offset_to_top value is static and hence pass this value to the run-time
to store it in the table of interfaces, or else if this value is dynamic
and then pass to the run-time the address of a function that is
generated by the expander to provide this value for each object of the
type.
* rtsfind.ads (Default_Prin_Op_Count): Removed.
(Default_Prim_Op_Count): New entity
(Get_Predefined_Prim_Op_Address): New entity
(Set_Predefined_Prim_Op_Address): New entity
(RE_Set_Signature): New entity
From-SVN: r111059
Diffstat (limited to 'gcc/ada/a-tags.ads')
-rw-r--r-- | gcc/ada/a-tags.ads | 120 |
1 files changed, 86 insertions, 34 deletions
diff --git a/gcc/ada/a-tags.ads b/gcc/ada/a-tags.ads index 25fed4f..bb69544 100644 --- a/gcc/ada/a-tags.ads +++ b/gcc/ada/a-tags.ads @@ -68,6 +68,12 @@ package Ada.Tags is Tag_Error : exception; + function Wide_Expanded_Name (T : Tag) return Wide_String; + pragma Ada_05 (Wide_Expanded_Name); + + function Wide_Wide_Expanded_Name (T : Tag) return Wide_Wide_String; + pragma Ada_05 (Wide_Wide_Expanded_Name); + private -- The following subprogram specifications are placed here instead of -- the package body to see them from the frontend through rtsfind. @@ -151,11 +157,25 @@ private Default_Prim_Op_Count : constant Positive := 15; -- Number of predefined primitive operations added by the Expander for a - -- tagged type. It is utilized for indexing in the two auxiliary tables - -- used for dispatching asynchronous, conditional and timed selects. In - -- order to be space efficient, indexing is performed by subtracting this - -- constant value from the provided position in the auxiliary tables (must - -- match Exp_Disp.Default_Prim_Op_Count). + -- tagged type (must match Exp_Disp.Default_Prim_Op_Count). + + type Signature_Kind is + (Unknown, + Valid_Signature, + Primary_DT, + Secondary_DT, + Abstract_Interface); + for Signature_Kind'Size use 8; + -- Kind of signature found in the header of the dispatch table. These + -- signatures are generated by the frontend and are used by the Check_XXX + -- routines to ensure that the kind of dispatch table managed by each of + -- the routines in this package is correct. This additional check is only + -- performed with this run-time package is compiled with assertions enabled + + -- The signature is a sequence of two bytes. The first byte must have the + -- value Valid_Signature, and the second byte must have a value in the + -- range Primary_DT .. Abstract_Interface. The Unknown value is used by + -- the Check_XXX routines to indicate that the signature is wrong. package SSE renames System.Storage_Elements; @@ -200,6 +220,13 @@ private -- operation in the DT, retrieve the corresponding operation's position in -- the primary dispatch table from the Offset Specific Data table of T. + function Get_Predefined_Prim_Op_Address + (T : Tag; + Position : Positive) return System.Address; + -- Given a pointer to a dispatch table (T) and a position in the DT + -- this function returns the address of the virtual function stored + -- in it (used for dispatching calls). + function Get_Prim_Op_Address (T : Tag; Position : Positive) return System.Address; @@ -239,9 +266,11 @@ private -- Initialize the TSD of a type knowing the tag of the direct ancestor function Offset_To_Top - (T : Tag) return System.Storage_Elements.Storage_Offset; + (This : System.Address) return System.Storage_Elements.Storage_Offset; -- Returns the current value of the offset_to_top component available in - -- the prologue of the dispatch table. + -- the prologue of the dispatch table. If the parent of the tagged type + -- has discriminants this value is stored in a record component just + -- immediately after the tag component. function OSD (T : Tag) return Object_Specific_Data_Ptr; -- Ada 2005 (AI-251): Given a pointer T to a secondary dispatch table, @@ -305,7 +334,9 @@ private procedure Set_Offset_To_Top (This : System.Address; Interface_T : Tag; - Offset_Value : System.Storage_Elements.Storage_Offset); + Is_Static : Boolean; + Offset_Value : System.Storage_Elements.Storage_Offset; + Offset_Func : System.Address); -- Ada 2005 (AI-251): Initialize the Offset_To_Top field in the prologue of -- the dispatch table. In primary dispatch tables the value of "This" is -- not required (and the compiler passes always the Null_Address value) and @@ -319,6 +350,14 @@ private -- Given a pointer T to a secondary dispatch table, store the pointer to -- the record containing the Object Specific Data generated by GNAT. + procedure Set_Predefined_Prim_Op_Address + (T : Tag; + Position : Positive; + Value : System.Address); + -- Given a pointer to a dispatch Table (T) and a position in the dispatch + -- table associated with a predefined primitive operation, put the address + -- of the virtual function in it (used for overriding). + procedure Set_Prim_Op_Address (T : Tag; Position : Positive; @@ -342,6 +381,9 @@ private -- Set to true if the type has been declared in a context described -- in E.4 (18). + procedure Set_Signature (T : Tag; Value : Signature_Kind); + -- Given a pointer T to a dispatch table, store the signature id + procedure Set_SSD (T : Tag; Value : System.Address); -- Given a pointer T to a dispatch Table, stores the pointer to the record -- containing the Select Specific Data generated by GNAT. @@ -363,11 +405,15 @@ private -- record containing the Type Specific Data generated by GNAT. DT_Prologue_Size : constant SSE.Storage_Count := - SSE.Storage_Count (4 * (Standard'Address_Size / System.Storage_Unit)); - -- Size of the first part of the dispatch table + SSE.Storage_Count + ((Default_Prim_Op_Count + 4) * + (Standard'Address_Size / System.Storage_Unit)); + -- Size of the hidden part of the dispatch table. It contains the table of + -- predefined primitive operations plus the C++ ABI header. DT_Signature_Size : constant SSE.Storage_Count := - SSE.Storage_Count (1 * (Standard'Address_Size / System.Storage_Unit)); + SSE.Storage_Count + (1 * (Standard'Address_Size / System.Storage_Unit)); -- Size of the Signature field of the dispatch table DT_Tagged_Kind_Size : constant SSE.Storage_Count := @@ -375,23 +421,35 @@ private -- Size of the Tagged_Type_Kind field of the dispatch table DT_Offset_To_Top_Size : constant SSE.Storage_Count := - SSE.Storage_Count (1 * (Standard'Address_Size / System.Storage_Unit)); + SSE.Storage_Count + (1 * (Standard'Address_Size / + System.Storage_Unit)); -- Size of the Offset_To_Top field of the Dispatch Table DT_Typeinfo_Ptr_Size : constant SSE.Storage_Count := - SSE.Storage_Count (1 * (Standard'Address_Size / System.Storage_Unit)); + SSE.Storage_Count + (1 * (Standard'Address_Size / + System.Storage_Unit)); -- Size of the Typeinfo_Ptr field of the Dispatch Table DT_Entry_Size : constant SSE.Storage_Count := - SSE.Storage_Count (1 * (Standard'Address_Size / System.Storage_Unit)); + SSE.Storage_Count + (1 * (Standard'Address_Size / System.Storage_Unit)); -- Size of each primitive operation entry in the Dispatch Table + Tag_Size : constant SSE.Storage_Count := + SSE.Storage_Count (1 * (Standard'Address_Size / System.Storage_Unit)); + -- Size of each tag + TSD_Prologue_Size : constant SSE.Storage_Count := - SSE.Storage_Count (10 * (Standard'Address_Size / System.Storage_Unit)); + SSE.Storage_Count + (10 * (Standard'Address_Size / + System.Storage_Unit)); -- Size of the first part of the type specific data TSD_Entry_Size : constant SSE.Storage_Count := - SSE.Storage_Count (1 * (Standard'Address_Size / System.Storage_Unit)); + SSE.Storage_Count + (1 * (Standard'Address_Size / System.Storage_Unit)); -- Size of each ancestor tag entry in the TSD type Address_Array is array (Natural range <>) of System.Address; @@ -400,24 +458,6 @@ private -- of this type are declared with a dummy size of 1, the actual size -- depending on the number of primitive operations. - type Signature_Kind is - (Unknown, - Valid_Signature, - Primary_DT, - Secondary_DT, - Abstract_Interface); - for Signature_Kind'Size use 8; - -- Kind of signature found in the header of the dispatch table. These - -- signatures are generated by the frontend and are used by the Check_XXX - -- routines to ensure that the kind of dispatch table managed by each of - -- the routines in this package is correct. This additional check is only - -- performed with this run-time package is compiled with assertions enabled - - -- The signature is a sequence of two bytes. The first byte must have the - -- value Valid_Signature, and the second byte must have a value in the - -- range Primary_DT .. Abstract_Interface. The Unknown value is used by - -- the Check_XXX routines to indicate that the signature is wrong. - -- Unchecked Conversions type Addr_Ptr is access System.Address; @@ -427,6 +467,8 @@ private array (1 .. DT_Signature_Size) of Signature_Kind; -- Type used to see the signature as a sequence of Signature_Kind values + type Signature_Values_Ptr is access all Signature_Values; + function To_Addr_Ptr is new Unchecked_Conversion (System.Address, Addr_Ptr); @@ -455,6 +497,13 @@ private new Unchecked_Conversion (System.Storage_Elements.Storage_Offset, Signature_Values); + function To_Signature_Values_Ptr is + new Unchecked_Conversion (System.Address, + Signature_Values_Ptr); + + function To_Tag is + new Unchecked_Conversion (System.Address, Tag); + function To_Tag_Ptr is new Unchecked_Conversion (System.Address, Tag_Ptr); @@ -470,6 +519,7 @@ private pragma Inline_Always (Get_Access_Level); pragma Inline_Always (Get_Entry_Index); pragma Inline_Always (Get_Offset_Index); + pragma Inline_Always (Get_Predefined_Prim_Op_Address); pragma Inline_Always (Get_Prim_Op_Address); pragma Inline_Always (Get_Prim_Op_Kind); pragma Inline_Always (Get_RC_Offset); @@ -488,10 +538,12 @@ private pragma Inline_Always (Set_Num_Prim_Ops); pragma Inline_Always (Set_Offset_Index); pragma Inline_Always (Set_Offset_To_Top); + pragma Inline_Always (Set_Predefined_Prim_Op_Address); pragma Inline_Always (Set_Prim_Op_Address); pragma Inline_Always (Set_Prim_Op_Kind); pragma Inline_Always (Set_RC_Offset); pragma Inline_Always (Set_Remotely_Callable); + pragma Inline_Always (Set_Signature); pragma Inline_Always (Set_OSD); pragma Inline_Always (Set_SSD); pragma Inline_Always (Set_TSD); |