1 ------------------------------------------------------------------------------
3 -- GNAT RUN-TIME COMPONENTS --
9 -- Copyright (C) 1992-2009, 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 3, 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. --
22 -- As a special exception under Section 7 of GPL version 3, you are granted --
23 -- additional permissions described in the GCC Runtime Library Exception, --
24 -- version 3.1, as published by the Free Software Foundation. --
26 -- You should have received a copy of the GNU General Public License and --
27 -- a copy of the GCC Runtime Library Exception along with this program; --
28 -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
29 -- <http://www.gnu.org/licenses/>. --
31 -- GNAT was originally developed by the GNAT team at New York University. --
32 -- Extensive contributions were provided by Ada Core Technologies Inc. --
34 ------------------------------------------------------------------------------
37 with System.Storage_Elements;
40 pragma Preelaborate_05;
41 -- In accordance with Ada 2005 AI-362
44 pragma Preelaborable_Initialization (Tag);
46 No_Tag : constant Tag;
48 function Expanded_Name (T : Tag) return String;
50 function Wide_Expanded_Name (T : Tag) return Wide_String;
51 pragma Ada_05 (Wide_Expanded_Name);
53 function Wide_Wide_Expanded_Name (T : Tag) return Wide_Wide_String;
54 pragma Ada_05 (Wide_Wide_Expanded_Name);
56 function External_Tag (T : Tag) return String;
58 function Internal_Tag (External : String) return Tag;
60 function Descendant_Tag
62 Ancestor : Tag) return Tag;
63 pragma Ada_05 (Descendant_Tag);
65 function Is_Descendant_At_Same_Level
67 Ancestor : Tag) return Boolean;
68 pragma Ada_05 (Is_Descendant_At_Same_Level);
70 function Parent_Tag (T : Tag) return Tag;
71 pragma Ada_05 (Parent_Tag);
73 type Tag_Array is array (Positive range <>) of Tag;
75 function Interface_Ancestor_Tags (T : Tag) return Tag_Array;
76 pragma Ada_05 (Interface_Ancestor_Tags);
78 Tag_Error : exception;
81 -- Structure of the GNAT Primary Dispatch Table
83 -- +--------------------+
85 -- +--------------------+
87 -- +--------------------+ Predef Prims
88 -- | Predef_Prims -----------------------------> +------------+
89 -- +--------------------+ | table of |
90 -- | Offset_To_Top | | predefined |
91 -- +--------------------+ | primitives |
92 -- |Typeinfo_Ptr/TSD_Ptr---> Type Specific Data +------------+
93 -- Tag ---> +--------------------+ +-------------------+
94 -- | table of | | inheritance depth |
95 -- : primitive ops : +-------------------+
96 -- | pointers | | access level |
97 -- +--------------------+ +-------------------+
99 -- +-------------------+
101 -- +-------------------+
102 -- | hash table link |
103 -- +-------------------+
104 -- | remotely callable |
105 -- +-------------------+
106 -- | rec ctrler offset |
107 -- +-------------------+
108 -- | Ifaces_Table ---> Interface Data
109 -- +-------------------+ +------------+
110 -- Select Specific Data <---- SSD | | Nb_Ifaces |
111 -- +------------------+ +-------------------+ +------------+
112 -- |table of primitive| | table of | | table |
113 -- : operation : : ancestor : : of :
114 -- | kinds | | tags | | interfaces |
115 -- +------------------+ +-------------------+ +------------+
119 -- +------------------+
121 -- Structure of the GNAT Secondary Dispatch Table
123 -- +--------------------+
125 -- +--------------------+
127 -- +--------------------+ Predef Prims
128 -- | Predef_Prims -----------------------------> +------------+
129 -- +--------------------+ | table of |
130 -- | Offset_To_Top | | predefined |
131 -- +--------------------+ | primitives |
132 -- | OSD_Ptr |---> Object Specific Data | thunks |
133 -- Tag ---> +--------------------+ +---------------+ +------------+
134 -- | table of | | num prim ops |
135 -- : primitive op : +---------------+
136 -- | thunk pointers | | table of |
137 -- +--------------------+ + primitive |
141 -- The runtime information kept for each tagged type is separated into two
142 -- objects: the Dispatch Table and the Type Specific Data record.
144 package SSE renames System.Storage_Elements;
146 subtype Cstring is String (Positive);
147 type Cstring_Ptr is access all Cstring;
148 pragma No_Strict_Aliasing (Cstring_Ptr);
150 -- Declarations for the table of interfaces
152 type Offset_To_Top_Function_Ptr is
153 access function (This : System.Address) return SSE.Storage_Offset;
154 -- Type definition used to call the function that is generated by the
155 -- expander in case of tagged types with discriminants that have secondary
156 -- dispatch tables. This function provides the Offset_To_Top value in this
159 type Interface_Data_Element is record
161 Static_Offset_To_Top : Boolean;
162 Offset_To_Top_Value : SSE.Storage_Offset;
163 Offset_To_Top_Func : Offset_To_Top_Function_Ptr;
166 -- If some ancestor of the tagged type has discriminants the field
167 -- Static_Offset_To_Top is False and the field Offset_To_Top_Func
168 -- is used to store the access to the function generated by the
169 -- expander which provides this value; otherwise Static_Offset_To_Top
170 -- is True and such value is stored in the Offset_To_Top_Value field.
171 -- Secondary_DT references a secondary dispatch table whose contents
172 -- are pointers to the primitives of the tagged type that cover the
173 -- interface primitives. Secondary_DT gives support to dispatching
174 -- calls through interface types associated with Generic Dispatching
177 type Interfaces_Array is array (Natural range <>) of Interface_Data_Element;
179 type Interface_Data (Nb_Ifaces : Positive) is record
180 Ifaces_Table : Interfaces_Array (1 .. Nb_Ifaces);
183 type Interface_Data_Ptr is access all Interface_Data;
184 -- Table of abstract interfaces used to give support to backward interface
185 -- conversions and also to IW_Membership.
187 -- Primitive operation kinds. These values differentiate the kinds of
188 -- callable entities stored in the dispatch table. Certain kinds may
189 -- not be used, but are added for completeness.
195 POK_Protected_Function,
196 POK_Protected_Procedure,
201 -- Select specific data types
203 type Select_Specific_Data_Element is record
208 type Select_Specific_Data_Array is
209 array (Positive range <>) of Select_Specific_Data_Element;
211 type Select_Specific_Data (Nb_Prim : Positive) is record
212 SSD_Table : Select_Specific_Data_Array (1 .. Nb_Prim);
213 -- NOTE: Nb_Prim is the number of non-predefined primitive operations
216 type Select_Specific_Data_Ptr is access all Select_Specific_Data;
217 -- A table used to store the primitive operation kind and entry index of
218 -- primitive subprograms of a type that implements a limited interface.
219 -- The Select Specific Data table resides in the Type Specific Data of a
220 -- type. This construct is used in the handling of dispatching triggers
221 -- in select statements.
223 type Prim_Ptr is access procedure;
224 type Address_Array is array (Positive range <>) of Prim_Ptr;
226 subtype Dispatch_Table is Address_Array (1 .. 1);
227 -- Used by GDB to identify the _tags and traverse the run-time structure
228 -- associated with tagged types. For compatibility with older versions of
229 -- gdb, its name must not be changed.
231 type Tag is access all Dispatch_Table;
232 pragma No_Strict_Aliasing (Tag);
234 type Interface_Tag is access all Dispatch_Table;
236 No_Tag : constant Tag := null;
238 -- The expander ensures that Tag objects reference the Prims_Ptr component
241 type Tag_Ptr is access all Tag;
242 pragma No_Strict_Aliasing (Tag_Ptr);
244 type Offset_To_Top_Ptr is access all SSE.Storage_Offset;
245 pragma No_Strict_Aliasing (Offset_To_Top_Ptr);
247 type Tag_Table is array (Natural range <>) of Tag;
250 access function (A : System.Address) return Long_Long_Integer;
252 type Type_Specific_Data (Idepth : Natural) is record
253 -- The discriminant Idepth is the Inheritance Depth Level: Used to
254 -- implement the membership test associated with single inheritance of
255 -- tagged types in constant-time. It also indicates the size of the
256 -- Tags_Table component.
258 Access_Level : Natural;
259 -- Accessibility level required to give support to Ada 2005 nested type
260 -- extensions. This feature allows safe nested type extensions by
261 -- shifting the accessibility checks to certain operations, rather than
262 -- being enforced at the type declaration. In particular, by performing
263 -- run-time accessibility checks on class-wide allocators, class-wide
264 -- function return, and class-wide stream I/O, the danger of objects
265 -- outliving their type declaration can be eliminated (Ada 2005: AI-344)
267 Expanded_Name : Cstring_Ptr;
268 External_Tag : Cstring_Ptr;
270 -- Components used to support to the Ada.Tags subprograms in RM 3.9
272 -- Note: Expanded_Name is referenced by GDB to determine the actual name
273 -- of the tagged type. Its requirements are: 1) it must have this exact
274 -- name, and 2) its contents must point to a C-style Nul terminated
275 -- string containing its expanded name. GDB has no requirement on a
276 -- given position inside the record.
278 Transportable : Boolean;
279 -- Used to check RM E.4(18), set for types that satisfy the requirements
280 -- for being used in remote calls as actuals for classwide formals or as
281 -- return values for classwide functions.
283 RC_Offset : SSE.Storage_Offset;
284 -- Controller Offset: Used to give support to tagged controlled objects
285 -- (see Get_Deep_Controller at s-finimp)
287 Size_Func : Size_Ptr;
288 -- Pointer to the subprogram computing the _size of the object. Used by
289 -- the run-time whenever a call to the 'size primitive is required. We
290 -- cannot assume that the contents of dispatch tables are addresses
291 -- because in some architectures the ABI allows descriptors.
293 Interfaces_Table : Interface_Data_Ptr;
294 -- Pointer to the table of interface tags. It is used to implement the
295 -- membership test associated with interfaces and also for backward
296 -- abstract interface type conversions (Ada 2005:AI-251)
298 SSD : Select_Specific_Data_Ptr;
299 -- Pointer to a table of records used in dispatching selects. This
300 -- field has a meaningful value for all tagged types that implement
301 -- a limited, protected, synchronized or task interfaces and have
302 -- non-predefined primitive operations.
304 Tags_Table : Tag_Table (0 .. Idepth);
305 -- Table of ancestor tags. Its size actually depends on the inheritance
306 -- depth level of the tagged type.
309 type Type_Specific_Data_Ptr is access all Type_Specific_Data;
310 pragma No_Strict_Aliasing (Type_Specific_Data_Ptr);
312 -- Declarations for the dispatch table record
314 type Signature_Kind is
319 -- Tagged type kinds with respect to concurrency and limitedness
322 (TK_Abstract_Limited_Tagged,
329 type Dispatch_Table_Wrapper (Num_Prims : Natural) is record
330 Signature : Signature_Kind;
331 Tag_Kind : Tagged_Kind;
332 Predef_Prims : System.Address;
333 -- Pointer to the dispatch table of predefined Ada primitives
335 -- According to the C++ ABI the components Offset_To_Top and TSD are
336 -- stored just "before" the dispatch table, and they are referenced with
337 -- negative offsets referring to the base of the dispatch table. The
338 -- _Tag (or the VTable_Ptr in C++ terminology) must point to the base
339 -- of the virtual table, just after these components, to point to the
342 Offset_To_Top : SSE.Storage_Offset;
343 TSD : System.Address;
345 Prims_Ptr : aliased Address_Array (1 .. Num_Prims);
346 -- The size of the Prims_Ptr array actually depends on the tagged type
347 -- to which it applies. For each tagged type, the expander computes the
348 -- actual array size, allocates the Dispatch_Table record accordingly.
351 type Dispatch_Table_Ptr is access all Dispatch_Table_Wrapper;
352 pragma No_Strict_Aliasing (Dispatch_Table_Ptr);
354 -- The following type declaration is used by the compiler when the program
355 -- is compiled with restriction No_Dispatching_Calls. It is also used with
356 -- interface types to generate the tag and run-time information associated
359 type No_Dispatch_Table_Wrapper is record
360 NDT_TSD : System.Address;
361 NDT_Prims_Ptr : Natural;
364 DT_Predef_Prims_Size : constant SSE.Storage_Count :=
366 (1 * (Standard'Address_Size /
367 System.Storage_Unit));
368 -- Size of the Predef_Prims field of the Dispatch_Table
370 DT_Offset_To_Top_Size : constant SSE.Storage_Count :=
372 (1 * (Standard'Address_Size /
373 System.Storage_Unit));
374 -- Size of the Offset_To_Top field of the Dispatch Table
376 DT_Typeinfo_Ptr_Size : constant SSE.Storage_Count :=
378 (1 * (Standard'Address_Size /
379 System.Storage_Unit));
380 -- Size of the Typeinfo_Ptr field of the Dispatch Table
382 use type System.Storage_Elements.Storage_Offset;
384 DT_Offset_To_Top_Offset : constant SSE.Storage_Count :=
386 + DT_Offset_To_Top_Size;
388 DT_Predef_Prims_Offset : constant SSE.Storage_Count :=
390 + DT_Offset_To_Top_Size
391 + DT_Predef_Prims_Size;
392 -- Offset from Prims_Ptr to Predef_Prims component
394 -- Object Specific Data record of secondary dispatch tables
396 type Object_Specific_Data_Array is array (Positive range <>) of Positive;
398 type Object_Specific_Data (OSD_Num_Prims : Positive) is record
399 OSD_Table : Object_Specific_Data_Array (1 .. OSD_Num_Prims);
400 -- Table used in secondary DT to reference their counterpart in the
401 -- select specific data (in the TSD of the primary DT). This construct
402 -- is used in the handling of dispatching triggers in select statements.
403 -- Nb_Prim is the number of non-predefined primitive operations.
406 type Object_Specific_Data_Ptr is access all Object_Specific_Data;
407 pragma No_Strict_Aliasing (Object_Specific_Data_Ptr);
409 -- The following subprogram specifications are placed here instead of
410 -- the package body to see them from the frontend through rtsfind.
412 function Base_Address (This : System.Address) return System.Address;
413 -- Ada 2005 (AI-251): Displace "This" to point to the base address of
414 -- the object (that is, the address of the primary tag of the object).
416 function Displace (This : System.Address; T : Tag) return System.Address;
417 -- Ada 2005 (AI-251): Displace "This" to point to the secondary dispatch
420 function Secondary_Tag (T, Iface : Tag) return Tag;
421 -- Ada 2005 (AI-251): Given a primary tag T associated with a tagged type
422 -- Typ, search for the secondary tag of the interface type Iface covered
425 function DT (T : Tag) return Dispatch_Table_Ptr;
426 -- Return the pointer to the TSD record associated with T
428 function Get_Entry_Index (T : Tag; Position : Positive) return Positive;
429 -- Ada 2005 (AI-251): Return a primitive operation's entry index (if entry)
430 -- given a dispatch table T and a position of a primitive operation in T.
432 function Get_Offset_Index
434 Position : Positive) return Positive;
435 -- Ada 2005 (AI-251): Given a pointer to a secondary dispatch table (T) and
436 -- a position of an operation in the DT, retrieve the corresponding
437 -- operation's position in the primary dispatch table from the Offset
438 -- Specific Data table of T.
440 function Get_Prim_Op_Kind
442 Position : Positive) return Prim_Op_Kind;
443 -- Ada 2005 (AI-251): Return a primitive operation's kind given a dispatch
444 -- table T and a position of a primitive operation in T.
446 function Get_RC_Offset (T : Tag) return SSE.Storage_Offset;
447 -- Return the Offset of the implicit record controller when the object
448 -- has controlled components, returns zero if no controlled components.
450 pragma Export (Ada, Get_RC_Offset, "ada__tags__get_rc_offset");
451 -- This procedure is used in s-finimp to compute the deep routines
452 -- it is exported manually in order to avoid changing completely the
453 -- organization of the run time.
455 function Get_Tagged_Kind (T : Tag) return Tagged_Kind;
456 -- Ada 2005 (AI-345): Given a pointer to either a primary or a secondary
457 -- dispatch table, return the tagged kind of a type in the context of
458 -- concurrency and limitedness.
460 function IW_Membership (This : System.Address; T : Tag) return Boolean;
461 -- Ada 2005 (AI-251): General routine that checks if a given object
462 -- implements a tagged type. Its common usage is to check if Obj is in
463 -- Iface'Class, but it is also used to check if a class-wide interface
464 -- implements a given type (Iface_CW_Typ in T'Class). For example:
466 -- type I is interface;
467 -- type T is tagged ...
469 -- function Test (O : I'Class) is
471 -- return O in T'Class.
474 function Offset_To_Top
475 (This : System.Address) return SSE.Storage_Offset;
476 -- Ada 2005 (AI-251): Returns the current value of the offset_to_top
477 -- component available in the prologue of the dispatch table. If the parent
478 -- of the tagged type has discriminants this value is stored in a record
479 -- component just immediately after the tag component.
482 (Obj : System.Address;
483 T : Tag) return SSE.Storage_Count;
484 -- Computes the size the ancestor part of a tagged extension object whose
485 -- address is 'obj' by calling indirectly the ancestor _size function. The
486 -- ancestor is the parent of the type represented by tag T. This function
487 -- assumes that _size is always in slot one of the dispatch table.
489 pragma Export (Ada, Parent_Size, "ada__tags__parent_size");
490 -- This procedure is used in s-finimp and is thus exported manually
492 procedure Register_Interface_Offset
493 (This : System.Address;
496 Offset_Value : SSE.Storage_Offset;
497 Offset_Func : Offset_To_Top_Function_Ptr);
498 -- Register in the table of interfaces of the tagged type associated with
499 -- "This" object the offset of the record component associated with the
500 -- progenitor Interface_T (that is, the distance from "This" to the object
501 -- component containing the tag of the secondary dispatch table). In case
502 -- of constant offset, Is_Static is true and Offset_Value has such value.
503 -- In case of variable offset, Is_Static is false and Offset_Func is an
504 -- access to function that must be called to evaluate the offset.
506 procedure Register_Tag (T : Tag);
507 -- Insert the Tag and its associated external_tag in a table for the
508 -- sake of Internal_Tag
510 procedure Set_Dynamic_Offset_To_Top
511 (This : System.Address;
513 Offset_Value : SSE.Storage_Offset;
514 Offset_Func : Offset_To_Top_Function_Ptr);
515 -- Ada 2005 (AI-251): The compiler generates calls to this routine only
516 -- when initializing the Offset_To_Top field of dispatch tables associated
517 -- with tagged type whose parent has variable size components. "This" is
518 -- the object whose dispatch table is being initialized. Interface_T is the
519 -- interface for which the secondary dispatch table is being initialized,
520 -- and Offset_Value is the distance from "This" to the object component
521 -- containing the tag of the secondary dispatch table (a zero value means
522 -- that this interface shares the primary dispatch table). Offset_Func
523 -- references a function that must be called to evaluate the offset at
524 -- runtime. This routine also takes care of registering these values in
525 -- the table of interfaces of the type.
527 procedure Set_Entry_Index (T : Tag; Position : Positive; Value : Positive);
528 -- Ada 2005 (AI-345): Set the entry index of a primitive operation in T's
529 -- TSD table indexed by Position.
531 procedure Set_Prim_Op_Kind
534 Value : Prim_Op_Kind);
535 -- Ada 2005 (AI-251): Set the kind of a primitive operation in T's TSD
536 -- table indexed by Position.
538 Max_Predef_Prims : constant Positive := 16;
539 -- Number of reserved slots for the following predefined ada primitives:
552 -- 12. conditional select
555 -- 15. dispatching requeue
558 -- The compiler checks that the value here is correct
560 subtype Predef_Prims_Table is Address_Array (1 .. Max_Predef_Prims);
561 type Predef_Prims_Table_Ptr is access Predef_Prims_Table;
562 pragma No_Strict_Aliasing (Predef_Prims_Table_Ptr);
564 type Addr_Ptr is access System.Address;
565 pragma No_Strict_Aliasing (Addr_Ptr);
566 -- This type is used by the frontend to generate the code that handles
567 -- dispatch table slots of types declared at the local level.