------------------------------------------------------------------------------ -- -- -- GNAT RUN-TIME COMPONENTS -- -- -- -- A D A . T A G S -- -- -- -- S p e c -- -- -- -- Copyright (C) 1992-2009, Free Software Foundation, Inc. -- -- -- -- This specification is derived from the Ada Reference Manual for use with -- -- GNAT. The copyright notice above, and the license provisions that follow -- -- apply solely to the contents of the part following the private keyword. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- -- ware Foundation; either version 3, or (at your option) any later ver- -- -- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- -- or FITNESS FOR A PARTICULAR PURPOSE. -- -- -- -- As a special exception under Section 7 of GPL version 3, you are granted -- -- additional permissions described in the GCC Runtime Library Exception, -- -- version 3.1, as published by the Free Software Foundation. -- -- -- -- You should have received a copy of the GNU General Public License and -- -- a copy of the GCC Runtime Library Exception along with this program; -- -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- -- . -- -- -- -- GNAT was originally developed by the GNAT team at New York University. -- -- Extensive contributions were provided by Ada Core Technologies Inc. -- -- -- ------------------------------------------------------------------------------ with System; with System.Storage_Elements; package Ada.Tags is pragma Preelaborate_05; -- In accordance with Ada 2005 AI-362 type Tag is private; pragma Preelaborable_Initialization (Tag); No_Tag : constant Tag; function Expanded_Name (T : Tag) return String; 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); function External_Tag (T : Tag) return String; function Internal_Tag (External : String) return Tag; function Descendant_Tag (External : String; Ancestor : Tag) return Tag; pragma Ada_05 (Descendant_Tag); function Is_Descendant_At_Same_Level (Descendant : Tag; Ancestor : Tag) return Boolean; pragma Ada_05 (Is_Descendant_At_Same_Level); function Parent_Tag (T : Tag) return Tag; pragma Ada_05 (Parent_Tag); type Tag_Array is array (Positive range <>) of Tag; function Interface_Ancestor_Tags (T : Tag) return Tag_Array; pragma Ada_05 (Interface_Ancestor_Tags); Tag_Error : exception; private -- Structure of the GNAT Primary Dispatch Table -- +--------------------+ -- | Signature | -- +--------------------+ -- | Tagged_Kind | -- +--------------------+ Predef Prims -- | Predef_Prims -----------------------------> +------------+ -- +--------------------+ | table of | -- | Offset_To_Top | | predefined | -- +--------------------+ | primitives | -- |Typeinfo_Ptr/TSD_Ptr---> Type Specific Data +------------+ -- Tag ---> +--------------------+ +-------------------+ -- | table of | | inheritance depth | -- : primitive ops : +-------------------+ -- | pointers | | access level | -- +--------------------+ +-------------------+ -- | expanded name | -- +-------------------+ -- | external tag | -- +-------------------+ -- | hash table link | -- +-------------------+ -- | remotely callable | -- +-------------------+ -- | rec ctrler offset | -- +-------------------+ -- | Ifaces_Table ---> Interface Data -- +-------------------+ +------------+ -- Select Specific Data <---- SSD | | Nb_Ifaces | -- +------------------+ +-------------------+ +------------+ -- |table of primitive| | table of | | table | -- : operation : : ancestor : : of : -- | kinds | | tags | | interfaces | -- +------------------+ +-------------------+ +------------+ -- |table of | -- : entry : -- | indices | -- +------------------+ -- Structure of the GNAT Secondary Dispatch Table -- +--------------------+ -- | Signature | -- +--------------------+ -- | Tagged_Kind | -- +--------------------+ Predef Prims -- | Predef_Prims -----------------------------> +------------+ -- +--------------------+ | table of | -- | Offset_To_Top | | predefined | -- +--------------------+ | primitives | -- | OSD_Ptr |---> Object Specific Data | thunks | -- Tag ---> +--------------------+ +---------------+ +------------+ -- | table of | | num prim ops | -- : primitive op : +---------------+ -- | thunk pointers | | table of | -- +--------------------+ + primitive | -- | op offsets | -- +---------------+ -- The runtime information kept for each tagged type is separated into two -- objects: the Dispatch Table and the Type Specific Data record. package SSE renames System.Storage_Elements; subtype Cstring is String (Positive); type Cstring_Ptr is access all Cstring; pragma No_Strict_Aliasing (Cstring_Ptr); -- Declarations for the table of interfaces type Offset_To_Top_Function_Ptr is access function (This : System.Address) return SSE.Storage_Offset; -- Type definition used to call the function that is generated by the -- expander in case of tagged types with discriminants that have secondary -- dispatch tables. This function provides the Offset_To_Top value in this -- specific case. type Interface_Data_Element is record Iface_Tag : Tag; Static_Offset_To_Top : Boolean; Offset_To_Top_Value : SSE.Storage_Offset; Offset_To_Top_Func : Offset_To_Top_Function_Ptr; Secondary_DT : Tag; end record; -- If some ancestor of the tagged type has discriminants the field -- Static_Offset_To_Top is False and the field Offset_To_Top_Func -- is used to store the access to the function generated by the -- expander which provides this value; otherwise Static_Offset_To_Top -- is True and such value is stored in the Offset_To_Top_Value field. -- Secondary_DT references a secondary dispatch table whose contents -- are pointers to the primitives of the tagged type that cover the -- interface primitives. Secondary_DT gives support to dispatching -- calls through interface types associated with Generic Dispatching -- Constructors. type Interfaces_Array is array (Natural range <>) of Interface_Data_Element; type Interface_Data (Nb_Ifaces : Positive) is record Ifaces_Table : Interfaces_Array (1 .. Nb_Ifaces); end record; type Interface_Data_Ptr is access all Interface_Data; -- Table of abstract interfaces used to give support to backward interface -- conversions and also to IW_Membership. -- Primitive operation kinds. These values differentiate the kinds of -- callable entities stored in the dispatch table. Certain kinds may -- not be used, but are added for completeness. type Prim_Op_Kind is (POK_Function, POK_Procedure, POK_Protected_Entry, POK_Protected_Function, POK_Protected_Procedure, POK_Task_Entry, POK_Task_Function, POK_Task_Procedure); -- Select specific data types type Select_Specific_Data_Element is record Index : Positive; Kind : Prim_Op_Kind; end record; type Select_Specific_Data_Array is array (Positive range <>) of Select_Specific_Data_Element; type Select_Specific_Data (Nb_Prim : Positive) is record SSD_Table : Select_Specific_Data_Array (1 .. Nb_Prim); -- NOTE: Nb_Prim is the number of non-predefined primitive operations end record; type Select_Specific_Data_Ptr is access all Select_Specific_Data; -- A table used to store the primitive operation kind and entry index of -- primitive subprograms of a type that implements a limited interface. -- The Select Specific Data table resides in the Type Specific Data of a -- type. This construct is used in the handling of dispatching triggers -- in select statements. type Prim_Ptr is access procedure; type Address_Array is array (Positive range <>) of Prim_Ptr; subtype Dispatch_Table is Address_Array (1 .. 1); -- Used by GDB to identify the _tags and traverse the run-time structure -- associated with tagged types. For compatibility with older versions of -- gdb, its name must not be changed. type Tag is access all Dispatch_Table; pragma No_Strict_Aliasing (Tag); type Interface_Tag is access all Dispatch_Table; No_Tag : constant Tag := null; -- The expander ensures that Tag objects reference the Prims_Ptr component -- of the wrapper. type Tag_Ptr is access all Tag; pragma No_Strict_Aliasing (Tag_Ptr); type Offset_To_Top_Ptr is access all SSE.Storage_Offset; pragma No_Strict_Aliasing (Offset_To_Top_Ptr); type Tag_Table is array (Natural range <>) of Tag; type Size_Ptr is access function (A : System.Address) return Long_Long_Integer; type Type_Specific_Data (Idepth : Natural) is record -- The discriminant Idepth is the Inheritance Depth Level: Used to -- implement the membership test associated with single inheritance of -- tagged types in constant-time. It also indicates the size of the -- Tags_Table component. Access_Level : Natural; -- Accessibility level required to give support to Ada 2005 nested type -- extensions. This feature allows safe nested type extensions by -- shifting the accessibility checks to certain operations, rather than -- being enforced at the type declaration. In particular, by performing -- run-time accessibility checks on class-wide allocators, class-wide -- function return, and class-wide stream I/O, the danger of objects -- outliving their type declaration can be eliminated (Ada 2005: AI-344) Expanded_Name : Cstring_Ptr; External_Tag : Cstring_Ptr; HT_Link : Tag_Ptr; -- Components used to support to the Ada.Tags subprograms in RM 3.9 -- Note: Expanded_Name is referenced by GDB to determine the actual name -- of the tagged type. Its requirements are: 1) it must have this exact -- name, and 2) its contents must point to a C-style Nul terminated -- string containing its expanded name. GDB has no requirement on a -- given position inside the record. Transportable : Boolean; -- Used to check RM E.4(18), set for types that satisfy the requirements -- for being used in remote calls as actuals for classwide formals or as -- return values for classwide functions. RC_Offset : SSE.Storage_Offset; -- Controller Offset: Used to give support to tagged controlled objects -- (see Get_Deep_Controller at s-finimp) Size_Func : Size_Ptr; -- Pointer to the subprogram computing the _size of the object. Used by -- the run-time whenever a call to the 'size primitive is required. We -- cannot assume that the contents of dispatch tables are addresses -- because in some architectures the ABI allows descriptors. Interfaces_Table : Interface_Data_Ptr; -- Pointer to the table of interface tags. It is used to implement the -- membership test associated with interfaces and also for backward -- abstract interface type conversions (Ada 2005:AI-251) SSD : Select_Specific_Data_Ptr; -- Pointer to a table of records used in dispatching selects. This -- field has a meaningful value for all tagged types that implement -- a limited, protected, synchronized or task interfaces and have -- non-predefined primitive operations. Tags_Table : Tag_Table (0 .. Idepth); -- Table of ancestor tags. Its size actually depends on the inheritance -- depth level of the tagged type. end record; type Type_Specific_Data_Ptr is access all Type_Specific_Data; pragma No_Strict_Aliasing (Type_Specific_Data_Ptr); -- Declarations for the dispatch table record type Signature_Kind is (Unknown, Primary_DT, Secondary_DT); -- Tagged type kinds with respect to concurrency and limitedness type Tagged_Kind is (TK_Abstract_Limited_Tagged, TK_Abstract_Tagged, TK_Limited_Tagged, TK_Protected, TK_Tagged, TK_Task); type Dispatch_Table_Wrapper (Num_Prims : Natural) is record Signature : Signature_Kind; Tag_Kind : Tagged_Kind; Predef_Prims : System.Address; -- Pointer to the dispatch table of predefined Ada primitives -- According to the C++ ABI the components Offset_To_Top and TSD are -- stored just "before" the dispatch table, and they are referenced with -- negative offsets referring to the base of the dispatch table. The -- _Tag (or the VTable_Ptr in C++ terminology) must point to the base -- of the virtual table, just after these components, to point to the -- Prims_Ptr table. Offset_To_Top : SSE.Storage_Offset; TSD : System.Address; Prims_Ptr : aliased Address_Array (1 .. Num_Prims); -- The size of the Prims_Ptr array actually depends on the tagged type -- to which it applies. For each tagged type, the expander computes the -- actual array size, allocates the Dispatch_Table record accordingly. end record; type Dispatch_Table_Ptr is access all Dispatch_Table_Wrapper; pragma No_Strict_Aliasing (Dispatch_Table_Ptr); -- The following type declaration is used by the compiler when the program -- is compiled with restriction No_Dispatching_Calls. It is also used with -- interface types to generate the tag and run-time information associated -- with them. type No_Dispatch_Table_Wrapper is record NDT_TSD : System.Address; NDT_Prims_Ptr : Natural; end record; DT_Predef_Prims_Size : constant SSE.Storage_Count := SSE.Storage_Count (1 * (Standard'Address_Size / System.Storage_Unit)); -- Size of the Predef_Prims field of the Dispatch_Table DT_Offset_To_Top_Size : constant SSE.Storage_Count := 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)); -- Size of the Typeinfo_Ptr field of the Dispatch Table use type System.Storage_Elements.Storage_Offset; DT_Offset_To_Top_Offset : constant SSE.Storage_Count := DT_Typeinfo_Ptr_Size + DT_Offset_To_Top_Size; DT_Predef_Prims_Offset : constant SSE.Storage_Count := DT_Typeinfo_Ptr_Size + DT_Offset_To_Top_Size + DT_Predef_Prims_Size; -- Offset from Prims_Ptr to Predef_Prims component -- Object Specific Data record of secondary dispatch tables type Object_Specific_Data_Array is array (Positive range <>) of Positive; type Object_Specific_Data (OSD_Num_Prims : Positive) is record OSD_Table : Object_Specific_Data_Array (1 .. OSD_Num_Prims); -- Table used in secondary DT to reference their counterpart in the -- select specific data (in the TSD of the primary DT). This construct -- is used in the handling of dispatching triggers in select statements. -- Nb_Prim is the number of non-predefined primitive operations. end record; type Object_Specific_Data_Ptr is access all Object_Specific_Data; pragma No_Strict_Aliasing (Object_Specific_Data_Ptr); -- The following subprogram specifications are placed here instead of -- the package body to see them from the frontend through rtsfind. function Base_Address (This : System.Address) return System.Address; -- Ada 2005 (AI-251): Displace "This" to point to the base address of -- the object (that is, the address of the primary tag of the object). function Displace (This : System.Address; T : Tag) return System.Address; -- Ada 2005 (AI-251): Displace "This" to point to the secondary dispatch -- table of T. function Secondary_Tag (T, Iface : Tag) return Tag; -- Ada 2005 (AI-251): Given a primary tag T associated with a tagged type -- Typ, search for the secondary tag of the interface type Iface covered -- by Typ. function DT (T : Tag) return Dispatch_Table_Ptr; -- Return the pointer to the TSD record associated with T function Get_Entry_Index (T : Tag; Position : Positive) return Positive; -- Ada 2005 (AI-251): Return a primitive operation's entry index (if entry) -- given a dispatch table T and a position of a primitive operation in T. function Get_Offset_Index (T : Tag; Position : Positive) return Positive; -- Ada 2005 (AI-251): Given a pointer to a secondary dispatch table (T) and -- a position of an 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_Prim_Op_Kind (T : Tag; Position : Positive) return Prim_Op_Kind; -- Ada 2005 (AI-251): Return a primitive operation's kind given a dispatch -- table T and a position of a primitive operation in T. function Get_RC_Offset (T : Tag) return SSE.Storage_Offset; -- Return the Offset of the implicit record controller when the object -- has controlled components, returns zero if no controlled components. pragma Export (Ada, Get_RC_Offset, "ada__tags__get_rc_offset"); -- This procedure is used in s-finimp to compute the deep routines -- it is exported manually in order to avoid changing completely the -- organization of the run time. function Get_Tagged_Kind (T : Tag) return Tagged_Kind; -- Ada 2005 (AI-345): Given a pointer to either a primary or a secondary -- dispatch table, return the tagged kind of a type in the context of -- concurrency and limitedness. function IW_Membership (This : System.Address; T : Tag) return Boolean; -- Ada 2005 (AI-251): General routine that checks if a given object -- implements a tagged type. Its common usage is to check if Obj is in -- Iface'Class, but it is also used to check if a class-wide interface -- implements a given type (Iface_CW_Typ in T'Class). For example: -- -- type I is interface; -- type T is tagged ... -- -- function Test (O : I'Class) is -- begin -- return O in T'Class. -- end Test; function Offset_To_Top (This : System.Address) return SSE.Storage_Offset; -- Ada 2005 (AI-251): Returns the current value of the offset_to_top -- component available in 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 Parent_Size (Obj : System.Address; T : Tag) return SSE.Storage_Count; -- Computes the size the ancestor part of a tagged extension object whose -- address is 'obj' by calling indirectly the ancestor _size function. The -- ancestor is the parent of the type represented by tag T. This function -- assumes that _size is always in slot one of the dispatch table. pragma Export (Ada, Parent_Size, "ada__tags__parent_size"); -- This procedure is used in s-finimp and is thus exported manually procedure Register_Interface_Offset (This : System.Address; Interface_T : Tag; Is_Static : Boolean; Offset_Value : SSE.Storage_Offset; Offset_Func : Offset_To_Top_Function_Ptr); -- Register in the table of interfaces of the tagged type associated with -- "This" object the offset of the record component associated with the -- progenitor Interface_T (that is, the distance from "This" to the object -- component containing the tag of the secondary dispatch table). In case -- of constant offset, Is_Static is true and Offset_Value has such value. -- In case of variable offset, Is_Static is false and Offset_Func is an -- access to function that must be called to evaluate the offset. procedure Register_Tag (T : Tag); -- Insert the Tag and its associated external_tag in a table for the -- sake of Internal_Tag procedure Set_Dynamic_Offset_To_Top (This : System.Address; Interface_T : Tag; Offset_Value : SSE.Storage_Offset; Offset_Func : Offset_To_Top_Function_Ptr); -- Ada 2005 (AI-251): The compiler generates calls to this routine only -- when initializing the Offset_To_Top field of dispatch tables associated -- with tagged type whose parent has variable size components. "This" is -- the object whose dispatch table is being initialized. Interface_T is the -- interface for which the secondary dispatch table is being initialized, -- and Offset_Value is the distance from "This" to the object component -- containing the tag of the secondary dispatch table (a zero value means -- that this interface shares the primary dispatch table). Offset_Func -- references a function that must be called to evaluate the offset at -- runtime. This routine also takes care of registering these values in -- the table of interfaces of the type. procedure Set_Entry_Index (T : Tag; Position : Positive; Value : Positive); -- Ada 2005 (AI-345): Set the entry index of a primitive operation in T's -- TSD table indexed by Position. procedure Set_Prim_Op_Kind (T : Tag; Position : Positive; Value : Prim_Op_Kind); -- Ada 2005 (AI-251): Set the kind of a primitive operation in T's TSD -- table indexed by Position. Max_Predef_Prims : constant Positive := 16; -- Number of reserved slots for the following predefined ada primitives: -- -- 1. Size -- 2. Alignment, -- 3. Read -- 4. Write -- 5. Input -- 6. Output -- 7. "=" -- 8. assignment -- 9. deep adjust -- 10. deep finalize -- 11. async select -- 12. conditional select -- 13. prim_op kind -- 14. task_id -- 15. dispatching requeue -- 16. timed select -- -- The compiler checks that the value here is correct subtype Predef_Prims_Table is Address_Array (1 .. Max_Predef_Prims); type Predef_Prims_Table_Ptr is access Predef_Prims_Table; pragma No_Strict_Aliasing (Predef_Prims_Table_Ptr); type Addr_Ptr is access System.Address; pragma No_Strict_Aliasing (Addr_Ptr); -- This type is used by the frontend to generate the code that handles -- dispatch table slots of types declared at the local level. end Ada.Tags;