?  search:
summary | log | graphiclog1 | graphiclog2 | commit | commitdiff | tree | refs | edit | fork
blame | history | raw | HEAD
* dwarf2out.c (compare_loc_descriptor, scompare_loc_descriptor,
[official-gcc.git] / gcc / ada / a-tags.ads
blob42063e26e7ea18482eea040eecfa5921b6ada105
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT RUN-TIME COMPONENTS --
4 -- --
5 -- A D A . T A G S --
6 -- --
7 -- S p e c --
8 -- --
9 -- Copyright (C) 1992-2010, Free Software Foundation, Inc. --
10 -- --
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. --
14 -- --
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. --
21 -- --
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. --
25 -- --
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/>. --
30 -- --
31 -- GNAT was originally developed by the GNAT team at New York University. --
32 -- Extensive contributions were provided by Ada Core Technologies Inc. --
33 -- --
34 ------------------------------------------------------------------------------
35
36 with System;
37 with System.Storage_Elements;
38
39 package Ada.Tags is
40 pragma Preelaborate_05;
41 -- In accordance with Ada 2005 AI-362
42
43 type Tag is private;
44 pragma Preelaborable_Initialization (Tag);
45
46 No_Tag : constant Tag;
47
48 function Expanded_Name (T : Tag) return String;
49
50 function Wide_Expanded_Name (T : Tag) return Wide_String;
51 pragma Ada_05 (Wide_Expanded_Name);
52
53 function Wide_Wide_Expanded_Name (T : Tag) return Wide_Wide_String;
54 pragma Ada_05 (Wide_Wide_Expanded_Name);
55
56 function External_Tag (T : Tag) return String;
57
58 function Internal_Tag (External : String) return Tag;
59
60 function Descendant_Tag
61 (External : String;
62 Ancestor : Tag) return Tag;
63 pragma Ada_05 (Descendant_Tag);
64
65 function Is_Descendant_At_Same_Level
66 (Descendant : Tag;
67 Ancestor : Tag) return Boolean;
68 pragma Ada_05 (Is_Descendant_At_Same_Level);
69
70 function Parent_Tag (T : Tag) return Tag;
71 pragma Ada_05 (Parent_Tag);
72
73 type Tag_Array is array (Positive range <>) of Tag;
74
75 function Interface_Ancestor_Tags (T : Tag) return Tag_Array;
76 pragma Ada_05 (Interface_Ancestor_Tags);
77
78 function Type_Is_Abstract (T : Tag) return Boolean;
79 pragma Ada_2012 (Type_Is_Abstract);
80
81 Tag_Error : exception;
82
83 private
84 -- Structure of the GNAT Primary Dispatch Table
85
86 -- +--------------------+
87 -- | Signature |
88 -- +--------------------+
89 -- | Tagged_Kind |
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 -- +--------------------+ +-------------------+
101 -- | expanded name |
102 -- +-------------------+
103 -- | external tag |
104 -- +-------------------+
105 -- | hash table link |
106 -- +-------------------+
107 -- | transportable |
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 -- +------------------+ +-------------------+ +------------+
121 -- |table of |
122 -- : entry :
123 -- | indexes |
124 -- +------------------+
125
126 -- Structure of the GNAT Secondary Dispatch Table
127
128 -- +--------------------+
129 -- | Signature |
130 -- +--------------------+
131 -- | Tagged_Kind |
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 |
143 -- | op offsets |
144 -- +---------------+
145
146 -- The runtime information kept for each tagged type is separated into two
147 -- objects: the Dispatch Table and the Type Specific Data record.
148
149 package SSE renames System.Storage_Elements;
150
151 subtype Cstring is String (Positive);
152 type Cstring_Ptr is access all Cstring;
153 pragma No_Strict_Aliasing (Cstring_Ptr);
154
155 -- Declarations for the table of interfaces
156
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
162 -- specific case.
163
164 type Interface_Data_Element is record
165 Iface_Tag : Tag;
166 Static_Offset_To_Top : Boolean;
167 Offset_To_Top_Value : SSE.Storage_Offset;
168 Offset_To_Top_Func : Offset_To_Top_Function_Ptr;
169 Secondary_DT : Tag;
170 end record;
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
180 -- Constructors.
181
182 type Interfaces_Array is array (Natural range <>) of Interface_Data_Element;
183
184 type Interface_Data (Nb_Ifaces : Positive) is record
185 Ifaces_Table : Interfaces_Array (1 .. Nb_Ifaces);
186 end record;
187
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.
191
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.
195
196 type Prim_Op_Kind is
197 (POK_Function,
198 POK_Procedure,
199 POK_Protected_Entry,
200 POK_Protected_Function,
201 POK_Protected_Procedure,
202 POK_Task_Entry,
203 POK_Task_Function,
204 POK_Task_Procedure);
205
206 -- Select specific data types
207
208 type Select_Specific_Data_Element is record
209 Index : Positive;
210 Kind : Prim_Op_Kind;
211 end record;
212
213 type Select_Specific_Data_Array is
214 array (Positive range <>) of Select_Specific_Data_Element;
215
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
219 end record;
220
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.
227
228 type Prim_Ptr is access procedure;
229 type Address_Array is array (Positive range <>) of Prim_Ptr;
230
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.
235
236 type Tag is access all Dispatch_Table;
237 pragma No_Strict_Aliasing (Tag);
238
239 type Interface_Tag is access all Dispatch_Table;
240
241 No_Tag : constant Tag := null;
242
243 -- The expander ensures that Tag objects reference the Prims_Ptr component
244 -- of the wrapper.
245
246 type Tag_Ptr is access all Tag;
247 pragma No_Strict_Aliasing (Tag_Ptr);
248
249 type Offset_To_Top_Ptr is access all SSE.Storage_Offset;
250 pragma No_Strict_Aliasing (Offset_To_Top_Ptr);
251
252 type Tag_Table is array (Natural range <>) of Tag;
253
254 type Size_Ptr is
255 access function (A : System.Address) return Long_Long_Integer;
256
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.
262
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)
271
272 Expanded_Name : Cstring_Ptr;
273 External_Tag : Cstring_Ptr;
274 HT_Link : Tag_Ptr;
275 -- Components used to support to the Ada.Tags subprograms in RM 3.9
276
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.
282
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.
287
288 Type_Is_Abstract : Boolean;
289 -- True if the type is abstract (Ada 2012: AI05-0173)
290
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)
294
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.
300
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)
305
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.
311
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.
315 end record;
316
317 type Type_Specific_Data_Ptr is access all Type_Specific_Data;
318 pragma No_Strict_Aliasing (Type_Specific_Data_Ptr);
319
320 -- Declarations for the dispatch table record
321
322 type Signature_Kind is
323 (Unknown,
324 Primary_DT,
325 Secondary_DT);
326
327 -- Tagged type kinds with respect to concurrency and limitedness
328
329 type Tagged_Kind is
330 (TK_Abstract_Limited_Tagged,
331 TK_Abstract_Tagged,
332 TK_Limited_Tagged,
333 TK_Protected,
334 TK_Tagged,
335 TK_Task);
336
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
342
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
348 -- Prims_Ptr table.
349
350 Offset_To_Top : SSE.Storage_Offset;
351 TSD : System.Address;
352
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.
357 end record;
358
359 type Dispatch_Table_Ptr is access all Dispatch_Table_Wrapper;
360 pragma No_Strict_Aliasing (Dispatch_Table_Ptr);
361
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
365 -- with them.
366
367 type No_Dispatch_Table_Wrapper is record
368 NDT_TSD : System.Address;
369 NDT_Prims_Ptr : Natural;
370 end record;
371
372 DT_Predef_Prims_Size : constant SSE.Storage_Count :=
373 SSE.Storage_Count
374 (1 * (Standard'Address_Size /
375 System.Storage_Unit));
376 -- Size of the Predef_Prims field of the Dispatch_Table
377
378 DT_Offset_To_Top_Size : constant SSE.Storage_Count :=
379 SSE.Storage_Count
380 (1 * (Standard'Address_Size /
381 System.Storage_Unit));
382 -- Size of the Offset_To_Top field of the Dispatch Table
383
384 DT_Typeinfo_Ptr_Size : constant SSE.Storage_Count :=
385 SSE.Storage_Count
386 (1 * (Standard'Address_Size /
387 System.Storage_Unit));
388 -- Size of the Typeinfo_Ptr field of the Dispatch Table
389
390 use type System.Storage_Elements.Storage_Offset;
391
392 DT_Offset_To_Top_Offset : constant SSE.Storage_Count :=
393 DT_Typeinfo_Ptr_Size
394 + DT_Offset_To_Top_Size;
395
396 DT_Predef_Prims_Offset : constant SSE.Storage_Count :=
397 DT_Typeinfo_Ptr_Size
398 + DT_Offset_To_Top_Size
399 + DT_Predef_Prims_Size;
400 -- Offset from Prims_Ptr to Predef_Prims component
401
402 -- Object Specific Data record of secondary dispatch tables
403
404 type Object_Specific_Data_Array is array (Positive range <>) of Positive;
405
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.
412 end record;
413
414 type Object_Specific_Data_Ptr is access all Object_Specific_Data;
415 pragma No_Strict_Aliasing (Object_Specific_Data_Ptr);
416
417 -- The following subprogram specifications are placed here instead of
418 -- the package body to see them from the frontend through rtsfind.
419
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).
423
424 function Displace (This : System.Address; T : Tag) return System.Address;
425 -- Ada 2005 (AI-251): Displace "This" to point to the secondary dispatch
426 -- table of T.
427
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
431 -- by Typ.
432
433 function DT (T : Tag) return Dispatch_Table_Ptr;
434 -- Return the pointer to the TSD record associated with T
435
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.
439
440 function Get_Offset_Index
441 (T : Tag;
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.
447
448 function Get_Prim_Op_Kind
449 (T : Tag;
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.
453
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.
457
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.
462
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.
467
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:
473 --
474 -- type I is interface;
475 -- type T is tagged ...
476 --
477 -- function Test (O : I'Class) is
478 -- begin
479 -- return O in T'Class.
480 -- end Test;
481
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.
488
489 function Parent_Size
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.
496
497 pragma Export (Ada, Parent_Size, "ada__tags__parent_size");
498 -- This procedure is used in s-finimp and is thus exported manually
499
500 procedure Register_Interface_Offset
501 (This : System.Address;
502 Interface_T : Tag;
503 Is_Static : Boolean;
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.
513
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
517
518 procedure Set_Dynamic_Offset_To_Top
519 (This : System.Address;
520 Interface_T : Tag;
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.
534
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.
538
539 procedure Set_Prim_Op_Kind
540 (T : Tag;
541 Position : Positive;
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.
545
546 Max_Predef_Prims : constant Positive := 16;
547 -- Number of reserved slots for the following predefined ada primitives:
548 --
549 -- 1. Size
550 -- 2. Alignment,
551 -- 3. Read
552 -- 4. Write
553 -- 5. Input
554 -- 6. Output
555 -- 7. "="
556 -- 8. assignment
557 -- 9. deep adjust
558 -- 10. deep finalize
559 -- 11. async select
560 -- 12. conditional select
561 -- 13. prim_op kind
562 -- 14. task_id
563 -- 15. dispatching requeue
564 -- 16. timed select
565 --
566 -- The compiler checks that the value here is correct
567
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);
571
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.
576
577 end Ada.Tags;
Mirror of the offical gcc git repository hosted at gcc.gnu.org