1 |
706 |
jeremybenn |
------------------------------------------------------------------------------
|
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 |
|
|
|
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 |
|
|
-- | 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 |
|
|
|
581 |
|
|
end Ada.Tags;
|