|
111
|
1 ------------------------------------------------------------------------------
|
|
|
2 -- --
|
|
|
3 -- GNAT COMPILER COMPONENTS --
|
|
|
4 -- --
|
|
|
5 -- E X P _ D I S P --
|
|
|
6 -- --
|
|
|
7 -- S p e c --
|
|
|
8 -- --
|
|
131
|
9 -- Copyright (C) 1992-2018, 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 tagged types and dynamic
|
|
|
27 -- dispatching expansion.
|
|
|
28
|
|
|
29 with Types; use Types;
|
|
|
30 with Uintp; use Uintp;
|
|
|
31
|
|
|
32 package Exp_Disp is
|
|
|
33
|
|
|
34 -------------------------------------
|
|
|
35 -- Predefined primitive operations --
|
|
|
36 -------------------------------------
|
|
|
37
|
|
|
38 -- The predefined primitive operations (PPOs) are subprograms generated
|
|
|
39 -- by GNAT for a particular tagged type. Their role is to provide support
|
|
|
40 -- for different Ada language features such as the attribute 'Size or
|
|
|
41 -- handling of dispatching triggers in select statements. PPOs are created
|
|
|
42 -- when a tagged type is expanded or frozen. These subprograms are later
|
|
|
43 -- collected and inserted into the dispatch table of a tagged type at
|
|
|
44 -- fixed positions. Some of the PPOs that manipulate data in tagged objects
|
|
|
45 -- require the generation of thunks.
|
|
|
46
|
|
|
47 -- List of predefined primitive operations
|
|
|
48
|
|
|
49 -- Leading underscores designate reserved names. Bracketed numerical
|
|
|
50 -- values represent dispatch table slot numbers.
|
|
|
51
|
|
|
52 -- _Size (1) - implementation of the attribute 'Size for any tagged
|
|
|
53 -- type. Constructs of the form Prefix'Size are converted into
|
|
|
54 -- Prefix._Size.
|
|
|
55
|
|
|
56 -- TSS_Stream_Read (2) - implementation of the stream attribute Read
|
|
|
57 -- for any tagged type.
|
|
|
58
|
|
|
59 -- TSS_Stream_Write (3) - implementation of the stream attribute Write
|
|
|
60 -- for any tagged type.
|
|
|
61
|
|
|
62 -- TSS_Stream_Input (4) - implementation of the stream attribute Input
|
|
|
63 -- for any tagged type.
|
|
|
64
|
|
|
65 -- TSS_Stream_Output (5) - implementation of the stream attribute
|
|
|
66 -- Output for any tagged type.
|
|
|
67
|
|
|
68 -- Op_Eq (6) - implementation of the equality operator for any non-
|
|
|
69 -- limited tagged type.
|
|
|
70
|
|
|
71 -- _Assign (7) - implementation of the assignment operator for any
|
|
|
72 -- non-limited tagged type.
|
|
|
73
|
|
|
74 -- TSS_Deep_Adjust (8) - implementation of the finalization operation
|
|
|
75 -- Adjust for any non-limited tagged type.
|
|
|
76
|
|
|
77 -- TSS_Deep_Finalize (9) - implementation of the finalization
|
|
|
78 -- operation Finalize for any non-limited tagged type.
|
|
|
79
|
|
|
80 -- _Disp_Asynchronous_Select (10) - used in the expansion of ATC with
|
|
|
81 -- dispatching triggers. Null implementation for limited interfaces,
|
|
|
82 -- full body generation for types that implement limited interfaces,
|
|
|
83 -- not generated for the rest of the cases. See Expand_N_Asynchronous_
|
|
|
84 -- Select in Exp_Ch9 for more information.
|
|
|
85
|
|
|
86 -- _Disp_Conditional_Select (11) - used in the expansion of conditional
|
|
|
87 -- selects with dispatching triggers. Null implementation for limited
|
|
|
88 -- interfaces, full body generation for types that implement limited
|
|
|
89 -- interfaces, not generated for the rest of the cases. See Expand_N_
|
|
|
90 -- Conditional_Entry_Call in Exp_Ch9 for more information.
|
|
|
91
|
|
|
92 -- _Disp_Get_Prim_Op_Kind (12) - helper routine used in the expansion
|
|
|
93 -- of ATC with dispatching triggers. Null implementation for limited
|
|
|
94 -- interfaces, full body generation for types that implement limited
|
|
|
95 -- interfaces, not generated for the rest of the cases.
|
|
|
96
|
|
|
97 -- _Disp_Get_Task_Id (13) - helper routine used in the expansion of
|
|
|
98 -- Abort, attributes 'Callable and 'Terminated for task interface
|
|
|
99 -- class-wide types. Full body generation for task types, null
|
|
|
100 -- implementation for limited interfaces, not generated for the rest
|
|
|
101 -- of the cases. See Expand_N_Attribute_Reference in Exp_Attr and
|
|
|
102 -- Expand_N_Abort_Statement in Exp_Ch9 for more information.
|
|
|
103
|
|
|
104 -- _Disp_Requeue (14) - used in the expansion of dispatching requeue
|
|
|
105 -- statements. Null implementation is provided for protected, task
|
|
|
106 -- and synchronized interfaces. Protected and task types implementing
|
|
|
107 -- concurrent interfaces receive full bodies. See Expand_N_Requeue_
|
|
|
108 -- Statement in Exp_Ch9 for more information.
|
|
|
109
|
|
|
110 -- _Disp_Timed_Select (15) - used in the expansion of timed selects
|
|
|
111 -- with dispatching triggers. Null implementation for limited
|
|
|
112 -- interfaces, full body generation for types that implement limited
|
|
|
113 -- interfaces, not generated for the rest of the cases. See Expand_N_
|
|
|
114 -- Timed_Entry_Call for more information.
|
|
|
115
|
|
|
116 -- Life cycle of predefined primitive operations
|
|
|
117
|
|
|
118 -- The specifications and bodies of the PPOs are created by
|
|
|
119 -- Make_Predefined_Primitive_Specs and Predefined_Primitive_Bodies
|
|
|
120 -- in Exp_Ch3. The generated specifications are immediately analyzed,
|
|
|
121 -- while the bodies are left as freeze actions to the tagged type for
|
|
|
122 -- which they are created.
|
|
|
123
|
|
|
124 -- PPOs are collected and added to the Primitive_Operations list of
|
|
|
125 -- a type by the regular analysis mechanism.
|
|
|
126
|
|
|
127 -- PPOs are frozen by Exp_Ch3.Predefined_Primitive_Freeze
|
|
|
128
|
|
|
129 -- Thunks for PPOs are created by Make_DT
|
|
|
130
|
|
|
131 -- Dispatch table positions of PPOs are set by Set_All_DT_Position
|
|
|
132
|
|
|
133 -- Calls to PPOs proceed as regular dispatching calls. If the PPO
|
|
|
134 -- has a thunk, a call proceeds as a regular dispatching call with
|
|
|
135 -- a thunk.
|
|
|
136
|
|
|
137 -- Guidelines for addition of new predefined primitive operations
|
|
|
138
|
|
|
139 -- Update the value of constant Max_Predef_Prims in a-tags.ads to
|
|
|
140 -- indicate the new number of PPOs.
|
|
|
141
|
|
|
142 -- Introduce a new predefined name for the new PPO in Snames.ads and
|
|
|
143 -- Snames.adb.
|
|
|
144
|
|
|
145 -- Categorize the new PPO name as predefined by adding an entry in
|
|
|
146 -- Is_Predefined_Dispatching_Operation in Exp_Disp.
|
|
|
147
|
|
|
148 -- Generate the specification of the new PPO in Make_Predefined_
|
|
|
149 -- Primitive_Spec in Exp_Ch3.adb. The Is_Internal flag of the defining
|
|
|
150 -- identifier of the specification must be set to True.
|
|
|
151
|
|
|
152 -- Generate the body of the new PPO in Predefined_Primitive_Bodies in
|
|
|
153 -- Exp_Ch3.adb. The Is_Internal flag of the defining identifier of the
|
|
|
154 -- specification must be set to True.
|
|
|
155
|
|
|
156 -- If the new PPO requires a thunk, add an entry in Freeze_Subprogram
|
|
|
157 -- in Exp_Ch6.adb.
|
|
|
158
|
|
|
159 -- When generating calls to a PPO, use Find_Prim_Op from Exp_Util.ads
|
|
|
160 -- to retrieve the entity of the operation directly.
|
|
|
161
|
|
|
162 -- Number of predefined primitive operations added by the Expander
|
|
|
163 -- for a tagged type. If more predefined primitive operations are
|
|
|
164 -- added, the following items must be changed:
|
|
|
165
|
|
|
166 -- Ada.Tags.Max_Predef_Prims - indirect use
|
|
|
167 -- Exp_Disp.Default_Prim_Op_Position - indirect use
|
|
|
168 -- Exp_Disp.Set_All_DT_Position - direct use
|
|
|
169
|
|
|
170 procedure Apply_Tag_Checks (Call_Node : Node_Id);
|
|
|
171 -- Generate checks required on dispatching calls
|
|
|
172
|
|
|
173 function Building_Static_DT (Typ : Entity_Id) return Boolean;
|
|
|
174 pragma Inline (Building_Static_DT);
|
|
|
175 -- Returns true when building statically allocated dispatch tables
|
|
|
176
|
|
|
177 function Building_Static_Secondary_DT (Typ : Entity_Id) return Boolean;
|
|
|
178 pragma Inline (Building_Static_Secondary_DT);
|
|
|
179 -- Returns true when building statically allocated secondary dispatch
|
|
|
180 -- tables
|
|
|
181
|
|
|
182 procedure Build_Static_Dispatch_Tables (N : Node_Id);
|
|
|
183 -- N is a library level package declaration or package body. Build the
|
|
|
184 -- static dispatch table of the tagged types defined at library level. In
|
|
|
185 -- case of package declarations with private part the generated nodes are
|
|
|
186 -- added at the end of the list of private declarations. Otherwise they are
|
|
|
187 -- added to the end of the list of public declarations. In case of package
|
|
|
188 -- bodies they are added to the end of the list of declarations of the
|
|
|
189 -- package body.
|
|
|
190
|
|
|
191 function Convert_Tag_To_Interface
|
|
|
192 (Typ : Entity_Id; Expr : Node_Id) return Node_Id;
|
|
|
193 pragma Inline (Convert_Tag_To_Interface);
|
|
|
194 -- This function is used in class-wide interface conversions; the expanded
|
|
|
195 -- code generated to convert a tagged object to a class-wide interface type
|
|
|
196 -- involves referencing the tag component containing the secondary dispatch
|
|
|
197 -- table associated with the interface. Given the expression Expr that
|
|
|
198 -- references a tag component, we cannot generate an unchecked conversion
|
|
|
199 -- to leave the expression decorated with the class-wide interface type Typ
|
|
|
200 -- because an unchecked conversion cannot be seen as a no-op. An unchecked
|
|
|
201 -- conversion is conceptually a function call and therefore the RM allows
|
|
|
202 -- the backend to obtain a copy of the value of the actual object and store
|
|
|
203 -- it in some other place (like a register); in such case the interface
|
|
|
204 -- conversion is not equivalent to a displacement of the pointer to the
|
|
|
205 -- interface and any further displacement fails. Although the functionality
|
|
|
206 -- of this function is simple and could be done directly, the purpose of
|
|
|
207 -- this routine is to leave well documented in the sources these
|
|
|
208 -- occurrences.
|
|
|
209
|
|
|
210 -- If Expr is an N_Selected_Component that references a tag generate:
|
|
|
211 -- type ityp is non null access Typ;
|
|
|
212 -- ityp!(Expr'Address).all
|
|
|
213
|
|
|
214 -- if Expr is an N_Function_Call to Ada.Tags.Displace then generate:
|
|
|
215 -- type ityp is non null access Typ;
|
|
|
216 -- ityp!(Expr).all
|
|
|
217
|
|
|
218 function CPP_Num_Prims (Typ : Entity_Id) return Nat;
|
|
|
219 -- Return the number of primitives of the C++ part of the dispatch table.
|
|
|
220 -- For types that are not derivations of CPP types return 0.
|
|
|
221
|
|
|
222 function Elab_Flag_Needed (Typ : Entity_Id) return Boolean;
|
|
|
223 -- Return True if the elaboration of the tagged type Typ is completed at
|
|
|
224 -- run time by the execution of code located in the IP routine and the
|
|
|
225 -- expander must generate an extra elaboration flag to avoid performing
|
|
|
226 -- such elaboration twice.
|
|
|
227
|
|
|
228 procedure Expand_Dispatching_Call (Call_Node : Node_Id);
|
|
|
229 -- Expand the call to the operation through the dispatch table and perform
|
|
|
230 -- the required tag checks when appropriate. For CPP types tag checks are
|
|
|
231 -- not relevant.
|
|
|
232
|
|
|
233 procedure Expand_Interface_Actuals (Call_Node : Node_Id);
|
|
|
234 -- Ada 2005 (AI-251): Displace all the actuals corresponding to class-wide
|
|
|
235 -- interfaces to reference the interface tag of the actual object
|
|
|
236
|
|
|
237 procedure Expand_Interface_Conversion (N : Node_Id);
|
|
|
238 -- Ada 2005 (AI-251): N is a type-conversion node. Displace the pointer
|
|
|
239 -- to the object to give access to the interface tag associated with the
|
|
|
240 -- dispatch table of the target type.
|
|
|
241
|
|
|
242 procedure Expand_Interface_Thunk
|
|
|
243 (Prim : Node_Id;
|
|
|
244 Thunk_Id : out Entity_Id;
|
|
|
245 Thunk_Code : out Node_Id);
|
|
|
246 -- Ada 2005 (AI-251): When a tagged type implements abstract interfaces we
|
|
|
247 -- generate additional subprograms (thunks) associated with each primitive
|
|
|
248 -- Prim to have a layout compatible with the C++ ABI. The thunk displaces
|
|
|
249 -- the pointers to the actuals that depend on the controlling type before
|
|
|
250 -- transferring control to the target subprogram. If there is no need to
|
|
|
251 -- generate the thunk then Thunk_Id and Thunk_Code are set to Empty.
|
|
|
252 -- Otherwise they are set to the defining identifier and the subprogram
|
|
|
253 -- body of the generated thunk.
|
|
|
254
|
|
|
255 function Has_CPP_Constructors (Typ : Entity_Id) return Boolean;
|
|
|
256 -- Returns true if the type has CPP constructors
|
|
|
257
|
|
|
258 function Is_Expanded_Dispatching_Call (N : Node_Id) return Boolean;
|
|
|
259 -- Returns true if N is the expanded code of a dispatching call
|
|
|
260
|
|
|
261 function Make_DT (Typ : Entity_Id; N : Node_Id := Empty) return List_Id;
|
|
|
262 -- Expand the declarations for the Dispatch Table. The node N is the
|
|
|
263 -- declaration that forces the generation of the table. It is used to place
|
|
|
264 -- error messages when the declaration leads to the freezing of a given
|
|
|
265 -- primitive operation that has an incomplete non- tagged formal.
|
|
|
266
|
|
|
267 function Make_Disp_Asynchronous_Select_Body
|
|
|
268 (Typ : Entity_Id) return Node_Id;
|
|
|
269 -- Ada 2005 (AI-345): Generate the body of the primitive operation of type
|
|
|
270 -- Typ used for dispatching in asynchronous selects. Generate a null body
|
|
|
271 -- if Typ is an interface type.
|
|
|
272
|
|
|
273 function Make_Disp_Asynchronous_Select_Spec
|
|
|
274 (Typ : Entity_Id) return Node_Id;
|
|
|
275 -- Ada 2005 (AI-345): Generate the specification of the primitive operation
|
|
|
276 -- of type Typ used for dispatching in asynchronous selects.
|
|
|
277
|
|
|
278 function Make_Disp_Conditional_Select_Body
|
|
|
279 (Typ : Entity_Id) return Node_Id;
|
|
|
280 -- Ada 2005 (AI-345): Generate the body of the primitive operation of type
|
|
|
281 -- Typ used for dispatching in conditional selects. Generate a null body
|
|
|
282 -- if Typ is an interface type.
|
|
|
283
|
|
|
284 function Make_Disp_Conditional_Select_Spec
|
|
|
285 (Typ : Entity_Id) return Node_Id;
|
|
|
286 -- Ada 2005 (AI-345): Generate the specification of the primitive operation
|
|
|
287 -- of type Typ used for dispatching in conditional selects.
|
|
|
288
|
|
|
289 function Make_Disp_Get_Prim_Op_Kind_Body
|
|
|
290 (Typ : Entity_Id) return Node_Id;
|
|
|
291 -- Ada 2005 (AI-345): Generate the body of the primitive operation of type
|
|
|
292 -- Typ used for retrieving the callable entity kind during dispatching in
|
|
|
293 -- asynchronous selects. Generate a null body if Typ is an interface type.
|
|
|
294
|
|
|
295 function Make_Disp_Get_Prim_Op_Kind_Spec
|
|
|
296 (Typ : Entity_Id) return Node_Id;
|
|
|
297 -- Ada 2005 (AI-345): Generate the specification of the primitive operation
|
|
|
298 -- of the type Typ use for retrieving the callable entity kind during
|
|
|
299 -- dispatching in asynchronous selects.
|
|
|
300
|
|
|
301 function Make_Disp_Get_Task_Id_Body
|
|
|
302 (Typ : Entity_Id) return Node_Id;
|
|
|
303 -- Ada 2005 (AI-345): Generate body of the primitive operation of type Typ
|
|
|
304 -- used for retrieving the _task_id field of a task interface class- wide
|
|
|
305 -- type. Generate a null body if Typ is an interface or a non-task type.
|
|
|
306
|
|
|
307 function Make_Disp_Get_Task_Id_Spec
|
|
|
308 (Typ : Entity_Id) return Node_Id;
|
|
|
309 -- Ada 2005 (AI-345): Generate the specification of the primitive operation
|
|
|
310 -- of type Typ used for retrieving the _task_id field of a task interface
|
|
|
311 -- class-wide type.
|
|
|
312
|
|
|
313 function Make_Disp_Requeue_Body
|
|
|
314 (Typ : Entity_Id) return Node_Id;
|
|
|
315 -- Ada 2005 (AI05-0030): Generate the body of the primitive operation of
|
|
|
316 -- type Typ used for dispatching on requeue statements. Generate a body
|
|
|
317 -- containing a single null-statement if Typ is an interface type.
|
|
|
318
|
|
|
319 function Make_Disp_Requeue_Spec
|
|
|
320 (Typ : Entity_Id) return Node_Id;
|
|
|
321 -- Ada 2005 (AI05-0030): Generate the specification of the primitive
|
|
|
322 -- operation of type Typ used for dispatching requeue statements.
|
|
|
323
|
|
|
324 function Make_Disp_Timed_Select_Body
|
|
|
325 (Typ : Entity_Id) return Node_Id;
|
|
|
326 -- Ada 2005 (AI-345): Generate the body of the primitive operation of type
|
|
|
327 -- Typ used for dispatching in timed selects. Generate a body containing
|
|
|
328 -- a single null-statement if Typ is an interface type.
|
|
|
329
|
|
|
330 function Make_Disp_Timed_Select_Spec
|
|
|
331 (Typ : Entity_Id) return Node_Id;
|
|
|
332 -- Ada 2005 (AI-345): Generate the specification of the primitive operation
|
|
|
333 -- of type Typ used for dispatching in timed selects.
|
|
|
334
|
|
|
335 function Make_Select_Specific_Data_Table
|
|
|
336 (Typ : Entity_Id) return List_Id;
|
|
|
337 -- Ada 2005 (AI-345): Create and populate the auxiliary table in the TSD
|
|
|
338 -- of Typ used for dispatching in asynchronous, conditional and timed
|
|
|
339 -- selects. Generate code to set the primitive operation kinds and entry
|
|
|
340 -- indexes of primitive operations and primitive wrappers.
|
|
|
341
|
|
|
342 function Make_Tags (Typ : Entity_Id) return List_Id;
|
|
|
343 -- Generate the entities associated with the primary and secondary tags of
|
|
|
344 -- Typ and fill the contents of Access_Disp_Table. In case of library level
|
|
|
345 -- tagged types this routine imports the forward declaration of the tag
|
|
|
346 -- entity, that will be declared and exported by Make_DT.
|
|
|
347
|
|
|
348 function Register_Primitive
|
|
|
349 (Loc : Source_Ptr;
|
|
|
350 Prim : Entity_Id) return List_Id;
|
|
|
351 -- Build code to register Prim in the primary or secondary dispatch table.
|
|
|
352 -- If Prim is associated with a secondary dispatch table then generate also
|
|
|
353 -- its thunk and register it in the associated secondary dispatch table.
|
|
|
354 -- In general the dispatch tables are always generated by Make_DT and
|
|
|
355 -- Make_Secondary_DT; this routine is only used in two corner cases:
|
|
|
356 --
|
|
|
357 -- 1) To construct the dispatch table of a tagged type whose parent
|
|
|
358 -- is a CPP_Class (see Build_Init_Procedure).
|
|
|
359 -- 2) To handle late overriding of dispatching operations (see
|
|
|
360 -- Check_Dispatching_Operation and Make_DT).
|
|
|
361 --
|
|
|
362 -- The caller is responsible for inserting the generated code in the
|
|
|
363 -- proper place.
|
|
|
364
|
|
|
365 procedure Set_All_DT_Position (Typ : Entity_Id);
|
|
|
366 -- Set the DT_Position field for each primitive operation. In the CPP
|
|
|
367 -- Class case check that no pragma CPP_Virtual is missing and that the
|
|
|
368 -- DT_Position are coherent
|
|
|
369
|
|
|
370 procedure Set_CPP_Constructors (Typ : Entity_Id);
|
|
|
371 -- Typ is a CPP_Class type. Create the Init procedures of that type
|
|
|
372 -- required to handle its default and non-default constructors. The
|
|
|
373 -- functions to which pragma CPP_Constructor is applied in the sources
|
|
|
374 -- are functions returning this type, and having an implicit access to the
|
|
|
375 -- target object in its first argument; such implicit argument is explicit
|
|
|
376 -- in the IP procedures built here.
|
|
|
377
|
|
|
378 procedure Set_DT_Position_Value (Prim : Entity_Id; Value : Uint);
|
|
|
379 -- Set the position of a dispatching primitive its dispatch table. For
|
|
|
380 -- subprogram wrappers propagate the value to the wrapped subprogram.
|
|
|
381
|
|
|
382 procedure Set_DTC_Entity_Value (Tagged_Type : Entity_Id; Prim : Entity_Id);
|
|
|
383 -- Set the definite value of the DTC_Entity value associated with a given
|
|
|
384 -- primitive of a tagged type. For subprogram wrappers, propagate the value
|
|
|
385 -- to the wrapped subprogram.
|
|
|
386
|
|
|
387 procedure Write_DT (Typ : Entity_Id);
|
|
|
388 pragma Export (Ada, Write_DT);
|
|
|
389 -- Debugging procedure (to be called within gdb)
|
|
|
390
|
|
|
391 end Exp_Disp;
|
