File : a-tags-hie.ads
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-2014, 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 -- --
23 -- --
24 -- --
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 -- This is the HI-E version of this file. It provides full object oriented
37 -- semantics (including dynamic dispatching and support for abstract
38 -- interface types), assuming that tagged types are declared at the library
39 -- level. Some functionality has been removed in order to simplify this
40 -- run-time unit. Compared to the full version of this package, the following
41 -- subprograms have been removed:
42
43 -- Internal_Tag, Register_Tag, Descendant_Tag, Is_Descendant_At_Same_Level:
44 -- These subprograms are used for cross-referencing the external and
45 -- internal representation of tags. The implementation of these routines
46 -- was considered neither simple nor esential for this restricted run-time,
47 -- and hence these functions were removed.
48
49 -- Get_Entry_Index, Get_Offset_Index, Get_Prim_Op_Kind, Get_Tagged_Kind,
50 -- SSD, Set_Entry_Index, Set_Prim_Op_Kind, OSD: They are used with types
51 -- that implement limited interfaces and are only invoked when there are
52 -- selective waits and ATC's where the trigger is a call to an interface
53 -- operation. These functions have been removed because selective waits
54 -- and ATC's are not supported by the restricted run-time.
55
56 -- Displace, IW_Membership, Offset_To_Top, Set_Dynamic_Offset_To_Top,
57 -- Base_Address, Register_Interface_Offset: They are used with extended
58 -- support for interface types that is not part of the zfp runtime
59 -- (membership test applied to interfaces, tagged types with variable
60 -- size components covering interfaces, explicit dereference through
61 -- access to interfaces, and unchecked deallocation through access to
62 -- interfaces).
63
64 -- The operations in this package provide the guarantee that all
65 -- dispatching calls on primitive operations of tagged types and
66 -- interfaces take constant time (in terms of source lines executed),
67 -- that is to say, the cost of these calls is independent of the number
68 -- of primitives of the type or interface, and independent of the number
69 -- of ancestors or interface progenitors that a tagged type may have.
70
71 with System;
72 with System.Storage_Elements;
73
74 package Ada.Tags is
75 pragma Preelaborate;
76 -- In accordance with Ada 2005 AI-362
77
78 type Tag is private;
79 pragma Preelaborable_Initialization (Tag);
80
81 No_Tag : constant Tag;
82
83 function Expanded_Name (T : Tag) return String;
84
85 function External_Tag (T : Tag) return String;
86
87 function Parent_Tag (T : Tag) return Tag;
88 pragma Ada_05 (Parent_Tag);
89
90 Tag_Error : exception;
91
92 private
93
94 -- Structure of the GNAT Primary Dispatch Table
95
96 -- +--------------------+
97 -- | Predef_Prims ---------------------------> +------------+
98 -- +--------------------+ | table of |
99 -- |Typeinfo_Ptr/TSD_Ptr --> Type Specific Data | predefined |
100 -- Tag --> +--------------------+ +-------------------+ | primitives |
101 -- | table of | | inheritance depth | +------------+
102 -- : primitive ops : +-------------------+
103 -- | pointers | | access level |
104 -- +--------------------+ +-------------------+
105 -- | alignment |
106 -- +-------------------+
107 -- | expanded name |
108 -- +-------------------+
109 -- | external tag |
110 -- +-------------------+
111 -- | hash table link |
112 -- +-------------------+
113 -- | transportable |
114 -- +-------------------+
115 -- | needs finalization|
116 -- +-------------------+
117 -- | table of |
118 -- : ancestor :
119 -- | tags |
120 -- +-------------------+
121
122 -- The runtime information kept for each tagged type is separated into
123 -- three objects: the Dispatch Table of predefined primitives, the dispatch
124 -- table of user-defined primitives and the Type_Specific_Data record.
125
126 package SSE renames System.Storage_Elements;
127
128 subtype Cstring is String (Positive);
129 type Cstring_Ptr is access all Cstring;
130 pragma No_Strict_Aliasing (Cstring_Ptr);
131
132 type Tag_Table is array (Natural range <>) of Tag;
133
134 type Prim_Ptr is access procedure;
135 type Address_Array is array (Positive range <>) of Prim_Ptr;
136
137 subtype Dispatch_Table is Address_Array (1 .. 1);
138 -- Used by GDB to identify the _tags and traverse the run-time structure
139 -- associated with tagged types. For compatibility with older versions of
140 -- gdb, its name must not be changed.
141
142 type Tag is access all Dispatch_Table;
143 pragma No_Strict_Aliasing (Tag);
144
145 type Interface_Tag is access all Dispatch_Table;
146
147 No_Tag : constant Tag := null;
148
149 -- The expander ensures that Tag objects reference the Prims_Ptr component
150 -- of the wrapper.
151
152 type Tag_Ptr is access all Tag;
153 pragma No_Strict_Aliasing (Tag_Ptr);
154
155 type Offset_To_Top_Ptr is access all SSE.Storage_Offset;
156 pragma No_Strict_Aliasing (Offset_To_Top_Ptr);
157
158 type Type_Specific_Data (Idepth : Natural) is record
159 -- Inheritance Depth Level: Used to implement the membership test
160 -- associated with single inheritance of tagged types in constant-time.
161 -- It also indicates the size of the Tags_Table component.
162
163 Access_Level : Natural;
164 -- Accessibility level required to give support to Ada 2005 nested type
165 -- extensions. This feature allows safe nested type extensions by
166 -- shifting the accessibility checks to certain operations, rather than
167 -- being enforced at the type declaration. In particular, by performing
168 -- run-time accessibility checks on class-wide allocators, class-wide
169 -- function return, and class-wide stream I/O, the danger of objects
170 -- outliving their type declaration can be eliminated (Ada 2005: AI-344)
171
172 Alignment : Natural;
173 Expanded_Name : Cstring_Ptr;
174 External_Tag : Cstring_Ptr;
175 HT_Link : Tag_Ptr;
176 -- Components used to support to the Ada.Tags subprograms in ARM 3.9
177
178 -- Note: Expanded_Name is referenced by GDB to determine the actual name
179 -- of the tagged type. Its requirements are: 1) it must have this exact
180 -- name, and 2) its contents must point to a C-style Nul terminated
181 -- string containing its expanded name. GDB has no requirement on a
182 -- given position inside the record.
183
184 Transportable : Boolean;
185 -- Used to check RM E.4(18), set for types that satisfy the requirements
186 -- for being used in remote calls as actuals for classwide formals or as
187 -- return values for classwide functions.
188
189 Needs_Finalization : Boolean;
190 -- Used to dynamically check whether an object is controlled or not
191
192 Tags_Table : Tag_Table (0 .. Idepth);
193 -- Table of ancestor tags. Its size actually depends on the inheritance
194 -- depth level of the tagged type.
195 end record;
196
197 type Type_Specific_Data_Ptr is access all Type_Specific_Data;
198 pragma No_Strict_Aliasing (Type_Specific_Data_Ptr);
199
200 type Dispatch_Table_Wrapper (Num_Prims : Natural) is record
201 Predef_Prims : System.Address;
202 -- Pointer to the dispatch table of predefined Ada primitives
203
204 -- According to the C++ ABI the components Offset_To_Top and TSD are
205 -- stored just "before" the dispatch table (that is, the Prims_Ptr
206 -- table), and they are referenced with negative offsets referring to
207 -- the base of the dispatch table. The _Tag (or the VTable_Ptr in C++
208 -- terminology) must point to the base of the virtual table, just after
209 -- these components, to point to the Prims_Ptr table.
210
211 Offset_To_Top : SSE.Storage_Offset;
212 TSD : System.Address;
213
214 Prims_Ptr : Address_Array (1 .. Num_Prims);
215 -- The size of the Prims_Ptr array actually depends on the tagged type
216 -- to which it applies. For each tagged type, the expander computes the
217 -- actual array size, allocates the Dispatch_Table record accordingly.
218 end record;
219
220 -- The following type declaration is used by the compiler when the program
221 -- is compiled with restriction No_Dispatching_Calls
222
223 type No_Dispatch_Table_Wrapper is record
224 NDT_TSD : System.Address;
225 NDT_Prims_Ptr : Natural;
226 end record;
227
228 DT_Predef_Prims_Size : constant SSE.Storage_Count :=
229 SSE.Storage_Count
230 (1 * (Standard'Address_Size /
231 System.Storage_Unit));
232 -- Size of the Predef_Prims field of the Dispatch_Table
233
234 DT_Offset_To_Top_Size : constant SSE.Storage_Count :=
235 SSE.Storage_Count
236 (1 * (Standard'Address_Size /
237 System.Storage_Unit));
238 -- Size of the Offset_To_Top field of the Dispatch Table
239
240 DT_Typeinfo_Ptr_Size : constant SSE.Storage_Count :=
241 SSE.Storage_Count
242 (1 * (Standard'Address_Size /
243 System.Storage_Unit));
244 -- Size of the Typeinfo_Ptr field of the Dispatch Table
245
246 use type System.Storage_Elements.Storage_Offset;
247
248 DT_Offset_To_Top_Offset : constant SSE.Storage_Count :=
249 DT_Typeinfo_Ptr_Size
250 + DT_Offset_To_Top_Size;
251
252 DT_Predef_Prims_Offset : constant SSE.Storage_Count :=
253 DT_Typeinfo_Ptr_Size
254 + DT_Offset_To_Top_Size
255 + DT_Predef_Prims_Size;
256 -- Offset from Prims_Ptr to Predef_Prims component
257
258 Max_Predef_Prims : constant Positive := 9;
259 -- Number of reserved slots for predefined ada primitives: Size, Read,
260 -- Write, Input, Output, "=", assignment, deep adjust, and deep finalize.
261 -- The compiler checks that this value is correct.
262
263 subtype Predef_Prims_Table is Address_Array (1 .. Max_Predef_Prims);
264 type Predef_Prims_Table_Ptr is access Predef_Prims_Table;
265 pragma No_Strict_Aliasing (Predef_Prims_Table_Ptr);
266
267 type Addr_Ptr is access System.Address;
268 pragma No_Strict_Aliasing (Addr_Ptr);
269
270 end Ada.Tags;