1 ------------------------------------------------------------------------------
3 -- GNAT RUN-TIME COMPONENTS --
9 -- Copyright (C) 1992-2011, 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 function Type_Is_Abstract
(T
: Tag
) return Boolean;
79 pragma Ada_2012
(Type_Is_Abstract
);
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 -- +-------------------+
106 -- +-------------------+
107 -- | hash table link |
108 -- +-------------------+
110 -- +-------------------+
111 -- | type_is_abstract |
112 -- +-------------------+
113 -- | needs finalization|
114 -- +-------------------+
115 -- | Ifaces_Table ---> Interface Data
116 -- +-------------------+ +------------+
117 -- Select Specific Data <---- SSD | | Nb_Ifaces |
118 -- +------------------+ +-------------------+ +------------+
119 -- |table of primitive| | table of | | table |
120 -- : operation : : ancestor : : of :
121 -- | kinds | | tags | | interfaces |
122 -- +------------------+ +-------------------+ +------------+
126 -- +------------------+
128 -- Structure of the GNAT Secondary Dispatch Table
130 -- +--------------------+
132 -- +--------------------+
134 -- +--------------------+ Predef Prims
135 -- | Predef_Prims -----------------------------> +------------+
136 -- +--------------------+ | table of |
137 -- | Offset_To_Top | | predefined |
138 -- +--------------------+ | primitives |
139 -- | OSD_Ptr |---> Object Specific Data | thunks |
140 -- Tag ---> +--------------------+ +---------------+ +------------+
141 -- | table of | | num prim ops |
142 -- : primitive op : +---------------+
143 -- | thunk pointers | | table of |
144 -- +--------------------+ + primitive |
148 -- The runtime information kept for each tagged type is separated into two
149 -- objects: the Dispatch Table and the Type Specific Data record.
151 package SSE
renames System
.Storage_Elements
;
153 subtype Cstring
is String (Positive);
154 type Cstring_Ptr
is access all Cstring
;
155 pragma No_Strict_Aliasing
(Cstring_Ptr
);
157 -- Declarations for the table of interfaces
159 type Offset_To_Top_Function_Ptr
is
160 access function (This
: System
.Address
) return SSE
.Storage_Offset
;
161 -- Type definition used to call the function that is generated by the
162 -- expander in case of tagged types with discriminants that have secondary
163 -- dispatch tables. This function provides the Offset_To_Top value in this
166 type Interface_Data_Element
is record
168 Static_Offset_To_Top
: Boolean;
169 Offset_To_Top_Value
: SSE
.Storage_Offset
;
170 Offset_To_Top_Func
: Offset_To_Top_Function_Ptr
;
173 -- If some ancestor of the tagged type has discriminants the field
174 -- Static_Offset_To_Top is False and the field Offset_To_Top_Func
175 -- is used to store the access to the function generated by the
176 -- expander which provides this value; otherwise Static_Offset_To_Top
177 -- is True and such value is stored in the Offset_To_Top_Value field.
178 -- Secondary_DT references a secondary dispatch table whose contents
179 -- are pointers to the primitives of the tagged type that cover the
180 -- interface primitives. Secondary_DT gives support to dispatching
181 -- calls through interface types associated with Generic Dispatching
184 type Interfaces_Array
is array (Natural range <>) of Interface_Data_Element
;
186 type Interface_Data
(Nb_Ifaces
: Positive) is record
187 Ifaces_Table
: Interfaces_Array
(1 .. Nb_Ifaces
);
190 type Interface_Data_Ptr
is access all Interface_Data
;
191 -- Table of abstract interfaces used to give support to backward interface
192 -- conversions and also to IW_Membership.
194 -- Primitive operation kinds. These values differentiate the kinds of
195 -- callable entities stored in the dispatch table. Certain kinds may
196 -- not be used, but are added for completeness.
202 POK_Protected_Function
,
203 POK_Protected_Procedure
,
208 -- Select specific data types
210 type Select_Specific_Data_Element
is record
215 type Select_Specific_Data_Array
is
216 array (Positive range <>) of Select_Specific_Data_Element
;
218 type Select_Specific_Data
(Nb_Prim
: Positive) is record
219 SSD_Table
: Select_Specific_Data_Array
(1 .. Nb_Prim
);
220 -- NOTE: Nb_Prim is the number of non-predefined primitive operations
223 type Select_Specific_Data_Ptr
is access all Select_Specific_Data
;
224 -- A table used to store the primitive operation kind and entry index of
225 -- primitive subprograms of a type that implements a limited interface.
226 -- The Select Specific Data table resides in the Type Specific Data of a
227 -- type. This construct is used in the handling of dispatching triggers
228 -- in select statements.
230 type Prim_Ptr
is access procedure;
231 type Address_Array
is array (Positive range <>) of Prim_Ptr
;
233 subtype Dispatch_Table
is Address_Array
(1 .. 1);
234 -- Used by GDB to identify the _tags and traverse the run-time structure
235 -- associated with tagged types. For compatibility with older versions of
236 -- gdb, its name must not be changed.
238 type Tag
is access all Dispatch_Table
;
239 pragma No_Strict_Aliasing
(Tag
);
241 type Interface_Tag
is access all Dispatch_Table
;
243 No_Tag
: constant Tag
:= null;
245 -- The expander ensures that Tag objects reference the Prims_Ptr component
248 type Tag_Ptr
is access all Tag
;
249 pragma No_Strict_Aliasing
(Tag_Ptr
);
251 type Offset_To_Top_Ptr
is access all SSE
.Storage_Offset
;
252 pragma No_Strict_Aliasing
(Offset_To_Top_Ptr
);
254 type Tag_Table
is array (Natural range <>) of Tag
;
257 access function (A
: System
.Address
) return Long_Long_Integer;
259 type Type_Specific_Data
(Idepth
: Natural) is record
260 -- The discriminant Idepth is the Inheritance Depth Level: Used to
261 -- implement the membership test associated with single inheritance of
262 -- tagged types in constant-time. It also indicates the size of the
263 -- Tags_Table component.
265 Access_Level
: Natural;
266 -- Accessibility level required to give support to Ada 2005 nested type
267 -- extensions. This feature allows safe nested type extensions by
268 -- shifting the accessibility checks to certain operations, rather than
269 -- being enforced at the type declaration. In particular, by performing
270 -- run-time accessibility checks on class-wide allocators, class-wide
271 -- function return, and class-wide stream I/O, the danger of objects
272 -- outliving their type declaration can be eliminated (Ada 2005: AI-344)
275 Expanded_Name
: Cstring_Ptr
;
276 External_Tag
: Cstring_Ptr
;
278 -- Components used to support to the Ada.Tags subprograms in RM 3.9
280 -- Note: Expanded_Name is referenced by GDB to determine the actual name
281 -- of the tagged type. Its requirements are: 1) it must have this exact
282 -- name, and 2) its contents must point to a C-style Nul terminated
283 -- string containing its expanded name. GDB has no requirement on a
284 -- given position inside the record.
286 Transportable
: Boolean;
287 -- Used to check RM E.4(18), set for types that satisfy the requirements
288 -- for being used in remote calls as actuals for classwide formals or as
289 -- return values for classwide functions.
291 Type_Is_Abstract
: Boolean;
292 -- True if the type is abstract (Ada 2012: AI05-0173)
294 Needs_Finalization
: Boolean;
295 -- Used to dynamically check whether an object is controlled or not
297 Size_Func
: Size_Ptr
;
298 -- Pointer to the subprogram computing the _size of the object. Used by
299 -- the run-time whenever a call to the 'size primitive is required. We
300 -- cannot assume that the contents of dispatch tables are addresses
301 -- because in some architectures the ABI allows descriptors.
303 Interfaces_Table
: Interface_Data_Ptr
;
304 -- Pointer to the table of interface tags. It is used to implement the
305 -- membership test associated with interfaces and also for backward
306 -- abstract interface type conversions (Ada 2005:AI-251)
308 SSD
: Select_Specific_Data_Ptr
;
309 -- Pointer to a table of records used in dispatching selects. This field
310 -- has a meaningful value for all tagged types that implement a limited,
311 -- protected, synchronized or task interfaces and have non-predefined
312 -- primitive operations.
314 Tags_Table
: Tag_Table
(0 .. Idepth
);
315 -- Table of ancestor tags. Its size actually depends on the inheritance
316 -- depth level of the tagged type.
319 type Type_Specific_Data_Ptr
is access all Type_Specific_Data
;
320 pragma No_Strict_Aliasing
(Type_Specific_Data_Ptr
);
322 -- Declarations for the dispatch table record
324 type Signature_Kind
is
329 -- Tagged type kinds with respect to concurrency and limitedness
332 (TK_Abstract_Limited_Tagged
,
339 type Dispatch_Table_Wrapper
(Num_Prims
: Natural) is record
340 Signature
: Signature_Kind
;
341 Tag_Kind
: Tagged_Kind
;
342 Predef_Prims
: System
.Address
;
343 -- Pointer to the dispatch table of predefined Ada primitives
345 -- According to the C++ ABI the components Offset_To_Top and TSD are
346 -- stored just "before" the dispatch table, and they are referenced with
347 -- negative offsets referring to the base of the dispatch table. The
348 -- _Tag (or the VTable_Ptr in C++ terminology) must point to the base
349 -- of the virtual table, just after these components, to point to the
352 Offset_To_Top
: SSE
.Storage_Offset
;
353 TSD
: System
.Address
;
355 Prims_Ptr
: aliased Address_Array
(1 .. Num_Prims
);
356 -- The size of the Prims_Ptr array actually depends on the tagged type
357 -- to which it applies. For each tagged type, the expander computes the
358 -- actual array size, allocates the Dispatch_Table record accordingly.
361 type Dispatch_Table_Ptr
is access all Dispatch_Table_Wrapper
;
362 pragma No_Strict_Aliasing
(Dispatch_Table_Ptr
);
364 -- The following type declaration is used by the compiler when the program
365 -- is compiled with restriction No_Dispatching_Calls. It is also used with
366 -- interface types to generate the tag and run-time information associated
369 type No_Dispatch_Table_Wrapper
is record
370 NDT_TSD
: System
.Address
;
371 NDT_Prims_Ptr
: Natural;
374 DT_Predef_Prims_Size
: constant SSE
.Storage_Count
:=
376 (1 * (Standard
'Address_Size /
377 System
.Storage_Unit
));
378 -- Size of the Predef_Prims field of the Dispatch_Table
380 DT_Offset_To_Top_Size
: constant SSE
.Storage_Count
:=
382 (1 * (Standard
'Address_Size /
383 System
.Storage_Unit
));
384 -- Size of the Offset_To_Top field of the Dispatch Table
386 DT_Typeinfo_Ptr_Size
: constant SSE
.Storage_Count
:=
388 (1 * (Standard
'Address_Size /
389 System
.Storage_Unit
));
390 -- Size of the Typeinfo_Ptr field of the Dispatch Table
392 use type System
.Storage_Elements
.Storage_Offset
;
394 DT_Offset_To_Top_Offset
: constant SSE
.Storage_Count
:=
396 + DT_Offset_To_Top_Size
;
398 DT_Predef_Prims_Offset
: constant SSE
.Storage_Count
:=
400 + DT_Offset_To_Top_Size
401 + DT_Predef_Prims_Size
;
402 -- Offset from Prims_Ptr to Predef_Prims component
404 -- Object Specific Data record of secondary dispatch tables
406 type Object_Specific_Data_Array
is array (Positive range <>) of Positive;
408 type Object_Specific_Data
(OSD_Num_Prims
: Positive) is record
409 OSD_Table
: Object_Specific_Data_Array
(1 .. OSD_Num_Prims
);
410 -- Table used in secondary DT to reference their counterpart in the
411 -- select specific data (in the TSD of the primary DT). This construct
412 -- is used in the handling of dispatching triggers in select statements.
413 -- Nb_Prim is the number of non-predefined primitive operations.
416 type Object_Specific_Data_Ptr
is access all Object_Specific_Data
;
417 pragma No_Strict_Aliasing
(Object_Specific_Data_Ptr
);
419 -- The following subprogram specifications are placed here instead of the
420 -- package body to see them from the frontend through rtsfind.
422 function Base_Address
(This
: System
.Address
) return System
.Address
;
423 -- Ada 2005 (AI-251): Displace "This" to point to the base address of the
424 -- object (that is, the address of the primary tag of the object).
426 procedure Check_TSD
(TSD
: Type_Specific_Data_Ptr
);
427 -- Ada 2012 (AI-113): Raise Program_Error if the external tag of this TSD
428 -- is the same as the external tag for some other tagged type declaration.
430 function Displace
(This
: System
.Address
; T
: Tag
) return System
.Address
;
431 -- Ada 2005 (AI-251): Displace "This" to point to the secondary dispatch
434 function Secondary_Tag
(T
, Iface
: Tag
) return Tag
;
435 -- Ada 2005 (AI-251): Given a primary tag T associated with a tagged type
436 -- Typ, search for the secondary tag of the interface type Iface covered
439 function DT
(T
: Tag
) return Dispatch_Table_Ptr
;
440 -- Return the pointer to the TSD record associated with T
442 function Get_Entry_Index
(T
: Tag
; Position
: Positive) return Positive;
443 -- Ada 2005 (AI-251): Return a primitive operation's entry index (if entry)
444 -- given a dispatch table T and a position of a primitive operation in T.
446 function Get_Offset_Index
448 Position
: Positive) return Positive;
449 -- Ada 2005 (AI-251): Given a pointer to a secondary dispatch table (T)
450 -- and a position of an operation in the DT, retrieve the corresponding
451 -- operation's position in the primary dispatch table from the Offset
452 -- Specific Data table of T.
454 function Get_Prim_Op_Kind
456 Position
: Positive) return Prim_Op_Kind
;
457 -- Ada 2005 (AI-251): Return a primitive operation's kind given a dispatch
458 -- table T and a position of a primitive operation in T.
460 function Get_Tagged_Kind
(T
: Tag
) return Tagged_Kind
;
461 -- Ada 2005 (AI-345): Given a pointer to either a primary or a secondary
462 -- dispatch table, return the tagged kind of a type in the context of
463 -- concurrency and limitedness.
465 function IW_Membership
(This
: System
.Address
; T
: Tag
) return Boolean;
466 -- Ada 2005 (AI-251): General routine that checks if a given object
467 -- implements a tagged type. Its common usage is to check if Obj is in
468 -- Iface'Class, but it is also used to check if a class-wide interface
469 -- implements a given type (Iface_CW_Typ in T'Class). For example:
471 -- type I is interface;
472 -- type T is tagged ...
474 -- function Test (O : I'Class) is
476 -- return O in T'Class.
479 function Offset_To_Top
480 (This
: System
.Address
) return SSE
.Storage_Offset
;
481 -- Ada 2005 (AI-251): Returns the current value of the Offset_To_Top
482 -- component available in the prologue of the dispatch table. If the parent
483 -- of the tagged type has discriminants this value is stored in a record
484 -- component just immediately after the tag component.
486 function Needs_Finalization
(T
: Tag
) return Boolean;
487 -- A helper routine used in conjunction with finalization collections which
488 -- service class-wide types. The function dynamically determines whether an
489 -- object is controlled or has controlled components.
492 (Obj
: System
.Address
;
493 T
: Tag
) return SSE
.Storage_Count
;
494 -- Computes the size the ancestor part of a tagged extension object whose
495 -- address is 'obj' by calling indirectly the ancestor _size function. The
496 -- ancestor is the parent of the type represented by tag T. This function
497 -- assumes that _size is always in slot one of the dispatch table.
499 pragma Export
(Ada
, Parent_Size
, "ada__tags__parent_size");
500 -- This procedure is used in s-finimp and is thus exported manually
502 procedure Register_Interface_Offset
503 (This
: System
.Address
;
506 Offset_Value
: SSE
.Storage_Offset
;
507 Offset_Func
: Offset_To_Top_Function_Ptr
);
508 -- Register in the table of interfaces of the tagged type associated with
509 -- "This" object the offset of the record component associated with the
510 -- progenitor Interface_T (that is, the distance from "This" to the object
511 -- component containing the tag of the secondary dispatch table). In case
512 -- of constant offset, Is_Static is true and Offset_Value has such value.
513 -- In case of variable offset, Is_Static is false and Offset_Func is an
514 -- access to function that must be called to evaluate the offset.
516 procedure Register_Tag
(T
: Tag
);
517 -- Insert the Tag and its associated external_tag in a table for the sake
520 procedure Set_Dynamic_Offset_To_Top
521 (This
: System
.Address
;
523 Offset_Value
: SSE
.Storage_Offset
;
524 Offset_Func
: Offset_To_Top_Function_Ptr
);
525 -- Ada 2005 (AI-251): The compiler generates calls to this routine only
526 -- when initializing the Offset_To_Top field of dispatch tables associated
527 -- with tagged type whose parent has variable size components. "This" is
528 -- the object whose dispatch table is being initialized. Interface_T is the
529 -- interface for which the secondary dispatch table is being initialized,
530 -- and Offset_Value is the distance from "This" to the object component
531 -- containing the tag of the secondary dispatch table (a zero value means
532 -- that this interface shares the primary dispatch table). Offset_Func
533 -- references a function that must be called to evaluate the offset at
534 -- runtime. This routine also takes care of registering these values in
535 -- the table of interfaces of the type.
537 procedure Set_Entry_Index
(T
: Tag
; Position
: Positive; Value
: Positive);
538 -- Ada 2005 (AI-345): Set the entry index of a primitive operation in T's
539 -- TSD table indexed by Position.
541 procedure Set_Prim_Op_Kind
544 Value
: Prim_Op_Kind
);
545 -- Ada 2005 (AI-251): Set the kind of a primitive operation in T's TSD
546 -- table indexed by Position.
548 procedure Unregister_Tag
(T
: Tag
);
549 -- Remove a particular tag from the external tag hash table
551 Max_Predef_Prims
: constant Positive := 15;
552 -- Number of reserved slots for the following predefined ada primitives:
564 -- 11. conditional select
567 -- 14. dispatching requeue
570 -- The compiler checks that the value here is correct
572 subtype Predef_Prims_Table
is Address_Array
(1 .. Max_Predef_Prims
);
573 type Predef_Prims_Table_Ptr
is access Predef_Prims_Table
;
574 pragma No_Strict_Aliasing
(Predef_Prims_Table_Ptr
);
576 type Addr_Ptr
is access System
.Address
;
577 pragma No_Strict_Aliasing
(Addr_Ptr
);
578 -- This type is used by the frontend to generate the code that handles
579 -- dispatch table slots of types declared at the local level.