1 ------------------------------------------------------------------------------
3 -- GNAT RUN-TIME COMPONENTS --
9 -- Copyright (C) 1992-2010, 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 -- +-------------------+
105 -- | hash table link |
106 -- +-------------------+
108 -- +-------------------+
109 -- | type_is_abstract |
110 -- +-------------------+
111 -- | rec ctrler offset |
112 -- +-------------------+
113 -- | Ifaces_Table ---> Interface Data
114 -- +-------------------+ +------------+
115 -- Select Specific Data <---- SSD | | Nb_Ifaces |
116 -- +------------------+ +-------------------+ +------------+
117 -- |table of primitive| | table of | | table |
118 -- : operation : : ancestor : : of :
119 -- | kinds | | tags | | interfaces |
120 -- +------------------+ +-------------------+ +------------+
124 -- +------------------+
126 -- Structure of the GNAT Secondary Dispatch Table
128 -- +--------------------+
130 -- +--------------------+
132 -- +--------------------+ Predef Prims
133 -- | Predef_Prims -----------------------------> +------------+
134 -- +--------------------+ | table of |
135 -- | Offset_To_Top | | predefined |
136 -- +--------------------+ | primitives |
137 -- | OSD_Ptr |---> Object Specific Data | thunks |
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
;
171 -- If some ancestor of the tagged type has discriminants the field
172 -- Static_Offset_To_Top is False and the field Offset_To_Top_Func
173 -- is used to store the access to the function generated by the
174 -- expander which provides this value; otherwise Static_Offset_To_Top
175 -- is True and such value is stored in the Offset_To_Top_Value field.
176 -- Secondary_DT references a secondary dispatch table whose contents
177 -- are pointers to the primitives of the tagged type that cover the
178 -- interface primitives. Secondary_DT gives support to dispatching
179 -- calls through interface types associated with Generic Dispatching
182 type Interfaces_Array
is array (Natural range <>) of Interface_Data_Element
;
184 type Interface_Data
(Nb_Ifaces
: Positive) is record
185 Ifaces_Table
: Interfaces_Array
(1 .. Nb_Ifaces
);
188 type Interface_Data_Ptr
is access all Interface_Data
;
189 -- Table of abstract interfaces used to give support to backward interface
190 -- conversions and also to IW_Membership.
192 -- Primitive operation kinds. These values differentiate the kinds of
193 -- callable entities stored in the dispatch table. Certain kinds may
194 -- not be used, but are added for completeness.
200 POK_Protected_Function
,
201 POK_Protected_Procedure
,
206 -- Select specific data types
208 type Select_Specific_Data_Element
is record
213 type Select_Specific_Data_Array
is
214 array (Positive range <>) of Select_Specific_Data_Element
;
216 type Select_Specific_Data
(Nb_Prim
: Positive) is record
217 SSD_Table
: Select_Specific_Data_Array
(1 .. Nb_Prim
);
218 -- NOTE: Nb_Prim is the number of non-predefined primitive operations
221 type Select_Specific_Data_Ptr
is access all Select_Specific_Data
;
222 -- A table used to store the primitive operation kind and entry index of
223 -- primitive subprograms of a type that implements a limited interface.
224 -- The Select Specific Data table resides in the Type Specific Data of a
225 -- type. This construct is used in the handling of dispatching triggers
226 -- in select statements.
228 type Prim_Ptr
is access procedure;
229 type Address_Array
is array (Positive range <>) of Prim_Ptr
;
231 subtype Dispatch_Table
is Address_Array
(1 .. 1);
232 -- Used by GDB to identify the _tags and traverse the run-time structure
233 -- associated with tagged types. For compatibility with older versions of
234 -- gdb, its name must not be changed.
236 type Tag
is access all Dispatch_Table
;
237 pragma No_Strict_Aliasing
(Tag
);
239 type Interface_Tag
is access all Dispatch_Table
;
241 No_Tag
: constant Tag
:= null;
243 -- The expander ensures that Tag objects reference the Prims_Ptr component
246 type Tag_Ptr
is access all Tag
;
247 pragma No_Strict_Aliasing
(Tag_Ptr
);
249 type Offset_To_Top_Ptr
is access all SSE
.Storage_Offset
;
250 pragma No_Strict_Aliasing
(Offset_To_Top_Ptr
);
252 type Tag_Table
is array (Natural range <>) of Tag
;
255 access function (A
: System
.Address
) return Long_Long_Integer;
257 type Type_Specific_Data
(Idepth
: Natural) is record
258 -- The discriminant Idepth is the Inheritance Depth Level: Used to
259 -- implement the membership test associated with single inheritance of
260 -- tagged types in constant-time. It also indicates the size of the
261 -- Tags_Table component.
263 Access_Level
: Natural;
264 -- Accessibility level required to give support to Ada 2005 nested type
265 -- extensions. This feature allows safe nested type extensions by
266 -- shifting the accessibility checks to certain operations, rather than
267 -- being enforced at the type declaration. In particular, by performing
268 -- run-time accessibility checks on class-wide allocators, class-wide
269 -- function return, and class-wide stream I/O, the danger of objects
270 -- outliving their type declaration can be eliminated (Ada 2005: AI-344)
272 Expanded_Name
: Cstring_Ptr
;
273 External_Tag
: Cstring_Ptr
;
275 -- Components used to support to the Ada.Tags subprograms in RM 3.9
277 -- Note: Expanded_Name is referenced by GDB to determine the actual name
278 -- of the tagged type. Its requirements are: 1) it must have this exact
279 -- name, and 2) its contents must point to a C-style Nul terminated
280 -- string containing its expanded name. GDB has no requirement on a
281 -- given position inside the record.
283 Transportable
: Boolean;
284 -- Used to check RM E.4(18), set for types that satisfy the requirements
285 -- for being used in remote calls as actuals for classwide formals or as
286 -- return values for classwide functions.
288 Type_Is_Abstract
: Boolean;
289 -- True if the type is abstract (Ada 2012: AI05-0173)
291 RC_Offset
: SSE
.Storage_Offset
;
292 -- Controller Offset: Used to give support to tagged controlled objects
293 -- (see Get_Deep_Controller at s-finimp)
295 Size_Func
: Size_Ptr
;
296 -- Pointer to the subprogram computing the _size of the object. Used by
297 -- the run-time whenever a call to the 'size primitive is required. We
298 -- cannot assume that the contents of dispatch tables are addresses
299 -- because in some architectures the ABI allows descriptors.
301 Interfaces_Table
: Interface_Data_Ptr
;
302 -- Pointer to the table of interface tags. It is used to implement the
303 -- membership test associated with interfaces and also for backward
304 -- abstract interface type conversions (Ada 2005:AI-251)
306 SSD
: Select_Specific_Data_Ptr
;
307 -- Pointer to a table of records used in dispatching selects. This
308 -- field has a meaningful value for all tagged types that implement
309 -- a limited, protected, synchronized or task interfaces and have
310 -- non-predefined primitive operations.
312 Tags_Table
: Tag_Table
(0 .. Idepth
);
313 -- Table of ancestor tags. Its size actually depends on the inheritance
314 -- depth level of the tagged type.
317 type Type_Specific_Data_Ptr
is access all Type_Specific_Data
;
318 pragma No_Strict_Aliasing
(Type_Specific_Data_Ptr
);
320 -- Declarations for the dispatch table record
322 type Signature_Kind
is
327 -- Tagged type kinds with respect to concurrency and limitedness
330 (TK_Abstract_Limited_Tagged
,
337 type Dispatch_Table_Wrapper
(Num_Prims
: Natural) is record
338 Signature
: Signature_Kind
;
339 Tag_Kind
: Tagged_Kind
;
340 Predef_Prims
: System
.Address
;
341 -- Pointer to the dispatch table of predefined Ada primitives
343 -- According to the C++ ABI the components Offset_To_Top and TSD are
344 -- stored just "before" the dispatch table, and they are referenced with
345 -- negative offsets referring to the base of the dispatch table. The
346 -- _Tag (or the VTable_Ptr in C++ terminology) must point to the base
347 -- of the virtual table, just after these components, to point to the
350 Offset_To_Top
: SSE
.Storage_Offset
;
351 TSD
: System
.Address
;
353 Prims_Ptr
: aliased Address_Array
(1 .. Num_Prims
);
354 -- The size of the Prims_Ptr array actually depends on the tagged type
355 -- to which it applies. For each tagged type, the expander computes the
356 -- actual array size, allocates the Dispatch_Table record accordingly.
359 type Dispatch_Table_Ptr
is access all Dispatch_Table_Wrapper
;
360 pragma No_Strict_Aliasing
(Dispatch_Table_Ptr
);
362 -- The following type declaration is used by the compiler when the program
363 -- is compiled with restriction No_Dispatching_Calls. It is also used with
364 -- interface types to generate the tag and run-time information associated
367 type No_Dispatch_Table_Wrapper
is record
368 NDT_TSD
: System
.Address
;
369 NDT_Prims_Ptr
: Natural;
372 DT_Predef_Prims_Size
: constant SSE
.Storage_Count
:=
374 (1 * (Standard
'Address_Size /
375 System
.Storage_Unit
));
376 -- Size of the Predef_Prims field of the Dispatch_Table
378 DT_Offset_To_Top_Size
: constant SSE
.Storage_Count
:=
380 (1 * (Standard
'Address_Size /
381 System
.Storage_Unit
));
382 -- Size of the Offset_To_Top field of the Dispatch Table
384 DT_Typeinfo_Ptr_Size
: constant SSE
.Storage_Count
:=
386 (1 * (Standard
'Address_Size /
387 System
.Storage_Unit
));
388 -- Size of the Typeinfo_Ptr field of the Dispatch Table
390 use type System
.Storage_Elements
.Storage_Offset
;
392 DT_Offset_To_Top_Offset
: constant SSE
.Storage_Count
:=
394 + DT_Offset_To_Top_Size
;
396 DT_Predef_Prims_Offset
: constant SSE
.Storage_Count
:=
398 + DT_Offset_To_Top_Size
399 + DT_Predef_Prims_Size
;
400 -- Offset from Prims_Ptr to Predef_Prims component
402 -- Object Specific Data record of secondary dispatch tables
404 type Object_Specific_Data_Array
is array (Positive range <>) of Positive;
406 type Object_Specific_Data
(OSD_Num_Prims
: Positive) is record
407 OSD_Table
: Object_Specific_Data_Array
(1 .. OSD_Num_Prims
);
408 -- Table used in secondary DT to reference their counterpart in the
409 -- select specific data (in the TSD of the primary DT). This construct
410 -- is used in the handling of dispatching triggers in select statements.
411 -- Nb_Prim is the number of non-predefined primitive operations.
414 type Object_Specific_Data_Ptr
is access all Object_Specific_Data
;
415 pragma No_Strict_Aliasing
(Object_Specific_Data_Ptr
);
417 -- The following subprogram specifications are placed here instead of
418 -- the package body to see them from the frontend through rtsfind.
420 function Base_Address
(This
: System
.Address
) return System
.Address
;
421 -- Ada 2005 (AI-251): Displace "This" to point to the base address of
422 -- the object (that is, the address of the primary tag of the object).
424 function Displace
(This
: System
.Address
; T
: Tag
) return System
.Address
;
425 -- Ada 2005 (AI-251): Displace "This" to point to the secondary dispatch
428 function Secondary_Tag
(T
, Iface
: Tag
) return Tag
;
429 -- Ada 2005 (AI-251): Given a primary tag T associated with a tagged type
430 -- Typ, search for the secondary tag of the interface type Iface covered
433 function DT
(T
: Tag
) return Dispatch_Table_Ptr
;
434 -- Return the pointer to the TSD record associated with T
436 function Get_Entry_Index
(T
: Tag
; Position
: Positive) return Positive;
437 -- Ada 2005 (AI-251): Return a primitive operation's entry index (if entry)
438 -- given a dispatch table T and a position of a primitive operation in T.
440 function Get_Offset_Index
442 Position
: Positive) return Positive;
443 -- Ada 2005 (AI-251): Given a pointer to a secondary dispatch table (T) and
444 -- a position of an operation in the DT, retrieve the corresponding
445 -- operation's position in the primary dispatch table from the Offset
446 -- Specific Data table of T.
448 function Get_Prim_Op_Kind
450 Position
: Positive) return Prim_Op_Kind
;
451 -- Ada 2005 (AI-251): Return a primitive operation's kind given a dispatch
452 -- table T and a position of a primitive operation in T.
454 function Get_RC_Offset
(T
: Tag
) return SSE
.Storage_Offset
;
455 -- Return the Offset of the implicit record controller when the object
456 -- has controlled components, returns zero if no controlled components.
458 pragma Export
(Ada
, Get_RC_Offset
, "ada__tags__get_rc_offset");
459 -- This procedure is used in s-finimp to compute the deep routines
460 -- it is exported manually in order to avoid changing completely the
461 -- organization of the run time.
463 function Get_Tagged_Kind
(T
: Tag
) return Tagged_Kind
;
464 -- Ada 2005 (AI-345): Given a pointer to either a primary or a secondary
465 -- dispatch table, return the tagged kind of a type in the context of
466 -- concurrency and limitedness.
468 function IW_Membership
(This
: System
.Address
; T
: Tag
) return Boolean;
469 -- Ada 2005 (AI-251): General routine that checks if a given object
470 -- implements a tagged type. Its common usage is to check if Obj is in
471 -- Iface'Class, but it is also used to check if a class-wide interface
472 -- implements a given type (Iface_CW_Typ in T'Class). For example:
474 -- type I is interface;
475 -- type T is tagged ...
477 -- function Test (O : I'Class) is
479 -- return O in T'Class.
482 function Offset_To_Top
483 (This
: System
.Address
) return SSE
.Storage_Offset
;
484 -- Ada 2005 (AI-251): Returns the current value of the offset_to_top
485 -- component available in the prologue of the dispatch table. If the parent
486 -- of the tagged type has discriminants this value is stored in a record
487 -- component just immediately after the tag component.
490 (Obj
: System
.Address
;
491 T
: Tag
) return SSE
.Storage_Count
;
492 -- Computes the size the ancestor part of a tagged extension object whose
493 -- address is 'obj' by calling indirectly the ancestor _size function. The
494 -- ancestor is the parent of the type represented by tag T. This function
495 -- assumes that _size is always in slot one of the dispatch table.
497 pragma Export
(Ada
, Parent_Size
, "ada__tags__parent_size");
498 -- This procedure is used in s-finimp and is thus exported manually
500 procedure Register_Interface_Offset
501 (This
: System
.Address
;
504 Offset_Value
: SSE
.Storage_Offset
;
505 Offset_Func
: Offset_To_Top_Function_Ptr
);
506 -- Register in the table of interfaces of the tagged type associated with
507 -- "This" object the offset of the record component associated with the
508 -- progenitor Interface_T (that is, the distance from "This" to the object
509 -- component containing the tag of the secondary dispatch table). In case
510 -- of constant offset, Is_Static is true and Offset_Value has such value.
511 -- In case of variable offset, Is_Static is false and Offset_Func is an
512 -- access to function that must be called to evaluate the offset.
514 procedure Register_Tag
(T
: Tag
);
515 -- Insert the Tag and its associated external_tag in a table for the
516 -- sake of Internal_Tag
518 procedure Set_Dynamic_Offset_To_Top
519 (This
: System
.Address
;
521 Offset_Value
: SSE
.Storage_Offset
;
522 Offset_Func
: Offset_To_Top_Function_Ptr
);
523 -- Ada 2005 (AI-251): The compiler generates calls to this routine only
524 -- when initializing the Offset_To_Top field of dispatch tables associated
525 -- with tagged type whose parent has variable size components. "This" is
526 -- the object whose dispatch table is being initialized. Interface_T is the
527 -- interface for which the secondary dispatch table is being initialized,
528 -- and Offset_Value is the distance from "This" to the object component
529 -- containing the tag of the secondary dispatch table (a zero value means
530 -- that this interface shares the primary dispatch table). Offset_Func
531 -- references a function that must be called to evaluate the offset at
532 -- runtime. This routine also takes care of registering these values in
533 -- the table of interfaces of the type.
535 procedure Set_Entry_Index
(T
: Tag
; Position
: Positive; Value
: Positive);
536 -- Ada 2005 (AI-345): Set the entry index of a primitive operation in T's
537 -- TSD table indexed by Position.
539 procedure Set_Prim_Op_Kind
542 Value
: Prim_Op_Kind
);
543 -- Ada 2005 (AI-251): Set the kind of a primitive operation in T's TSD
544 -- table indexed by Position.
546 Max_Predef_Prims
: constant Positive := 16;
547 -- Number of reserved slots for the following predefined ada primitives:
560 -- 12. conditional select
563 -- 15. dispatching requeue
566 -- The compiler checks that the value here is correct
568 subtype Predef_Prims_Table
is Address_Array
(1 .. Max_Predef_Prims
);
569 type Predef_Prims_Table_Ptr
is access Predef_Prims_Table
;
570 pragma No_Strict_Aliasing
(Predef_Prims_Table_Ptr
);
572 type Addr_Ptr
is access System
.Address
;
573 pragma No_Strict_Aliasing
(Addr_Ptr
);
574 -- This type is used by the frontend to generate the code that handles
575 -- dispatch table slots of types declared at the local level.