1 ------------------------------------------------------------------------------
3 -- GNAT RUN-TIME COMPONENTS --
9 -- Copyright (C) 1992-2008, Free Software Foundation, Inc. --
11 -- This specification is derived from the Ada Reference Manual for use with --
12 -- GNAT. The copyright notice above, and the license provisions that follow --
13 -- apply solely to the contents of the part following the private keyword. --
15 -- GNAT is free software; you can redistribute it and/or modify it under --
16 -- terms of the GNU General Public License as published by the Free Soft- --
17 -- ware Foundation; either version 2, or (at your option) any later ver- --
18 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
19 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
20 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
21 -- for more details. You should have received a copy of the GNU General --
22 -- Public License distributed with GNAT; see file COPYING. If not, write --
23 -- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
24 -- Boston, MA 02110-1301, USA. --
26 -- As a special exception, if other files instantiate generics from this --
27 -- unit, or you link this unit with other files to produce an executable, --
28 -- this unit does not by itself cause the resulting executable to be --
29 -- covered by the GNU General Public License. This exception does not --
30 -- however invalidate any other reasons why the executable file might be --
31 -- covered by the GNU Public License. --
33 -- GNAT was originally developed by the GNAT team at New York University. --
34 -- Extensive contributions were provided by Ada Core Technologies Inc. --
36 ------------------------------------------------------------------------------
39 with System.Storage_Elements;
42 pragma Preelaborate_05;
43 -- In accordance with Ada 2005 AI-362
46 pragma Preelaborable_Initialization (Tag);
48 No_Tag : constant Tag;
50 function Expanded_Name (T : Tag) return String;
52 function Wide_Expanded_Name (T : Tag) return Wide_String;
53 pragma Ada_05 (Wide_Expanded_Name);
55 function Wide_Wide_Expanded_Name (T : Tag) return Wide_Wide_String;
56 pragma Ada_05 (Wide_Wide_Expanded_Name);
58 function External_Tag (T : Tag) return String;
60 function Internal_Tag (External : String) return Tag;
62 function Descendant_Tag
64 Ancestor : Tag) return Tag;
65 pragma Ada_05 (Descendant_Tag);
67 function Is_Descendant_At_Same_Level
69 Ancestor : Tag) return Boolean;
70 pragma Ada_05 (Is_Descendant_At_Same_Level);
72 function Parent_Tag (T : Tag) return Tag;
73 pragma Ada_05 (Parent_Tag);
75 type Tag_Array is array (Positive range <>) of Tag;
77 function Interface_Ancestor_Tags (T : Tag) return Tag_Array;
78 pragma Ada_05 (Interface_Ancestor_Tags);
80 Tag_Error : exception;
83 -- Structure of the GNAT Primary Dispatch Table
85 -- +--------------------+
87 -- +--------------------+
89 -- +--------------------+ Predef Prims
90 -- | Predef_Prims -----------------------------> +------------+
91 -- +--------------------+ | table of |
92 -- | Offset_To_Top | | predefined |
93 -- +--------------------+ | primitives |
94 -- |Typeinfo_Ptr/TSD_Ptr---> Type Specific Data +------------+
95 -- Tag ---> +--------------------+ +-------------------+
96 -- | table of | | inheritance depth |
97 -- : primitive ops : +-------------------+
98 -- | pointers | | access level |
99 -- +--------------------+ +-------------------+
101 -- +-------------------+
103 -- +-------------------+
104 -- | hash table link |
105 -- +-------------------+
106 -- | remotely callable |
107 -- +-------------------+
108 -- | rec ctrler offset |
109 -- +-------------------+
110 -- | Ifaces_Table ---> Interface Data
111 -- +-------------------+ +------------+
112 -- Select Specific Data <---- SSD | | Nb_Ifaces |
113 -- +------------------+ +-------------------+ +------------+
114 -- |table of primitive| | table of | | table |
115 -- : operation : : ancestor : : of :
116 -- | kinds | | tags | | interfaces |
117 -- +------------------+ +-------------------+ +------------+
121 -- +------------------+
123 -- Structure of the GNAT Secondary Dispatch Table
125 -- +--------------------+
127 -- +--------------------+
129 -- +--------------------+ Predef Prims
130 -- | Predef_Prims -----------------------------> +------------+
131 -- +--------------------+ | table of |
132 -- | Offset_To_Top | | predefined |
133 -- +--------------------+ | primitives |
134 -- | OSD_Ptr |---> Object Specific Data | thunks |
135 -- Tag ---> +--------------------+ +---------------+ +------------+
136 -- | table of | | num prim ops |
137 -- : primitive op : +---------------+
138 -- | thunk pointers | | table of |
139 -- +--------------------+ + primitive |
143 -- The runtime information kept for each tagged type is separated into two
144 -- objects: the Dispatch Table and the Type Specific Data record.
146 package SSE renames System.Storage_Elements;
148 subtype Cstring is String (Positive);
149 type Cstring_Ptr is access all Cstring;
150 pragma No_Strict_Aliasing (Cstring_Ptr);
152 -- Declarations for the table of interfaces
154 type Offset_To_Top_Function_Ptr is
155 access function (This : System.Address) return SSE.Storage_Offset;
156 -- Type definition used to call the function that is generated by the
157 -- expander in case of tagged types with discriminants that have secondary
158 -- dispatch tables. This function provides the Offset_To_Top value in this
161 type Interface_Data_Element is record
163 Static_Offset_To_Top : Boolean;
164 Offset_To_Top_Value : SSE.Storage_Offset;
165 Offset_To_Top_Func : Offset_To_Top_Function_Ptr;
168 -- If some ancestor of the tagged type has discriminants the field
169 -- Static_Offset_To_Top is False and the field Offset_To_Top_Func
170 -- is used to store the access to the function generated by the
171 -- expander which provides this value; otherwise Static_Offset_To_Top
172 -- is True and such value is stored in the Offset_To_Top_Value field.
173 -- Secondary_DT references a secondary dispatch table whose contents
174 -- are pointers to the primitives of the tagged type that cover the
175 -- interface primitives. Secondary_DT gives support to dispatching
176 -- calls through interface types associated with Generic Dispatching
179 type Interfaces_Array is array (Natural range <>) of Interface_Data_Element;
181 type Interface_Data (Nb_Ifaces : Positive) is record
182 Ifaces_Table : Interfaces_Array (1 .. Nb_Ifaces);
185 type Interface_Data_Ptr is access all Interface_Data;
186 -- Table of abstract interfaces used to give support to backward interface
187 -- conversions and also to IW_Membership.
189 -- Primitive operation kinds. These values differentiate the kinds of
190 -- callable entities stored in the dispatch table. Certain kinds may
191 -- not be used, but are added for completeness.
197 POK_Protected_Function,
198 POK_Protected_Procedure,
203 -- Select specific data types
205 type Select_Specific_Data_Element is record
210 type Select_Specific_Data_Array is
211 array (Positive range <>) of Select_Specific_Data_Element;
213 type Select_Specific_Data (Nb_Prim : Positive) is record
214 SSD_Table : Select_Specific_Data_Array (1 .. Nb_Prim);
215 -- NOTE: Nb_Prim is the number of non-predefined primitive operations
218 type Select_Specific_Data_Ptr is access all Select_Specific_Data;
219 -- A table used to store the primitive operation kind and entry index of
220 -- primitive subprograms of a type that implements a limited interface.
221 -- The Select Specific Data table resides in the Type Specific Data of a
222 -- type. This construct is used in the handling of dispatching triggers
223 -- in select statements.
225 type Prim_Ptr is access procedure;
226 type Address_Array is array (Positive range <>) of Prim_Ptr;
228 subtype Dispatch_Table is Address_Array (1 .. 1);
229 -- Used by GDB to identify the _tags and traverse the run-time structure
230 -- associated with tagged types. For compatibility with older versions of
231 -- gdb, its name must not be changed.
233 type Tag is access all Dispatch_Table;
234 pragma No_Strict_Aliasing (Tag);
236 type Interface_Tag is access all Dispatch_Table;
238 No_Tag : constant Tag := null;
240 -- The expander ensures that Tag objects reference the Prims_Ptr component
243 type Tag_Ptr is access all Tag;
244 pragma No_Strict_Aliasing (Tag_Ptr);
246 type Offset_To_Top_Ptr is access all SSE.Storage_Offset;
247 pragma No_Strict_Aliasing (Offset_To_Top_Ptr);
249 type Tag_Table is array (Natural range <>) of Tag;
252 access function (A : System.Address) return Long_Long_Integer;
254 type Type_Specific_Data (Idepth : Natural) is record
255 -- The discriminant Idepth is the Inheritance Depth Level: Used to
256 -- implement the membership test associated with single inheritance of
257 -- tagged types in constant-time. It also indicates the size of the
258 -- Tags_Table component.
260 Access_Level : Natural;
261 -- Accessibility level required to give support to Ada 2005 nested type
262 -- extensions. This feature allows safe nested type extensions by
263 -- shifting the accessibility checks to certain operations, rather than
264 -- being enforced at the type declaration. In particular, by performing
265 -- run-time accessibility checks on class-wide allocators, class-wide
266 -- function return, and class-wide stream I/O, the danger of objects
267 -- outliving their type declaration can be eliminated (Ada 2005: AI-344)
269 Expanded_Name : Cstring_Ptr;
270 External_Tag : Cstring_Ptr;
272 -- Components used to support to the Ada.Tags subprograms in RM 3.9
274 -- Note: Expanded_Name is referenced by GDB to determine the actual name
275 -- of the tagged type. Its requirements are: 1) it must have this exact
276 -- name, and 2) its contents must point to a C-style Nul terminated
277 -- string containing its expanded name. GDB has no requirement on a
278 -- given position inside the record.
280 Transportable : Boolean;
281 -- Used to check RM E.4(18), set for types that satisfy the requirements
282 -- for being used in remote calls as actuals for classwide formals or as
283 -- return values for classwide functions.
285 RC_Offset : SSE.Storage_Offset;
286 -- Controller Offset: Used to give support to tagged controlled objects
287 -- (see Get_Deep_Controller at s-finimp)
289 Size_Func : Size_Ptr;
290 -- Pointer to the subprogram computing the _size of the object. Used by
291 -- the run-time whenever a call to the 'size primitive is required. We
292 -- cannot assume that the contents of dispatch tables are addresses
293 -- because in some architectures the ABI allows descriptors.
295 Interfaces_Table : Interface_Data_Ptr;
296 -- Pointer to the table of interface tags. It is used to implement the
297 -- membership test associated with interfaces and also for backward
298 -- abstract interface type conversions (Ada 2005:AI-251)
300 SSD : Select_Specific_Data_Ptr;
301 -- Pointer to a table of records used in dispatching selects. This
302 -- field has a meaningful value for all tagged types that implement
303 -- a limited, protected, synchronized or task interfaces and have
304 -- non-predefined primitive operations.
306 Tags_Table : Tag_Table (0 .. Idepth);
307 -- Table of ancestor tags. Its size actually depends on the inheritance
308 -- depth level of the tagged type.
311 type Type_Specific_Data_Ptr is access all Type_Specific_Data;
312 pragma No_Strict_Aliasing (Type_Specific_Data_Ptr);
314 -- Declarations for the dispatch table record
316 type Signature_Kind is
321 -- Tagged type kinds with respect to concurrency and limitedness
324 (TK_Abstract_Limited_Tagged,
331 type Dispatch_Table_Wrapper (Num_Prims : Natural) is record
332 Signature : Signature_Kind;
333 Tag_Kind : Tagged_Kind;
334 Predef_Prims : System.Address;
335 -- Pointer to the dispatch table of predefined Ada primitives
337 -- According to the C++ ABI the components Offset_To_Top and TSD are
338 -- stored just "before" the dispatch table, and they are referenced with
339 -- negative offsets referring to the base of the dispatch table. The
340 -- _Tag (or the VTable_Ptr in C++ terminology) must point to the base
341 -- of the virtual table, just after these components, to point to the
344 Offset_To_Top : SSE.Storage_Offset;
345 TSD : System.Address;
347 Prims_Ptr : aliased Address_Array (1 .. Num_Prims);
348 -- The size of the Prims_Ptr array actually depends on the tagged type
349 -- to which it applies. For each tagged type, the expander computes the
350 -- actual array size, allocates the Dispatch_Table record accordingly.
353 type Dispatch_Table_Ptr is access all Dispatch_Table_Wrapper;
354 pragma No_Strict_Aliasing (Dispatch_Table_Ptr);
356 -- The following type declaration is used by the compiler when the program
357 -- is compiled with restriction No_Dispatching_Calls. It is also used with
358 -- interface types to generate the tag and run-time information associated
361 type No_Dispatch_Table_Wrapper is record
362 NDT_TSD : System.Address;
363 NDT_Prims_Ptr : Natural;
366 DT_Predef_Prims_Size : constant SSE.Storage_Count :=
368 (1 * (Standard'Address_Size /
369 System.Storage_Unit));
370 -- Size of the Predef_Prims field of the Dispatch_Table
372 DT_Offset_To_Top_Size : constant SSE.Storage_Count :=
374 (1 * (Standard'Address_Size /
375 System.Storage_Unit));
376 -- Size of the Offset_To_Top field of the Dispatch Table
378 DT_Typeinfo_Ptr_Size : constant SSE.Storage_Count :=
380 (1 * (Standard'Address_Size /
381 System.Storage_Unit));
382 -- Size of the Typeinfo_Ptr field of the Dispatch Table
384 use type System.Storage_Elements.Storage_Offset;
386 DT_Offset_To_Top_Offset : constant SSE.Storage_Count :=
388 + DT_Offset_To_Top_Size;
390 DT_Predef_Prims_Offset : constant SSE.Storage_Count :=
392 + DT_Offset_To_Top_Size
393 + DT_Predef_Prims_Size;
394 -- Offset from Prims_Ptr to Predef_Prims component
396 -- Object Specific Data record of secondary dispatch tables
398 type Object_Specific_Data_Array is array (Positive range <>) of Positive;
400 type Object_Specific_Data (OSD_Num_Prims : Positive) is record
401 OSD_Table : Object_Specific_Data_Array (1 .. OSD_Num_Prims);
402 -- Table used in secondary DT to reference their counterpart in the
403 -- select specific data (in the TSD of the primary DT). This construct
404 -- is used in the handling of dispatching triggers in select statements.
405 -- Nb_Prim is the number of non-predefined primitive operations.
408 type Object_Specific_Data_Ptr is access all Object_Specific_Data;
409 pragma No_Strict_Aliasing (Object_Specific_Data_Ptr);
411 -- The following subprogram specifications are placed here instead of
412 -- the package body to see them from the frontend through rtsfind.
414 function Base_Address (This : System.Address) return System.Address;
415 -- Ada 2005 (AI-251): Displace "This" to point to the base address of
416 -- the object (that is, the address of the primary tag of the object).
418 function Displace (This : System.Address; T : Tag) return System.Address;
419 -- Ada 2005 (AI-251): Displace "This" to point to the secondary dispatch
422 function Secondary_Tag (T, Iface : Tag) return Tag;
423 -- Ada 2005 (AI-251): Given a primary tag T associated with a tagged type
424 -- Typ, search for the secondary tag of the interface type Iface covered
427 function DT (T : Tag) return Dispatch_Table_Ptr;
428 -- Return the pointer to the TSD record associated with T
430 function Get_Entry_Index (T : Tag; Position : Positive) return Positive;
431 -- Ada 2005 (AI-251): Return a primitive operation's entry index (if entry)
432 -- given a dispatch table T and a position of a primitive operation in T.
434 function Get_Offset_Index
436 Position : Positive) return Positive;
437 -- Ada 2005 (AI-251): Given a pointer to a secondary dispatch table (T) and
438 -- a position of an operation in the DT, retrieve the corresponding
439 -- operation's position in the primary dispatch table from the Offset
440 -- Specific Data table of T.
442 function Get_Prim_Op_Kind
444 Position : Positive) return Prim_Op_Kind;
445 -- Ada 2005 (AI-251): Return a primitive operation's kind given a dispatch
446 -- table T and a position of a primitive operation in T.
448 function Get_RC_Offset (T : Tag) return SSE.Storage_Offset;
449 -- Return the Offset of the implicit record controller when the object
450 -- has controlled components, returns zero if no controlled components.
452 pragma Export (Ada, Get_RC_Offset, "ada__tags__get_rc_offset");
453 -- This procedure is used in s-finimp to compute the deep routines
454 -- it is exported manually in order to avoid changing completely the
455 -- organization of the run time.
457 function Get_Tagged_Kind (T : Tag) return Tagged_Kind;
458 -- Ada 2005 (AI-345): Given a pointer to either a primary or a secondary
459 -- dispatch table, return the tagged kind of a type in the context of
460 -- concurrency and limitedness.
462 function IW_Membership (This : System.Address; T : Tag) return Boolean;
463 -- Ada 2005 (AI-251): General routine that checks if a given object
464 -- implements a tagged type. Its common usage is to check if Obj is in
465 -- Iface'Class, but it is also used to check if a class-wide interface
466 -- implements a given type (Iface_CW_Typ in T'Class). For example:
468 -- type I is interface;
469 -- type T is tagged ...
471 -- function Test (O : I'Class) is
473 -- return O in T'Class.
476 function Offset_To_Top
477 (This : System.Address) return SSE.Storage_Offset;
478 -- Ada 2005 (AI-251): Returns the current value of the offset_to_top
479 -- component available in the prologue of the dispatch table. If the parent
480 -- of the tagged type has discriminants this value is stored in a record
481 -- component just immediately after the tag component.
484 (Obj : System.Address;
485 T : Tag) return SSE.Storage_Count;
486 -- Computes the size the ancestor part of a tagged extension object whose
487 -- address is 'obj' by calling indirectly the ancestor _size function. The
488 -- ancestor is the parent of the type represented by tag T. This function
489 -- assumes that _size is always in slot one of the dispatch table.
491 pragma Export (Ada, Parent_Size, "ada__tags__parent_size");
492 -- This procedure is used in s-finimp and is thus exported manually
494 procedure Register_Interface_Offset
495 (This : System.Address;
498 Offset_Value : SSE.Storage_Offset;
499 Offset_Func : Offset_To_Top_Function_Ptr);
500 -- Register in the table of interfaces of the tagged type associated with
501 -- "This" object the offset of the record component associated with the
502 -- progenitor Interface_T (that is, the distance from "This" to the object
503 -- component containing the tag of the secondary dispatch table). In case
504 -- of constant offset, Is_Static is true and Offset_Value has such value.
505 -- In case of variable offset, Is_Static is false and Offset_Func is an
506 -- access to function that must be called to evaluate the offset.
508 procedure Register_Tag (T : Tag);
509 -- Insert the Tag and its associated external_tag in a table for the
510 -- sake of Internal_Tag
512 procedure Set_Dynamic_Offset_To_Top
513 (This : System.Address;
515 Offset_Value : SSE.Storage_Offset;
516 Offset_Func : Offset_To_Top_Function_Ptr);
517 -- Ada 2005 (AI-251): The compiler generates calls to this routine only
518 -- when initializing the Offset_To_Top field of dispatch tables associated
519 -- with tagged type whose parent has variable size components. "This" is
520 -- the object whose dispatch table is being initialized. Interface_T is the
521 -- interface for which the secondary dispatch table is being initialized,
522 -- and Offset_Value is the distance from "This" to the object component
523 -- containing the tag of the secondary dispatch table (a zero value means
524 -- that this interface shares the primary dispatch table). Offset_Func
525 -- references a function that must be called to evaluate the offset at
526 -- runtime. This routine also takes care of registering these values in
527 -- the table of interfaces of the type.
529 procedure Set_Entry_Index (T : Tag; Position : Positive; Value : Positive);
530 -- Ada 2005 (AI-345): Set the entry index of a primitive operation in T's
531 -- TSD table indexed by Position.
533 procedure Set_Prim_Op_Kind
536 Value : Prim_Op_Kind);
537 -- Ada 2005 (AI-251): Set the kind of a primitive operation in T's TSD
538 -- table indexed by Position.
540 Max_Predef_Prims : constant Positive := 16;
541 -- Number of reserved slots for the following predefined ada primitives:
554 -- 12. conditional select
557 -- 15. dispatching requeue
560 -- The compiler checks that the value here is correct
562 subtype Predef_Prims_Table is Address_Array (1 .. Max_Predef_Prims);
563 type Predef_Prims_Table_Ptr is access Predef_Prims_Table;
564 pragma No_Strict_Aliasing (Predef_Prims_Table_Ptr);
566 type Addr_Ptr is access System.Address;
567 pragma No_Strict_Aliasing (Addr_Ptr);
568 -- This type is used by the frontend to generate the code that handles
569 -- dispatch table slots of types declared at the local level.