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-2011, 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 36with System; 37with System.Storage_Elements; 38 39package 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 83private 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 -- | alignment | 102 -- +-------------------+ 103 -- | expanded name | 104 -- +-------------------+ 105 -- | external tag | 106 -- +-------------------+ 107 -- | hash table link | 108 -- +-------------------+ 109 -- | transportable | 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 -- +------------------+ +-------------------+ +------------+ 123 -- |table of | 124 -- : entry : 125 -- | indexes | 126 -- +------------------+ 127 128 -- Structure of the GNAT Secondary Dispatch Table 129 130 -- +--------------------+ 131 -- | Signature | 132 -- +--------------------+ 133 -- | Tagged_Kind | 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 | 145 -- | op offsets | 146 -- +---------------+ 147 148 -- The runtime information kept for each tagged type is separated into two 149 -- objects: the Dispatch Table and the Type Specific Data record. 150 151 package SSE renames System.Storage_Elements; 152 153 subtype Cstring is String (Positive); 154 type Cstring_Ptr is access all Cstring; 155 pragma No_Strict_Aliasing (Cstring_Ptr); 156 157 -- Declarations for the table of interfaces 158 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 164 -- specific case. 165 166 type Interface_Data_Element is record 167 Iface_Tag : Tag; 168 Static_Offset_To_Top : Boolean; 169 Offset_To_Top_Value : SSE.Storage_Offset; 170 Offset_To_Top_Func : Offset_To_Top_Function_Ptr; 171 Secondary_DT : Tag; 172 end record; 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 182 -- Constructors. 183 184 type Interfaces_Array is array (Natural range <>) of Interface_Data_Element; 185 186 type Interface_Data (Nb_Ifaces : Positive) is record 187 Ifaces_Table : Interfaces_Array (1 .. Nb_Ifaces); 188 end record; 189 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. 193 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. 197 198 type Prim_Op_Kind is 199 (POK_Function, 200 POK_Procedure, 201 POK_Protected_Entry, 202 POK_Protected_Function, 203 POK_Protected_Procedure, 204 POK_Task_Entry, 205 POK_Task_Function, 206 POK_Task_Procedure); 207 208 -- Select specific data types 209 210 type Select_Specific_Data_Element is record 211 Index : Positive; 212 Kind : Prim_Op_Kind; 213 end record; 214 215 type Select_Specific_Data_Array is 216 array (Positive range <>) of Select_Specific_Data_Element; 217 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 221 end record; 222 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. 229 230 type Prim_Ptr is access procedure; 231 type Address_Array is array (Positive range <>) of Prim_Ptr; 232 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. 237 238 type Tag is access all Dispatch_Table; 239 pragma No_Strict_Aliasing (Tag); 240 241 type Interface_Tag is access all Dispatch_Table; 242 243 No_Tag : constant Tag := null; 244 245 -- The expander ensures that Tag objects reference the Prims_Ptr component 246 -- of the wrapper. 247 248 type Tag_Ptr is access all Tag; 249 pragma No_Strict_Aliasing (Tag_Ptr); 250 251 type Offset_To_Top_Ptr is access all SSE.Storage_Offset; 252 pragma No_Strict_Aliasing (Offset_To_Top_Ptr); 253 254 type Tag_Table is array (Natural range <>) of Tag; 255 256 type Size_Ptr is 257 access function (A : System.Address) return Long_Long_Integer; 258 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. 264 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) 273 274 Alignment : Natural; 275 Expanded_Name : Cstring_Ptr; 276 External_Tag : Cstring_Ptr; 277 HT_Link : Tag_Ptr; 278 -- Components used to support to the Ada.Tags subprograms in RM 3.9 279 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. 285 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. 290 291 Type_Is_Abstract : Boolean; 292 -- True if the type is abstract (Ada 2012: AI05-0173) 293 294 Needs_Finalization : Boolean; 295 -- Used to dynamically check whether an object is controlled or not 296 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. 302 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) 307 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. 313 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. 317 end record; 318 319 type Type_Specific_Data_Ptr is access all Type_Specific_Data; 320 pragma No_Strict_Aliasing (Type_Specific_Data_Ptr); 321 322 -- Declarations for the dispatch table record 323 324 type Signature_Kind is 325 (Unknown, 326 Primary_DT, 327 Secondary_DT); 328 329 -- Tagged type kinds with respect to concurrency and limitedness 330 331 type Tagged_Kind is 332 (TK_Abstract_Limited_Tagged, 333 TK_Abstract_Tagged, 334 TK_Limited_Tagged, 335 TK_Protected, 336 TK_Tagged, 337 TK_Task); 338 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 344 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 350 -- Prims_Ptr table. 351 352 Offset_To_Top : SSE.Storage_Offset; 353 TSD : System.Address; 354 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. 359 end record; 360 361 type Dispatch_Table_Ptr is access all Dispatch_Table_Wrapper; 362 pragma No_Strict_Aliasing (Dispatch_Table_Ptr); 363 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 367 -- with them. 368 369 type No_Dispatch_Table_Wrapper is record 370 NDT_TSD : System.Address; 371 NDT_Prims_Ptr : Natural; 372 end record; 373 374 DT_Predef_Prims_Size : constant SSE.Storage_Count := 375 SSE.Storage_Count 376 (1 * (Standard'Address_Size / 377 System.Storage_Unit)); 378 -- Size of the Predef_Prims field of the Dispatch_Table 379 380 DT_Offset_To_Top_Size : constant SSE.Storage_Count := 381 SSE.Storage_Count 382 (1 * (Standard'Address_Size / 383 System.Storage_Unit)); 384 -- Size of the Offset_To_Top field of the Dispatch Table 385 386 DT_Typeinfo_Ptr_Size : constant SSE.Storage_Count := 387 SSE.Storage_Count 388 (1 * (Standard'Address_Size / 389 System.Storage_Unit)); 390 -- Size of the Typeinfo_Ptr field of the Dispatch Table 391 392 use type System.Storage_Elements.Storage_Offset; 393 394 DT_Offset_To_Top_Offset : constant SSE.Storage_Count := 395 DT_Typeinfo_Ptr_Size 396 + DT_Offset_To_Top_Size; 397 398 DT_Predef_Prims_Offset : constant SSE.Storage_Count := 399 DT_Typeinfo_Ptr_Size 400 + DT_Offset_To_Top_Size 401 + DT_Predef_Prims_Size; 402 -- Offset from Prims_Ptr to Predef_Prims component 403 404 -- Object Specific Data record of secondary dispatch tables 405 406 type Object_Specific_Data_Array is array (Positive range <>) of Positive; 407 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. 414 end record; 415 416 type Object_Specific_Data_Ptr is access all Object_Specific_Data; 417 pragma No_Strict_Aliasing (Object_Specific_Data_Ptr); 418 419 -- The following subprogram specifications are placed here instead of the 420 -- package body to see them from the frontend through rtsfind. 421 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). 425 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. 429 430 function Displace (This : System.Address; T : Tag) return System.Address; 431 -- Ada 2005 (AI-251): Displace "This" to point to the secondary dispatch 432 -- table of T. 433 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 437 -- by Typ. 438 439 function DT (T : Tag) return Dispatch_Table_Ptr; 440 -- Return the pointer to the TSD record associated with T 441 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. 445 446 function Get_Offset_Index 447 (T : Tag; 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. 453 454 function Get_Prim_Op_Kind 455 (T : Tag; 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. 459 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. 464 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: 470 -- 471 -- type I is interface; 472 -- type T is tagged ... 473 -- 474 -- function Test (O : I'Class) is 475 -- begin 476 -- return O in T'Class. 477 -- end Test; 478 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. 485 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. 490 491 function Parent_Size 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. 498 499 pragma Export (Ada, Parent_Size, "ada__tags__parent_size"); 500 -- This procedure is used in s-finimp and is thus exported manually 501 502 procedure Register_Interface_Offset 503 (This : System.Address; 504 Interface_T : Tag; 505 Is_Static : Boolean; 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. 515 516 procedure Register_Tag (T : Tag); 517 -- Insert the Tag and its associated external_tag in a table for the sake 518 -- of Internal_Tag. 519 520 procedure Set_Dynamic_Offset_To_Top 521 (This : System.Address; 522 Interface_T : Tag; 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. 536 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. 540 541 procedure Set_Prim_Op_Kind 542 (T : Tag; 543 Position : Positive; 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. 547 548 procedure Unregister_Tag (T : Tag); 549 -- Remove a particular tag from the external tag hash table 550 551 Max_Predef_Prims : constant Positive := 15; 552 -- Number of reserved slots for the following predefined ada primitives: 553 -- 554 -- 1. Size 555 -- 2. Read 556 -- 3. Write 557 -- 4. Input 558 -- 5. Output 559 -- 6. "=" 560 -- 7. assignment 561 -- 8. deep adjust 562 -- 9. deep finalize 563 -- 10. async select 564 -- 11. conditional select 565 -- 12. prim_op kind 566 -- 13. task_id 567 -- 14. dispatching requeue 568 -- 15. timed select 569 -- 570 -- The compiler checks that the value here is correct 571 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); 575 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. 580 581end Ada.Tags; 582