1 |
706 |
jeremybenn |
------------------------------------------------------------------------------
|
2 |
|
|
-- --
|
3 |
|
|
-- GNAT COMPILER COMPONENTS --
|
4 |
|
|
-- --
|
5 |
|
|
-- E X P _ A T A G --
|
6 |
|
|
-- --
|
7 |
|
|
-- S p e c --
|
8 |
|
|
-- --
|
9 |
|
|
-- Copyright (C) 2006-2011, Free Software Foundation, Inc. --
|
10 |
|
|
-- --
|
11 |
|
|
-- GNAT is free software; you can redistribute it and/or modify it under --
|
12 |
|
|
-- terms of the GNU General Public License as published by the Free Soft- --
|
13 |
|
|
-- ware Foundation; either version 3, or (at your option) any later ver- --
|
14 |
|
|
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
|
15 |
|
|
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
|
16 |
|
|
-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
|
17 |
|
|
-- for more details. You should have received a copy of the GNU General --
|
18 |
|
|
-- Public License distributed with GNAT; see file COPYING3. If not, go to --
|
19 |
|
|
-- http://www.gnu.org/licenses for a complete copy of the license. --
|
20 |
|
|
-- --
|
21 |
|
|
-- GNAT was originally developed by the GNAT team at New York University. --
|
22 |
|
|
-- Extensive contributions were provided by Ada Core Technologies Inc. --
|
23 |
|
|
-- --
|
24 |
|
|
------------------------------------------------------------------------------
|
25 |
|
|
|
26 |
|
|
-- This package contains routines involved in the frontend expansion of
|
27 |
|
|
-- subprograms of package Ada.Tags
|
28 |
|
|
|
29 |
|
|
with Types; use Types;
|
30 |
|
|
with Uintp; use Uintp;
|
31 |
|
|
|
32 |
|
|
package Exp_Atag is
|
33 |
|
|
|
34 |
|
|
-- Note: In all the subprograms of this package formal 'Loc' is the source
|
35 |
|
|
-- location used in constructing the corresponding nodes.
|
36 |
|
|
|
37 |
|
|
procedure Build_Common_Dispatching_Select_Statements
|
38 |
|
|
(Typ : Entity_Id;
|
39 |
|
|
Stmts : List_Id);
|
40 |
|
|
-- Ada 2005 (AI-345): Build statements that are common to the expansion of
|
41 |
|
|
-- timed, asynchronous, and conditional select and append them to Stmts.
|
42 |
|
|
-- Typ is the tagged type used for dispatching calls.
|
43 |
|
|
|
44 |
|
|
procedure Build_CW_Membership
|
45 |
|
|
(Loc : Source_Ptr;
|
46 |
|
|
Obj_Tag_Node : in out Node_Id;
|
47 |
|
|
Typ_Tag_Node : Node_Id;
|
48 |
|
|
Related_Nod : Node_Id;
|
49 |
|
|
New_Node : out Node_Id);
|
50 |
|
|
-- Build code that returns true if Obj_Tag is in Typ_Tag'Class. Each DT
|
51 |
|
|
-- has a table of ancestors and its inheritance level (Idepth). Obj is in
|
52 |
|
|
-- Typ'Class if Typ'Tag is found in the table of ancestors referenced by
|
53 |
|
|
-- Obj'Tag. Knowing the level of inheritance of both types, this can be
|
54 |
|
|
-- computed in constant time by the formula:
|
55 |
|
|
--
|
56 |
|
|
-- Index := TSD (Obj'Tag).Idepth - TSD (Typ'Tag).Idepth;
|
57 |
|
|
-- Index > 0 and then TSD (Obj'Tag).Tags_Table (Index) = Typ'Tag
|
58 |
|
|
--
|
59 |
|
|
-- Related_Nod is the node where the implicit declaration of variable Index
|
60 |
|
|
-- is inserted. Obj_Tag_Node is relocated.
|
61 |
|
|
|
62 |
|
|
function Build_Get_Access_Level
|
63 |
|
|
(Loc : Source_Ptr;
|
64 |
|
|
Tag_Node : Node_Id) return Node_Id;
|
65 |
|
|
-- Build code that retrieves the accessibility level of the tagged type.
|
66 |
|
|
--
|
67 |
|
|
-- Generates: TSD (Tag).Access_Level
|
68 |
|
|
|
69 |
|
|
function Build_Get_Alignment
|
70 |
|
|
(Loc : Source_Ptr;
|
71 |
|
|
Tag_Node : Node_Id) return Node_Id;
|
72 |
|
|
-- Build code that retrieves the alignment of the tagged type.
|
73 |
|
|
-- Generates: TSD (Tag).Alignment
|
74 |
|
|
|
75 |
|
|
procedure Build_Get_Predefined_Prim_Op_Address
|
76 |
|
|
(Loc : Source_Ptr;
|
77 |
|
|
Position : Uint;
|
78 |
|
|
Tag_Node : in out Node_Id;
|
79 |
|
|
New_Node : out Node_Id);
|
80 |
|
|
-- Given a pointer to a dispatch table (T) and a position in the DT, build
|
81 |
|
|
-- code that gets the address of the predefined virtual function stored in
|
82 |
|
|
-- it (used for dispatching calls). Tag_Node is relocated.
|
83 |
|
|
--
|
84 |
|
|
-- Generates: Predefined_DT (Tag).D (Position);
|
85 |
|
|
|
86 |
|
|
procedure Build_Get_Prim_Op_Address
|
87 |
|
|
(Loc : Source_Ptr;
|
88 |
|
|
Typ : Entity_Id;
|
89 |
|
|
Position : Uint;
|
90 |
|
|
Tag_Node : in out Node_Id;
|
91 |
|
|
New_Node : out Node_Id);
|
92 |
|
|
-- Build code that retrieves the address of the virtual function stored in
|
93 |
|
|
-- a given position of the dispatch table (used for dispatching calls).
|
94 |
|
|
-- Tag_Node is relocated.
|
95 |
|
|
--
|
96 |
|
|
-- Generates: To_Tag (Tag).D (Position);
|
97 |
|
|
|
98 |
|
|
function Build_Get_Transportable
|
99 |
|
|
(Loc : Source_Ptr;
|
100 |
|
|
Tag_Node : Node_Id) return Node_Id;
|
101 |
|
|
-- Build code that retrieves the value of the Transportable flag for
|
102 |
|
|
-- the given Tag.
|
103 |
|
|
--
|
104 |
|
|
-- Generates: TSD (Tag).Transportable;
|
105 |
|
|
|
106 |
|
|
function Build_Inherit_CPP_Prims (Typ : Entity_Id) return List_Id;
|
107 |
|
|
-- Build code that copies from Typ's parent the dispatch table slots of
|
108 |
|
|
-- inherited primitives and updates slots of overridden primitives. The
|
109 |
|
|
-- generated code handles primary and secondary dispatch tables of Typ.
|
110 |
|
|
|
111 |
|
|
function Build_Inherit_Predefined_Prims
|
112 |
|
|
(Loc : Source_Ptr;
|
113 |
|
|
Old_Tag_Node : Node_Id;
|
114 |
|
|
New_Tag_Node : Node_Id) return Node_Id;
|
115 |
|
|
-- Build code that inherits the predefined primitives of the parent.
|
116 |
|
|
--
|
117 |
|
|
-- Generates: Predefined_DT (New_T).D (All_Predefined_Prims) :=
|
118 |
|
|
-- Predefined_DT (Old_T).D (All_Predefined_Prims);
|
119 |
|
|
--
|
120 |
|
|
-- Required to build non-library level dispatch tables. Also required
|
121 |
|
|
-- when compiling without static dispatch tables support.
|
122 |
|
|
|
123 |
|
|
function Build_Inherit_Prims
|
124 |
|
|
(Loc : Source_Ptr;
|
125 |
|
|
Typ : Entity_Id;
|
126 |
|
|
Old_Tag_Node : Node_Id;
|
127 |
|
|
New_Tag_Node : Node_Id;
|
128 |
|
|
Num_Prims : Nat) return Node_Id;
|
129 |
|
|
-- Build code that inherits Num_Prims user-defined primitives from the
|
130 |
|
|
-- dispatch table of the parent type of tagged type Typ. It is used to
|
131 |
|
|
-- copy the dispatch table of the parent in the following cases:
|
132 |
|
|
-- a) case of derivations of CPP_Class types
|
133 |
|
|
-- b) tagged types whose dispatch table is not statically allocated
|
134 |
|
|
--
|
135 |
|
|
-- Generates:
|
136 |
|
|
-- New_Tag.Prims_Ptr (1 .. Num_Prims) :=
|
137 |
|
|
-- Old_Tag.Prims_Ptr (1 .. Num_Prims);
|
138 |
|
|
|
139 |
|
|
function Build_Offset_To_Top
|
140 |
|
|
(Loc : Source_Ptr;
|
141 |
|
|
This_Node : Node_Id) return Node_Id;
|
142 |
|
|
-- Build code that references the Offset_To_Top component of the primary
|
143 |
|
|
-- or secondary dispatch table associated with This_Node. This subprogram
|
144 |
|
|
-- provides a subset of the functionality provided by the function
|
145 |
|
|
-- Offset_To_Top of package Ada.Tags, and is only called by the frontend
|
146 |
|
|
-- when such routine is not available in a configurable runtime.
|
147 |
|
|
--
|
148 |
|
|
-- Generates:
|
149 |
|
|
-- Offset_To_Top_Ptr
|
150 |
|
|
-- (Address!(Tag_Ptr!(This).all) - Offset_To_Top_Offset)
|
151 |
|
|
|
152 |
|
|
function Build_Set_Predefined_Prim_Op_Address
|
153 |
|
|
(Loc : Source_Ptr;
|
154 |
|
|
Tag_Node : Node_Id;
|
155 |
|
|
Position : Uint;
|
156 |
|
|
Address_Node : Node_Id) return Node_Id;
|
157 |
|
|
-- Build code that saves the address of a virtual function in a given
|
158 |
|
|
-- Position of the portion of the dispatch table associated with the
|
159 |
|
|
-- predefined primitives of Tag. Called from Exp_Disp.Fill_DT_Entry
|
160 |
|
|
-- and Exp_Disp.Fill_Secondary_DT_Entry. It is used for:
|
161 |
|
|
-- 1) Filling the dispatch table of CPP_Class types.
|
162 |
|
|
-- 2) Late overriding (see Check_Dispatching_Operation).
|
163 |
|
|
--
|
164 |
|
|
-- Generates: Predefined_DT (Tag).D (Position) := Value
|
165 |
|
|
|
166 |
|
|
function Build_Set_Prim_Op_Address
|
167 |
|
|
(Loc : Source_Ptr;
|
168 |
|
|
Typ : Entity_Id;
|
169 |
|
|
Tag_Node : Node_Id;
|
170 |
|
|
Position : Uint;
|
171 |
|
|
Address_Node : Node_Id) return Node_Id;
|
172 |
|
|
-- Build code that saves the address of a virtual function in a given
|
173 |
|
|
-- Position of the dispatch table associated with the Tag. Called from
|
174 |
|
|
-- Exp_Disp.Fill_DT_Entry and Exp_Disp.Fill_Secondary_DT_Entry. Used for:
|
175 |
|
|
-- 1) Filling the dispatch table of CPP_Class types.
|
176 |
|
|
-- 2) Late overriding (see Check_Dispatching_Operation).
|
177 |
|
|
--
|
178 |
|
|
-- Generates: Tag.D (Position) := Value
|
179 |
|
|
|
180 |
|
|
function Build_Set_Size_Function
|
181 |
|
|
(Loc : Source_Ptr;
|
182 |
|
|
Tag_Node : Node_Id;
|
183 |
|
|
Size_Func : Entity_Id) return Node_Id;
|
184 |
|
|
-- Build code that saves in the TSD the address of the function
|
185 |
|
|
-- calculating _size of the object.
|
186 |
|
|
|
187 |
|
|
function Build_Set_Static_Offset_To_Top
|
188 |
|
|
(Loc : Source_Ptr;
|
189 |
|
|
Iface_Tag : Node_Id;
|
190 |
|
|
Offset_Value : Node_Id) return Node_Id;
|
191 |
|
|
-- Build code that initialize the Offset_To_Top component of the
|
192 |
|
|
-- secondary dispatch table referenced by Iface_Tag.
|
193 |
|
|
--
|
194 |
|
|
-- Generates:
|
195 |
|
|
-- Offset_To_Top_Ptr
|
196 |
|
|
-- (Address!(Tag_Ptr!(This).all) - Offset_To_Top_Offset).all
|
197 |
|
|
-- := Offset_Value
|
198 |
|
|
|
199 |
|
|
end Exp_Atag;
|