|
111
|
1 ------------------------------------------------------------------------------
|
|
|
2 -- --
|
|
|
3 -- GNAT COMPILER COMPONENTS --
|
|
|
4 -- --
|
|
|
5 -- E X P _ A T A G --
|
|
|
6 -- --
|
|
|
7 -- S p e c --
|
|
|
8 -- --
|
|
145
|
9 -- Copyright (C) 2006-2019, Free Software Foundation, Inc. --
|
|
111
|
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
|
|
145
|
112 (Loc : Source_Ptr;
|
|
|
113 Old_Tag_Node : Node_Id;
|
|
|
114 New_Tag_Node : Node_Id;
|
|
|
115 Num_Predef_Prims : Int) return Node_Id;
|
|
111
|
116 -- Build code that inherits the predefined primitives of the parent.
|
|
|
117 --
|
|
|
118 -- Generates: Predefined_DT (New_T).D (All_Predefined_Prims) :=
|
|
|
119 -- Predefined_DT (Old_T).D (All_Predefined_Prims);
|
|
|
120 --
|
|
|
121 -- Required to build non-library level dispatch tables. Also required
|
|
|
122 -- when compiling without static dispatch tables support.
|
|
|
123
|
|
|
124 function Build_Inherit_Prims
|
|
|
125 (Loc : Source_Ptr;
|
|
|
126 Typ : Entity_Id;
|
|
|
127 Old_Tag_Node : Node_Id;
|
|
|
128 New_Tag_Node : Node_Id;
|
|
|
129 Num_Prims : Nat) return Node_Id;
|
|
|
130 -- Build code that inherits Num_Prims user-defined primitives from the
|
|
|
131 -- dispatch table of the parent type of tagged type Typ. It is used to
|
|
|
132 -- copy the dispatch table of the parent in the following cases:
|
|
|
133 -- a) case of derivations of CPP_Class types
|
|
|
134 -- b) tagged types whose dispatch table is not statically allocated
|
|
|
135 --
|
|
|
136 -- Generates:
|
|
|
137 -- New_Tag.Prims_Ptr (1 .. Num_Prims) :=
|
|
|
138 -- Old_Tag.Prims_Ptr (1 .. Num_Prims);
|
|
|
139
|
|
|
140 function Build_Offset_To_Top
|
|
|
141 (Loc : Source_Ptr;
|
|
|
142 This_Node : Node_Id) return Node_Id;
|
|
|
143 -- Build code that references the Offset_To_Top component of the primary
|
|
|
144 -- or secondary dispatch table associated with This_Node. This subprogram
|
|
|
145 -- provides a subset of the functionality provided by the function
|
|
|
146 -- Offset_To_Top of package Ada.Tags, and is only called by the frontend
|
|
|
147 -- when such routine is not available in a configurable runtime.
|
|
|
148 --
|
|
|
149 -- Generates:
|
|
|
150 -- Offset_To_Top_Ptr
|
|
|
151 -- (Address!(Tag_Ptr!(This).all) - Offset_To_Top_Offset).all
|
|
|
152
|
|
|
153 function Build_Set_Predefined_Prim_Op_Address
|
|
|
154 (Loc : Source_Ptr;
|
|
|
155 Tag_Node : Node_Id;
|
|
|
156 Position : Uint;
|
|
|
157 Address_Node : Node_Id) return Node_Id;
|
|
|
158 -- Build code that saves the address of a virtual function in a given
|
|
|
159 -- Position of the portion of the dispatch table associated with the
|
|
|
160 -- predefined primitives of Tag. Called from Exp_Disp.Fill_DT_Entry
|
|
|
161 -- and Exp_Disp.Fill_Secondary_DT_Entry. It is used for:
|
|
|
162 -- 1) Filling the dispatch table of CPP_Class types.
|
|
|
163 -- 2) Late overriding (see Check_Dispatching_Operation).
|
|
|
164 --
|
|
|
165 -- Generates: Predefined_DT (Tag).D (Position) := Value
|
|
|
166
|
|
|
167 function Build_Set_Prim_Op_Address
|
|
|
168 (Loc : Source_Ptr;
|
|
|
169 Typ : Entity_Id;
|
|
|
170 Tag_Node : Node_Id;
|
|
|
171 Position : Uint;
|
|
|
172 Address_Node : Node_Id) return Node_Id;
|
|
|
173 -- Build code that saves the address of a virtual function in a given
|
|
|
174 -- Position of the dispatch table associated with the Tag. Called from
|
|
|
175 -- Exp_Disp.Fill_DT_Entry and Exp_Disp.Fill_Secondary_DT_Entry. Used for:
|
|
|
176 -- 1) Filling the dispatch table of CPP_Class types.
|
|
|
177 -- 2) Late overriding (see Check_Dispatching_Operation).
|
|
|
178 --
|
|
|
179 -- Generates: Tag.D (Position) := Value
|
|
|
180
|
|
|
181 function Build_Set_Size_Function
|
|
|
182 (Loc : Source_Ptr;
|
|
|
183 Tag_Node : Node_Id;
|
|
|
184 Size_Func : Entity_Id) return Node_Id;
|
|
|
185 -- Build code that saves in the TSD the address of the function
|
|
|
186 -- calculating _size of the object.
|
|
|
187
|
|
|
188 function Build_Set_Static_Offset_To_Top
|
|
|
189 (Loc : Source_Ptr;
|
|
|
190 Iface_Tag : Node_Id;
|
|
|
191 Offset_Value : Node_Id) return Node_Id;
|
|
|
192 -- Build code that initialize the Offset_To_Top component of the
|
|
|
193 -- secondary dispatch table referenced by Iface_Tag.
|
|
|
194 --
|
|
|
195 -- Generates:
|
|
|
196 -- Offset_To_Top_Ptr
|
|
|
197 -- (Address!(Tag_Ptr!(This).all) - Offset_To_Top_Offset).all
|
|
|
198 -- := Offset_Value
|
|
|
199
|
|
|
200 end Exp_Atag;
|
