1 ------------------------------------------------------------------------------
3 -- GNAT RUN-TIME COMPONENTS --
9 -- Copyright (C) 1992-2007, 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;
40 with Ada.Unchecked_Conversion;
43 pragma Preelaborate_05;
44 -- In accordance with Ada 2005 AI-362
47 pragma Preelaborable_Initialization (Tag);
49 No_Tag : constant Tag;
51 function Expanded_Name (T : Tag) return String;
53 function Wide_Expanded_Name (T : Tag) return Wide_String;
54 pragma Ada_05 (Wide_Expanded_Name);
56 function Wide_Wide_Expanded_Name (T : Tag) return Wide_Wide_String;
57 pragma Ada_05 (Wide_Wide_Expanded_Name);
59 function External_Tag (T : Tag) return String;
61 function Internal_Tag (External : String) return Tag;
63 function Descendant_Tag
65 Ancestor : Tag) return Tag;
66 pragma Ada_05 (Descendant_Tag);
68 function Is_Descendant_At_Same_Level
70 Ancestor : Tag) return Boolean;
71 pragma Ada_05 (Is_Descendant_At_Same_Level);
73 function Parent_Tag (T : Tag) return Tag;
74 pragma Ada_05 (Parent_Tag);
76 type Tag_Array is array (Positive range <>) of Tag;
78 function Interface_Ancestor_Tags (T : Tag) return Tag_Array;
79 pragma Ada_05 (Interface_Ancestor_Tags);
81 Tag_Error : exception;
84 -- Structure of the GNAT Primary Dispatch Table
86 -- +--------------------+
88 -- +--------------------+
90 -- +--------------------+ Predef Prims
91 -- | Predef_Prims -----------------------------> +------------+
92 -- +--------------------+ | table of |
93 -- | Offset_To_Top | | predefined |
94 -- +--------------------+ | primitives |
95 -- |Typeinfo_Ptr/TSD_Ptr---> Type Specific Data +------------+
96 -- Tag ---> +--------------------+ +-------------------+
97 -- | table of | | inheritance depth |
98 -- : primitive ops : +-------------------+
99 -- | pointers | | access level |
100 -- +--------------------+ +-------------------+
102 -- +-------------------+
104 -- +-------------------+
105 -- | hash table link |
106 -- +-------------------+
107 -- | remotely callable |
108 -- +-------------------+
109 -- | rec ctrler offset |
110 -- +-------------------+
111 -- | Ifaces_Table ---> Interface Data
112 -- +-------------------+ +------------+
113 -- Select Specific Data <---- SSD | | Nb_Ifaces |
114 -- +------------------+ +-------------------+ +------------+
115 -- |table of primitive| | table of | | table |
116 -- : operation : : ancestor : : of :
117 -- | kinds | | tags | | interfaces |
118 -- +------------------+ +-------------------+ +------------+
122 -- +------------------+
124 -- Structure of the GNAT Secondary Dispatch Table
126 -- +-----------------------+
128 -- : predefined primitive :
130 -- +-----------------------+
132 -- +-----------------------+
134 -- +-----------------------+
136 -- +-----------------------+
137 -- | OSD_Ptr |---> Object Specific Data
138 -- Tag ---> +-----------------------+ +---------------+
139 -- | table of | | num prim ops |
140 -- : primitive op : +---------------+
141 -- | thunk pointers | | table of |
142 -- +-----------------------+ + primitive |
146 -- The runtime information kept for each tagged type is separated into two
147 -- objects: the Dispatch Table and the Type Specific Data record.
149 package SSE renames System.Storage_Elements;
151 subtype Cstring is String (Positive);
152 type Cstring_Ptr is access all Cstring;
153 pragma No_Strict_Aliasing (Cstring_Ptr);
155 -- Declarations for the table of interfaces
157 type Offset_To_Top_Function_Ptr is
158 access function (This : System.Address) return SSE.Storage_Offset;
159 -- Type definition used to call the function that is generated by the
160 -- expander in case of tagged types with discriminants that have secondary
161 -- dispatch tables. This function provides the Offset_To_Top value in this
164 type Interface_Data_Element is record
166 Static_Offset_To_Top : Boolean;
167 Offset_To_Top_Value : SSE.Storage_Offset;
168 Offset_To_Top_Func : Offset_To_Top_Function_Ptr;
170 -- If some ancestor of the tagged type has discriminants the field
171 -- Static_Offset_To_Top is False and the field Offset_To_Top_Func
172 -- is used to store the access to the function generated by the
173 -- expander which provides this value; otherwise Static_Offset_To_Top
174 -- is True and such value is stored in the Offset_To_Top_Value field.
176 type Interfaces_Array is array (Natural range <>) of Interface_Data_Element;
178 type Interface_Data (Nb_Ifaces : Positive) is record
179 Ifaces_Table : Interfaces_Array (1 .. Nb_Ifaces);
182 type Interface_Data_Ptr is access all Interface_Data;
183 -- Table of abstract interfaces used to give support to backward interface
184 -- conversions and also to IW_Membership.
186 -- Primitive operation kinds. These values differentiate the kinds of
187 -- callable entities stored in the dispatch table. Certain kinds may
188 -- not be used, but are added for completeness.
194 POK_Protected_Function,
195 POK_Protected_Procedure,
200 -- Select specific data types
202 type Select_Specific_Data_Element is record
207 type Select_Specific_Data_Array is
208 array (Positive range <>) of Select_Specific_Data_Element;
210 type Select_Specific_Data (Nb_Prim : Positive) is record
211 SSD_Table : Select_Specific_Data_Array (1 .. Nb_Prim);
212 -- NOTE: Nb_Prim is the number of non-predefined primitive operations
215 type Select_Specific_Data_Ptr is access all Select_Specific_Data;
216 -- A table used to store the primitive operation kind and entry index of
217 -- primitive subprograms of a type that implements a limited interface.
218 -- The Select Specific Data table resides in the Type Specific Data of a
219 -- type. This construct is used in the handling of dispatching triggers
220 -- in select statements.
222 type Tag_Table is array (Natural range <>) of Tag;
224 type Type_Specific_Data (Idepth : Natural) is record
225 -- The discriminant Idepth is the Inheritance Depth Level: Used to
226 -- implement the membership test associated with single inheritance of
227 -- tagged types in constant-time. It also indicates the size of the
228 -- Tags_Table component.
230 Access_Level : Natural;
231 -- Accessibility level required to give support to Ada 2005 nested type
232 -- extensions. This feature allows safe nested type extensions by
233 -- shifting the accessibility checks to certain operations, rather than
234 -- being enforced at the type declaration. In particular, by performing
235 -- run-time accessibility checks on class-wide allocators, class-wide
236 -- function return, and class-wide stream I/O, the danger of objects
237 -- outliving their type declaration can be eliminated (Ada 2005: AI-344)
239 Expanded_Name : Cstring_Ptr;
240 External_Tag : Cstring_Ptr;
242 -- Components used to support to the Ada.Tags subprograms in RM 3.9
244 -- Note: Expanded_Name is referenced by GDB to determine the actual name
245 -- of the tagged type. Its requirements are: 1) it must have this exact
246 -- name, and 2) its contents must point to a C-style Nul terminated
247 -- string containing its expanded name. GDB has no requirement on a
248 -- given position inside the record.
250 Transportable : Boolean;
251 -- Used to check RM E.4(18), set for types that satisfy the requirements
252 -- for being used in remote calls as actuals for classwide formals or as
253 -- return values for classwide functions.
255 RC_Offset : SSE.Storage_Offset;
256 -- Controller Offset: Used to give support to tagged controlled objects
257 -- (see Get_Deep_Controller at s-finimp)
259 Interfaces_Table : Interface_Data_Ptr;
260 -- Pointer to the table of interface tags. It is used to implement the
261 -- membership test associated with interfaces and also for backward
262 -- abstract interface type conversions (Ada 2005:AI-251)
264 SSD : Select_Specific_Data_Ptr;
265 -- Pointer to a table of records used in dispatching selects. This
266 -- field has a meaningful value for all tagged types that implement
267 -- a limited, protected, synchronized or task interfaces and have
268 -- non-predefined primitive operations.
270 Tags_Table : Tag_Table (0 .. Idepth);
271 -- Table of ancestor tags. Its size actually depends on the inheritance
272 -- depth level of the tagged type.
275 type Type_Specific_Data_Ptr is access all Type_Specific_Data;
277 -- Declarations for the dispatch table record
279 type Signature_Kind is
284 -- Tagged type kinds with respect to concurrency and limitedness
287 (TK_Abstract_Limited_Tagged,
294 type Address_Array is array (Positive range <>) of System.Address;
296 type Dispatch_Table_Wrapper (Num_Prims : Natural) is record
297 Signature : Signature_Kind;
298 Tag_Kind : Tagged_Kind;
299 Predef_Prims : System.Address;
300 -- Pointer to the dispatch table of predefined Ada primitives
302 -- According to the C++ ABI the components Offset_To_Top and TSD are
303 -- stored just "before" the dispatch table, and they are referenced with
304 -- negative offsets referring to the base of the dispatch table. The
305 -- _Tag (or the VTable_Ptr in C++ terminology) must point to the base
306 -- of the virtual table, just after these components, to point to the
309 Offset_To_Top : SSE.Storage_Offset;
310 TSD : System.Address;
312 Prims_Ptr : aliased Address_Array (1 .. Num_Prims);
313 -- The size of the Prims_Ptr array actually depends on the tagged type
314 -- to which it applies. For each tagged type, the expander computes the
315 -- actual array size, allocates the Dispatch_Table record accordingly.
318 subtype Dispatch_Table is Address_Array (1 .. 1);
319 -- Used by GDB to identify the _tags and traverse the run-time structure
320 -- associated with tagged types. For compatibility with older versions of
321 -- gdb, its name must not be changed.
323 type Tag is access all Dispatch_Table;
324 type Interface_Tag is access all Dispatch_Table;
326 No_Tag : constant Tag := null;
328 -- The expander ensures that Tag objects reference the Prims_Ptr component
331 type Tag_Ptr is access all Tag;
332 type Dispatch_Table_Ptr is access all Dispatch_Table_Wrapper;
334 -- The following type declaration is used by the compiler when the program
335 -- is compiled with restriction No_Dispatching_Calls. It is also used with
336 -- interface types to generate the tag and run-time information associated
339 type No_Dispatch_Table_Wrapper is record
340 NDT_TSD : System.Address;
341 NDT_Prims_Ptr : Natural;
344 Default_Prim_Op_Count : constant Positive := 15;
345 -- Number of predefined ada primitives: Size, Alignment, Read, Write,
346 -- Input, Output, "=", assignment, deep adjust, deep finalize, async
347 -- select, conditional select, prim_op kind, task_id, and timed select.
349 DT_Predef_Prims_Size : constant SSE.Storage_Count :=
351 (1 * (Standard'Address_Size /
352 System.Storage_Unit));
353 -- Size of the Predef_Prims field of the Dispatch_Table
355 DT_Offset_To_Top_Size : constant SSE.Storage_Count :=
357 (1 * (Standard'Address_Size /
358 System.Storage_Unit));
359 -- Size of the Offset_To_Top field of the Dispatch Table
361 DT_Typeinfo_Ptr_Size : constant SSE.Storage_Count :=
363 (1 * (Standard'Address_Size /
364 System.Storage_Unit));
365 -- Size of the Typeinfo_Ptr field of the Dispatch Table
367 use type System.Storage_Elements.Storage_Offset;
369 DT_Predef_Prims_Offset : constant SSE.Storage_Count :=
371 + DT_Offset_To_Top_Size
372 + DT_Predef_Prims_Size;
373 -- Offset from Prims_Ptr to Predef_Prims component
375 -- Object Specific Data record of secondary dispatch tables
377 type Object_Specific_Data_Array is array (Positive range <>) of Positive;
379 type Object_Specific_Data (OSD_Num_Prims : Positive) is record
380 OSD_Table : Object_Specific_Data_Array (1 .. OSD_Num_Prims);
381 -- Table used in secondary DT to reference their counterpart in the
382 -- select specific data (in the TSD of the primary DT). This construct
383 -- is used in the handling of dispatching triggers in select statements.
384 -- Nb_Prim is the number of non-predefined primitive operations.
387 type Object_Specific_Data_Ptr is access all Object_Specific_Data;
389 -- The following subprogram specifications are placed here instead of
390 -- the package body to see them from the frontend through rtsfind.
392 function Base_Address (This : System.Address) return System.Address;
393 -- Ada 2005 (AI-251): Displace "This" to point to the base address of
394 -- the object (that is, the address of the primary tag of the object).
396 function Displace (This : System.Address; T : Tag) return System.Address;
397 -- Ada 2005 (AI-251): Displace "This" to point to the secondary dispatch
400 function DT (T : Tag) return Dispatch_Table_Ptr;
401 -- Return the pointer to the TSD record associated with T
403 function Get_Entry_Index (T : Tag; Position : Positive) return Positive;
404 -- Ada 2005 (AI-251): Return a primitive operation's entry index (if entry)
405 -- given a dispatch table T and a position of a primitive operation in T.
407 function Get_Offset_Index
409 Position : Positive) return Positive;
410 -- Ada 2005 (AI-251): Given a pointer to a secondary dispatch table (T) and
411 -- a position of an operation in the DT, retrieve the corresponding
412 -- operation's position in the primary dispatch table from the Offset
413 -- Specific Data table of T.
415 function Get_Prim_Op_Kind
417 Position : Positive) return Prim_Op_Kind;
418 -- Ada 2005 (AI-251): Return a primitive operation's kind given a dispatch
419 -- table T and a position of a primitive operation in T.
421 function Get_RC_Offset (T : Tag) return SSE.Storage_Offset;
422 -- Return the Offset of the implicit record controller when the object
423 -- has controlled components, returns zero if no controlled components.
425 pragma Export (Ada, Get_RC_Offset, "ada__tags__get_rc_offset");
426 -- This procedure is used in s-finimp to compute the deep routines
427 -- it is exported manually in order to avoid changing completely the
428 -- organization of the run time.
430 function Get_Tagged_Kind (T : Tag) return Tagged_Kind;
431 -- Ada 2005 (AI-345): Given a pointer to either a primary or a secondary
432 -- dispatch table, return the tagged kind of a type in the context of
433 -- concurrency and limitedness.
435 function IW_Membership (This : System.Address; T : Tag) return Boolean;
436 -- Ada 2005 (AI-251): General routine that checks if a given object
437 -- implements a tagged type. Its common usage is to check if Obj is in
438 -- Iface'Class, but it is also used to check if a class-wide interface
439 -- implements a given type (Iface_CW_Typ in T'Class). For example:
441 -- type I is interface;
442 -- type T is tagged ...
444 -- function Test (O : I'Class) is
446 -- return O in T'Class.
449 function Offset_To_Top
450 (This : System.Address) return SSE.Storage_Offset;
451 -- Ada 2005 (AI-251): Returns the current value of the offset_to_top
452 -- component available in the prologue of the dispatch table. If the parent
453 -- of the tagged type has discriminants this value is stored in a record
454 -- component just immediately after the tag component.
457 (Obj : System.Address;
458 T : Tag) return SSE.Storage_Count;
459 -- Computes the size the ancestor part of a tagged extension object whose
460 -- address is 'obj' by calling indirectly the ancestor _size function. The
461 -- ancestor is the parent of the type represented by tag T. This function
462 -- assumes that _size is always in slot one of the dispatch table.
464 pragma Export (Ada, Parent_Size, "ada__tags__parent_size");
465 -- This procedure is used in s-finimp and is thus exported manually
467 procedure Register_Tag (T : Tag);
468 -- Insert the Tag and its associated external_tag in a table for the
469 -- sake of Internal_Tag
471 procedure Set_Entry_Index (T : Tag; Position : Positive; Value : Positive);
472 -- Ada 2005 (AI-345): Set the entry index of a primitive operation in T's
473 -- TSD table indexed by Position.
475 procedure Set_Offset_To_Top
476 (This : System.Address;
479 Offset_Value : SSE.Storage_Offset;
480 Offset_Func : Offset_To_Top_Function_Ptr);
481 -- Ada 2005 (AI-251): Initialize the Offset_To_Top field in the prologue of
482 -- the dispatch table. In primary dispatch tables the value of "This" is
483 -- not required (and the compiler passes always the Null_Address value) and
484 -- the Offset_Value is always cero; in secondary dispatch tables "This"
485 -- points to the object, Interface_T is the interface for which the
486 -- secondary dispatch table is being initialized, and Offset_Value is the
487 -- distance from "This" to the object component containing the tag of the
488 -- secondary dispatch table.
490 procedure Set_Prim_Op_Kind
493 Value : Prim_Op_Kind);
494 -- Ada 2005 (AI-251): Set the kind of a primitive operation in T's TSD
495 -- table indexed by Position.
497 -- Unchecked Conversions
499 Max_Predef_Prims : constant Natural := 16;
500 -- Compiler should check this constant is OK ???
502 subtype Predef_Prims_Table is Address_Array (1 .. Max_Predef_Prims);
503 type Predef_Prims_Table_Ptr is access Predef_Prims_Table;
505 type Addr_Ptr is access System.Address;
507 function To_Addr_Ptr is
508 new Ada.Unchecked_Conversion (System.Address, Addr_Ptr);
510 function To_Address is
511 new Ada.Unchecked_Conversion (Tag, System.Address);
513 function To_Dispatch_Table_Ptr is
514 new Ada.Unchecked_Conversion (Tag, Dispatch_Table_Ptr);
516 function To_Dispatch_Table_Ptr is
517 new Ada.Unchecked_Conversion (System.Address, Dispatch_Table_Ptr);
519 function To_Object_Specific_Data_Ptr is
520 new Ada.Unchecked_Conversion (System.Address, Object_Specific_Data_Ptr);
522 function To_Predef_Prims_Table_Ptr is
523 new Ada.Unchecked_Conversion (System.Address, Predef_Prims_Table_Ptr);
525 function To_Tag_Ptr is
526 new Ada.Unchecked_Conversion (System.Address, Tag_Ptr);
528 function To_Type_Specific_Data_Ptr is
529 new Ada.Unchecked_Conversion (System.Address, Type_Specific_Data_Ptr);
531 -- Primitive dispatching operations are always inlined, to facilitate use
532 -- in a minimal/no run-time environment for high integrity use.
534 pragma Inline_Always (Displace);
535 pragma Inline_Always (IW_Membership);
536 pragma Inline_Always (Get_Entry_Index);
537 pragma Inline_Always (Get_Offset_Index);
538 pragma Inline_Always (Get_Prim_Op_Kind);
539 pragma Inline_Always (Get_Tagged_Kind);
540 pragma Inline_Always (Register_Tag);
541 pragma Inline_Always (Set_Entry_Index);
542 pragma Inline_Always (Set_Offset_To_Top);
543 pragma Inline_Always (Set_Prim_Op_Kind);