1 ------------------------------------------------------------------------------
3 -- GNAT RUN-TIME COMPONENTS --
9 -- Copyright (C) 1992-2017, 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 ------------------------------------------------------------------------------
36 -- For performance analysis, take into account that the operations in this
37 -- package provide the guarantee that all dispatching calls on primitive
38 -- operations of tagged types and interfaces take constant time (in terms
39 -- of source lines executed), that is to say, the cost of these calls is
40 -- independent of the number of primitives of the type or interface, and
41 -- independent of the number of ancestors or interface progenitors that a
42 -- tagged type may have.
44 -- The following subprograms of the public part of this package take constant
45 -- time (in terms of source lines executed):
47 -- Expanded_Name, Wide_Expanded_Name, Wide_Wide_Expanded_Name, External_Tag,
48 -- Is_Abstract, Is_Descendant_At_Same_Level, Parent_Tag,
49 -- Descendant_Tag (when used with a library-level tagged type),
50 -- Internal_Tag (when used with a library-level tagged type).
52 -- The following subprograms of the public part of this package execute in
53 -- time that is not constant (in terms of sources line executed):
55 -- Internal_Tag (when used with a locally defined tagged type), because in
56 -- such cases this routine processes the external tag, extracts from it an
57 -- address available there, and converts it into the tag value returned by
58 -- this function. The number of instructions executed is not constant since
59 -- it depends on the length of the external tag string.
61 -- Descendant_Tag (when used with a locally defined tagged type), because
62 -- it relies on the subprogram Internal_Tag() to provide its functionality.
64 -- Interface_Ancestor_Tags, because this function returns a table whose
65 -- length depends on the number of interfaces covered by a tagged type.
67 with System
.Storage_Elements
;
71 -- In accordance with Ada 2005 AI-362
74 pragma Preelaborable_Initialization
(Tag
);
76 No_Tag
: constant Tag
;
78 function Expanded_Name
(T
: Tag
) return String;
80 function Wide_Expanded_Name
(T
: Tag
) return Wide_String;
81 pragma Ada_05
(Wide_Expanded_Name
);
83 function Wide_Wide_Expanded_Name
(T
: Tag
) return Wide_Wide_String
;
84 pragma Ada_05
(Wide_Wide_Expanded_Name
);
86 function External_Tag
(T
: Tag
) return String;
88 function Internal_Tag
(External
: String) return Tag
;
90 function Descendant_Tag
92 Ancestor
: Tag
) return Tag
;
93 pragma Ada_05
(Descendant_Tag
);
95 function Is_Descendant_At_Same_Level
97 Ancestor
: Tag
) return Boolean;
98 pragma Ada_05
(Is_Descendant_At_Same_Level
);
100 function Parent_Tag
(T
: Tag
) return Tag
;
101 pragma Ada_05
(Parent_Tag
);
103 type Tag_Array
is array (Positive range <>) of Tag
;
105 function Interface_Ancestor_Tags
(T
: Tag
) return Tag_Array
;
106 pragma Ada_05
(Interface_Ancestor_Tags
);
108 function Is_Abstract
(T
: Tag
) return Boolean;
109 pragma Ada_2012
(Is_Abstract
);
111 Tag_Error
: exception;
114 -- Structure of the GNAT Primary Dispatch Table
116 -- +--------------------+
118 -- +--------------------+
120 -- +--------------------+ Predef Prims
121 -- | Predef_Prims -----------------------------> +------------+
122 -- +--------------------+ | table of |
123 -- | Offset_To_Top | | predefined |
124 -- +--------------------+ | primitives |
125 -- |Typeinfo_Ptr/TSD_Ptr---> Type Specific Data +------------+
126 -- Tag ---> +--------------------+ +-------------------+
127 -- | table of | | inheritance depth |
128 -- : primitive ops : +-------------------+
129 -- | pointers | | access level |
130 -- +--------------------+ +-------------------+
132 -- +-------------------+
134 -- +-------------------+
136 -- +-------------------+
137 -- | hash table link |
138 -- +-------------------+
140 -- +-------------------+
142 -- +-------------------+
143 -- | needs finalization|
144 -- +-------------------+
145 -- | Ifaces_Table ---> Interface Data
146 -- +-------------------+ +------------+
147 -- Select Specific Data <---- SSD | | Nb_Ifaces |
148 -- +------------------+ +-------------------+ +------------+
149 -- |table of primitive| | table of | | table |
150 -- : operation : : ancestor : : of :
151 -- | kinds | | tags | | interfaces |
152 -- +------------------+ +-------------------+ +------------+
156 -- +------------------+
158 -- Structure of the GNAT Secondary Dispatch Table
160 -- +--------------------+
162 -- +--------------------+
164 -- +--------------------+ Predef Prims
165 -- | Predef_Prims -----------------------------> +------------+
166 -- +--------------------+ | table of |
167 -- | Offset_To_Top | | predefined |
168 -- +--------------------+ | primitives |
169 -- | OSD_Ptr |---> Object Specific Data | thunks |
170 -- Tag ---> +--------------------+ +---------------+ +------------+
171 -- | table of | | num prim ops |
172 -- : primitive op : +---------------+
173 -- | thunk pointers | | table of |
174 -- +--------------------+ + primitive |
178 -- The runtime information kept for each tagged type is separated into two
179 -- objects: the Dispatch Table and the Type Specific Data record.
181 package SSE
renames System
.Storage_Elements
;
183 subtype Cstring
is String (Positive);
184 type Cstring_Ptr
is access all Cstring
;
185 pragma No_Strict_Aliasing
(Cstring_Ptr
);
187 -- Declarations for the table of interfaces
189 type Offset_To_Top_Function_Ptr
is
190 access function (This
: System
.Address
) return SSE
.Storage_Offset
;
191 -- Type definition used to call the function that is generated by the
192 -- expander in case of tagged types with discriminants that have secondary
193 -- dispatch tables. This function provides the Offset_To_Top value in this
196 type Interface_Data_Element
is record
198 Static_Offset_To_Top
: Boolean;
199 Offset_To_Top_Value
: SSE
.Storage_Offset
;
200 Offset_To_Top_Func
: Offset_To_Top_Function_Ptr
;
203 -- If some ancestor of the tagged type has discriminants the field
204 -- Static_Offset_To_Top is False and the field Offset_To_Top_Func
205 -- is used to store the access to the function generated by the
206 -- expander which provides this value; otherwise Static_Offset_To_Top
207 -- is True and such value is stored in the Offset_To_Top_Value field.
208 -- Secondary_DT references a secondary dispatch table whose contents
209 -- are pointers to the primitives of the tagged type that cover the
210 -- interface primitives. Secondary_DT gives support to dispatching
211 -- calls through interface types associated with Generic Dispatching
214 type Interfaces_Array
is array (Natural range <>) of Interface_Data_Element
;
216 type Interface_Data
(Nb_Ifaces
: Positive) is record
217 Ifaces_Table
: Interfaces_Array
(1 .. Nb_Ifaces
);
220 type Interface_Data_Ptr
is access all Interface_Data
;
221 -- Table of abstract interfaces used to give support to backward interface
222 -- conversions and also to IW_Membership.
224 -- Primitive operation kinds. These values differentiate the kinds of
225 -- callable entities stored in the dispatch table. Certain kinds may
226 -- not be used, but are added for completeness.
232 POK_Protected_Function
,
233 POK_Protected_Procedure
,
238 -- Select specific data types
240 type Select_Specific_Data_Element
is record
245 type Select_Specific_Data_Array
is
246 array (Positive range <>) of Select_Specific_Data_Element
;
248 type Select_Specific_Data
(Nb_Prim
: Positive) is record
249 SSD_Table
: Select_Specific_Data_Array
(1 .. Nb_Prim
);
250 -- NOTE: Nb_Prim is the number of non-predefined primitive operations
253 type Select_Specific_Data_Ptr
is access all Select_Specific_Data
;
254 -- A table used to store the primitive operation kind and entry index of
255 -- primitive subprograms of a type that implements a limited interface.
256 -- The Select Specific Data table resides in the Type Specific Data of a
257 -- type. This construct is used in the handling of dispatching triggers
258 -- in select statements.
260 type Prim_Ptr
is access procedure;
261 type Address_Array
is array (Positive range <>) of Prim_Ptr
;
263 subtype Dispatch_Table
is Address_Array
(1 .. 1);
264 -- Used by GDB to identify the _tags and traverse the run-time structure
265 -- associated with tagged types. For compatibility with older versions of
266 -- gdb, its name must not be changed.
268 type Tag
is access all Dispatch_Table
;
269 pragma No_Strict_Aliasing
(Tag
);
271 type Interface_Tag
is access all Dispatch_Table
;
273 No_Tag
: constant Tag
:= null;
275 -- The expander ensures that Tag objects reference the Prims_Ptr component
278 type Tag_Ptr
is access all Tag
;
279 pragma No_Strict_Aliasing
(Tag_Ptr
);
281 type Offset_To_Top_Ptr
is access all SSE
.Storage_Offset
;
282 pragma No_Strict_Aliasing
(Offset_To_Top_Ptr
);
284 type Tag_Table
is array (Natural range <>) of Tag
;
287 access function (A
: System
.Address
) return Long_Long_Integer;
289 type Type_Specific_Data
(Idepth
: Natural) is record
290 -- The discriminant Idepth is the Inheritance Depth Level: Used to
291 -- implement the membership test associated with single inheritance of
292 -- tagged types in constant-time. It also indicates the size of the
293 -- Tags_Table component.
295 Access_Level
: Natural;
296 -- Accessibility level required to give support to Ada 2005 nested type
297 -- extensions. This feature allows safe nested type extensions by
298 -- shifting the accessibility checks to certain operations, rather than
299 -- being enforced at the type declaration. In particular, by performing
300 -- run-time accessibility checks on class-wide allocators, class-wide
301 -- function return, and class-wide stream I/O, the danger of objects
302 -- outliving their type declaration can be eliminated (Ada 2005: AI-344)
305 Expanded_Name
: Cstring_Ptr
;
306 External_Tag
: Cstring_Ptr
;
308 -- Components used to support to the Ada.Tags subprograms in RM 3.9
310 -- Note: Expanded_Name is referenced by GDB to determine the actual name
311 -- of the tagged type. Its requirements are: 1) it must have this exact
312 -- name, and 2) its contents must point to a C-style Nul terminated
313 -- string containing its expanded name. GDB has no requirement on a
314 -- given position inside the record.
316 Transportable
: Boolean;
317 -- Used to check RM E.4(18), set for types that satisfy the requirements
318 -- for being used in remote calls as actuals for classwide formals or as
319 -- return values for classwide functions.
321 Is_Abstract
: Boolean;
322 -- True if the type is abstract (Ada 2012: AI05-0173)
324 Needs_Finalization
: Boolean;
325 -- Used to dynamically check whether an object is controlled or not
327 Size_Func
: Size_Ptr
;
328 -- Pointer to the subprogram computing the _size of the object. Used by
329 -- the run-time whenever a call to the 'size primitive is required. We
330 -- cannot assume that the contents of dispatch tables are addresses
331 -- because in some architectures the ABI allows descriptors.
333 Interfaces_Table
: Interface_Data_Ptr
;
334 -- Pointer to the table of interface tags. It is used to implement the
335 -- membership test associated with interfaces and also for backward
336 -- abstract interface type conversions (Ada 2005:AI-251)
338 SSD
: Select_Specific_Data_Ptr
;
339 -- Pointer to a table of records used in dispatching selects. This field
340 -- has a meaningful value for all tagged types that implement a limited,
341 -- protected, synchronized or task interfaces and have non-predefined
342 -- primitive operations.
344 Tags_Table
: Tag_Table
(0 .. Idepth
);
345 -- Table of ancestor tags. Its size actually depends on the inheritance
346 -- depth level of the tagged type.
349 type Type_Specific_Data_Ptr
is access all Type_Specific_Data
;
350 pragma No_Strict_Aliasing
(Type_Specific_Data_Ptr
);
352 -- Declarations for the dispatch table record
354 type Signature_Kind
is
359 -- Tagged type kinds with respect to concurrency and limitedness
362 (TK_Abstract_Limited_Tagged
,
369 type Dispatch_Table_Wrapper
(Num_Prims
: Natural) is record
370 Signature
: Signature_Kind
;
371 Tag_Kind
: Tagged_Kind
;
372 Predef_Prims
: System
.Address
;
373 -- Pointer to the dispatch table of predefined Ada primitives
375 -- According to the C++ ABI the components Offset_To_Top and TSD are
376 -- stored just "before" the dispatch table, and they are referenced with
377 -- negative offsets referring to the base of the dispatch table. The
378 -- _Tag (or the VTable_Ptr in C++ terminology) must point to the base
379 -- of the virtual table, just after these components, to point to the
382 Offset_To_Top
: SSE
.Storage_Offset
;
383 -- Offset between the _Tag field and the field that contains the
384 -- reference to this dispatch table. For primary dispatch tables it is
385 -- zero. For secondary dispatch tables: if the parent record type (if
386 -- any) has a compile-time-known size, then Offset_To_Top contains the
387 -- expected value, otherwise it contains SSE.Storage_Offset'Last and the
388 -- actual offset is to be found in the tagged record, right after the
389 -- field that contains the reference to this dispatch table. See the
390 -- implementation of Ada.Tags.Offset_To_Top for the corresponding logic.
392 TSD
: System
.Address
;
394 Prims_Ptr
: aliased Address_Array
(1 .. Num_Prims
);
395 -- The size of the Prims_Ptr array actually depends on the tagged type
396 -- to which it applies. For each tagged type, the expander computes the
397 -- actual array size, allocating the Dispatch_Table record accordingly.
400 type Dispatch_Table_Ptr
is access all Dispatch_Table_Wrapper
;
401 pragma No_Strict_Aliasing
(Dispatch_Table_Ptr
);
403 -- The following type declaration is used by the compiler when the program
404 -- is compiled with restriction No_Dispatching_Calls. It is also used with
405 -- interface types to generate the tag and run-time information associated
408 type No_Dispatch_Table_Wrapper
is record
409 NDT_TSD
: System
.Address
;
410 NDT_Prims_Ptr
: Natural;
413 DT_Predef_Prims_Size
: constant SSE
.Storage_Count
:=
415 (1 * (Standard
'Address_Size /
416 System
.Storage_Unit
));
417 -- Size of the Predef_Prims field of the Dispatch_Table
419 DT_Offset_To_Top_Size
: constant SSE
.Storage_Count
:=
421 (1 * (Standard
'Address_Size /
422 System
.Storage_Unit
));
423 -- Size of the Offset_To_Top field of the Dispatch Table
425 DT_Typeinfo_Ptr_Size
: constant SSE
.Storage_Count
:=
427 (1 * (Standard
'Address_Size /
428 System
.Storage_Unit
));
429 -- Size of the Typeinfo_Ptr field of the Dispatch Table
431 use type System
.Storage_Elements
.Storage_Offset
;
433 DT_Offset_To_Top_Offset
: constant SSE
.Storage_Count
:=
435 + DT_Offset_To_Top_Size
;
437 DT_Predef_Prims_Offset
: constant SSE
.Storage_Count
:=
439 + DT_Offset_To_Top_Size
440 + DT_Predef_Prims_Size
;
441 -- Offset from Prims_Ptr to Predef_Prims component
443 -- Object Specific Data record of secondary dispatch tables
445 type Object_Specific_Data_Array
is array (Positive range <>) of Positive;
447 type Object_Specific_Data
(OSD_Num_Prims
: Positive) is record
448 OSD_Table
: Object_Specific_Data_Array
(1 .. OSD_Num_Prims
);
449 -- Table used in secondary DT to reference their counterpart in the
450 -- select specific data (in the TSD of the primary DT). This construct
451 -- is used in the handling of dispatching triggers in select statements.
452 -- Nb_Prim is the number of non-predefined primitive operations.
455 type Object_Specific_Data_Ptr
is access all Object_Specific_Data
;
456 pragma No_Strict_Aliasing
(Object_Specific_Data_Ptr
);
458 -- The following subprogram specifications are placed here instead of the
459 -- package body to see them from the frontend through rtsfind.
461 function Base_Address
(This
: System
.Address
) return System
.Address
;
462 -- Ada 2005 (AI-251): Displace "This" to point to the base address of the
463 -- object (that is, the address of the primary tag of the object).
465 procedure Check_TSD
(TSD
: Type_Specific_Data_Ptr
);
466 -- Ada 2012 (AI-113): Raise Program_Error if the external tag of this TSD
467 -- is the same as the external tag for some other tagged type declaration.
469 function Displace
(This
: System
.Address
; T
: Tag
) return System
.Address
;
470 -- Ada 2005 (AI-251): Displace "This" to point to the secondary dispatch
473 function Secondary_Tag
(T
, Iface
: Tag
) return Tag
;
474 -- Ada 2005 (AI-251): Given a primary tag T associated with a tagged type
475 -- Typ, search for the secondary tag of the interface type Iface covered
478 function DT
(T
: Tag
) return Dispatch_Table_Ptr
;
479 -- Return the pointer to the TSD record associated with T
481 function Get_Entry_Index
(T
: Tag
; Position
: Positive) return Positive;
482 -- Ada 2005 (AI-251): Return a primitive operation's entry index (if entry)
483 -- given a dispatch table T and a position of a primitive operation in T.
485 function Get_Offset_Index
487 Position
: Positive) return Positive;
488 -- Ada 2005 (AI-251): Given a pointer to a secondary dispatch table (T)
489 -- and a position of an operation in the DT, retrieve the corresponding
490 -- operation's position in the primary dispatch table from the Offset
491 -- Specific Data table of T.
493 function Get_Prim_Op_Kind
495 Position
: Positive) return Prim_Op_Kind
;
496 -- Ada 2005 (AI-251): Return a primitive operation's kind given a dispatch
497 -- table T and a position of a primitive operation in T.
499 function Get_Tagged_Kind
(T
: Tag
) return Tagged_Kind
;
500 -- Ada 2005 (AI-345): Given a pointer to either a primary or a secondary
501 -- dispatch table, return the tagged kind of a type in the context of
502 -- concurrency and limitedness.
504 function IW_Membership
(This
: System
.Address
; T
: Tag
) return Boolean;
505 -- Ada 2005 (AI-251): General routine that checks if a given object
506 -- implements a tagged type. Its common usage is to check if Obj is in
507 -- Iface'Class, but it is also used to check if a class-wide interface
508 -- implements a given type (Iface_CW_Typ in T'Class). For example:
510 -- type I is interface;
511 -- type T is tagged ...
513 -- function Test (O : I'Class) is
515 -- return O in T'Class.
518 function Offset_To_Top
519 (This
: System
.Address
) return SSE
.Storage_Offset
;
520 -- Ada 2005 (AI-251): Returns the current value of the Offset_To_Top
521 -- component available in the prologue of the dispatch table. If the parent
522 -- of the tagged type has discriminants this value is stored in a record
523 -- component just immediately after the tag component.
525 function Needs_Finalization
(T
: Tag
) return Boolean;
526 -- A helper routine used in conjunction with finalization collections which
527 -- service class-wide types. The function dynamically determines whether an
528 -- object is controlled or has controlled components.
531 (Obj
: System
.Address
;
532 T
: Tag
) return SSE
.Storage_Count
;
533 -- Computes the size the ancestor part of a tagged extension object whose
534 -- address is 'obj' by calling indirectly the ancestor _size function. The
535 -- ancestor is the parent of the type represented by tag T. This function
536 -- assumes that _size is always in slot one of the dispatch table.
538 procedure Register_Interface_Offset
542 Offset_Value
: SSE
.Storage_Offset
;
543 Offset_Func
: Offset_To_Top_Function_Ptr
);
544 -- Register in the table of interfaces of the tagged type associated with
545 -- Prim_T the offset of the record component associated with the progenitor
546 -- Interface_T (that is, the distance from "This" to the object component
547 -- containing the tag of the secondary dispatch table). In case of constant
548 -- offset, Is_Static is true and Offset_Value has such value. In case of
549 -- variable offset, Is_Static is false and Offset_Func is an access to
550 -- function that must be called to evaluate the offset.
552 procedure Register_Tag
(T
: Tag
);
553 -- Insert the Tag and its associated external_tag in a table for the sake
556 procedure Set_Dynamic_Offset_To_Top
557 (This
: System
.Address
;
560 Offset_Value
: SSE
.Storage_Offset
;
561 Offset_Func
: Offset_To_Top_Function_Ptr
);
562 -- Ada 2005 (AI-251): The compiler generates calls to this routine only
563 -- when initializing the Offset_To_Top field of dispatch tables of tagged
564 -- types that cover interface types whose parent type has variable size
567 -- "This" is the object whose dispatch table is being initialized. Prim_T
568 -- is the primary tag of such object. Interface_T is the interface tag for
569 -- which the secondary dispatch table is being initialized. Offset_Value
570 -- is the distance from "This" to the object component containing the tag
571 -- of the secondary dispatch table (a zero value means that this interface
572 -- shares the primary dispatch table). Offset_Func references a function
573 -- that must be called to evaluate the offset at run time. This routine
574 -- also takes care of registering these values in the table of interfaces
577 procedure Set_Entry_Index
(T
: Tag
; Position
: Positive; Value
: Positive);
578 -- Ada 2005 (AI-345): Set the entry index of a primitive operation in T's
579 -- TSD table indexed by Position.
581 procedure Set_Prim_Op_Kind
584 Value
: Prim_Op_Kind
);
585 -- Ada 2005 (AI-251): Set the kind of a primitive operation in T's TSD
586 -- table indexed by Position.
588 procedure Unregister_Tag
(T
: Tag
);
589 -- Remove a particular tag from the external tag hash table
591 Max_Predef_Prims
: constant Positive := 15;
592 -- Number of reserved slots for the following predefined ada primitives:
604 -- 11. conditional select
607 -- 14. dispatching requeue
610 -- The compiler checks that the value here is correct
612 subtype Predef_Prims_Table
is Address_Array
(1 .. Max_Predef_Prims
);
613 type Predef_Prims_Table_Ptr
is access Predef_Prims_Table
;
614 pragma No_Strict_Aliasing
(Predef_Prims_Table_Ptr
);
616 type Addr_Ptr
is access System
.Address
;
617 pragma No_Strict_Aliasing
(Addr_Ptr
);
618 -- This type is used by the frontend to generate the code that handles
619 -- dispatch table slots of types declared at the local level.