1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
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 2, 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 COPYING. If not, write --
19 -- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
20 -- Boston, MA 02110-1301, USA. --
22 -- GNAT was originally developed by the GNAT team at New York University. --
23 -- Extensive contributions were provided by Ada Core Technologies Inc. --
25 ------------------------------------------------------------------------------
27 -- This package contains routines involved in tagged types and dynamic
28 -- dispatching expansion.
30 with Types; use Types;
34 -------------------------------------
35 -- Predefined primitive operations --
36 -------------------------------------
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.
47 -- List of predefined primitive operations
49 -- Leading underscores designate reserved names. Bracketed numerical
50 -- values represent dispatch table slot numbers.
52 -- _Size (1) - implementation of the attribute 'Size for any tagged
53 -- type. Constructs of the form Prefix'Size are converted into
56 -- _Alignment (2) - implementation of the attribute 'Alignment for
57 -- any tagged type. Constructs of the form Prefix'Alignment are
58 -- converted into Prefix._Alignment.
60 -- TSS_Stream_Read (3) - implementation of the stream attribute Read
61 -- for any tagged type.
63 -- TSS_Stream_Write (4) - implementation of the stream attribute Write
64 -- for any tagged type.
66 -- TSS_Stream_Input (5) - implementation of the stream attribute Input
67 -- for any tagged type.
69 -- TSS_Stream_Output (6) - implementation of the stream attribute
70 -- Output for any tagged type.
72 -- Op_Eq (7) - implementation of the equality operator for any non-
73 -- limited tagged type.
75 -- _Assign (8) - implementation of the assignment operator for any
76 -- non-limited tagged type.
78 -- TSS_Deep_Adjust (9) - implementation of the finalization operation
79 -- Adjust for any non-limited tagged type.
81 -- TSS_Deep_Finalize (10) - implementation of the finalization
82 -- operation Finalize for any non-limited tagged type.
84 -- _Disp_Asynchronous_Select (11) - used in the expansion of ATC with
85 -- dispatching triggers. Null implementation for limited interfaces,
86 -- full body generation for types that implement limited interfaces,
87 -- not generated for the rest of the cases. See Expand_N_Asynchronous_
88 -- Select in Exp_Ch9 for more information.
90 -- _Disp_Conditional_Select (12) - used in the expansion of conditional
91 -- selects with dispatching triggers. Null implementation for limited
92 -- interfaces, full body generation for types that implement limited
93 -- interfaces, not generated for the rest of the cases. See Expand_N_
94 -- Conditional_Entry_Call in Exp_Ch9 for more information.
96 -- _Disp_Get_Prim_Op_Kind (13) - helper routine used in the expansion
97 -- of ATC with dispatching triggers. Null implementation for limited
98 -- interfaces, full body generation for types that implement limited
99 -- interfaces, not generated for the rest of the cases.
101 -- _Disp_Get_Task_Id (14) - helper routine used in the expansion of
102 -- Abort, attributes 'Callable and 'Terminated for task interface
103 -- class-wide types. Full body generation for task types, null
104 -- implementation for limited interfaces, not generated for the rest
105 -- of the cases. See Expand_N_Attribute_Reference in Exp_Attr and
106 -- Expand_N_Abort_Statement in Exp_Ch9 for more information.
108 -- _Disp_Timed_Select (15) - used in the expansion of timed selects
109 -- with dispatching triggers. Null implementation for limited
110 -- interfaces, full body generation for types that implement limited
111 -- interfaces, not generated for the rest of the cases. See Expand_N_
112 -- Timed_Entry_Call for more information.
114 -- Lifecycle of predefined primitive operations
116 -- The specifications and bodies of the PPOs are created by
117 -- Make_Predefined_Primitive_Specs and Predefined_Primitive_Bodies
118 -- in Exp_Ch3. The generated specifications are immediately analyzed,
119 -- while the bodies are left as freeze actions to the tagged type for
120 -- which they are created.
122 -- PPOs are collected and added to the Primitive_Operations list of
123 -- a type by the regular analysis mechanism.
125 -- PPOs are frozen in Predefined_Primitive_Freeze in Exp_Ch3.
127 -- Thunks for PPOs are created in Freeze_Subprogram in Exp_Ch6, by a
128 -- call to Register_Predefined_DT_Entry, also in Exp_Ch6.
130 -- Dispatch table positions of PPOs are set in Set_All_DT_Position in
133 -- Calls to PPOs procede as regular dispatching calls. If the PPO
134 -- has a thunk, a call procedes as a regular dispatching call with
137 -- Guidelines for addition of new predefined primitive operations
139 -- Update the value of constant Default_Prim_Op_Count in Exp_Disp.ads
140 -- to reflect the new number of PPOs.
142 -- Update the value of constant Default_Prim_Op_Count in A-Tags.ads
143 -- to reflect the new number of PPOs. This value should be the same
144 -- as the one in Exp_Disp.ads.
146 -- Introduce a new predefined name for the new PPO in Snames.ads and
149 -- Categorize the new PPO name as predefined by adding an entry in
150 -- Is_Predefined_Dispatching_Operation in Exp_Util.adb.
152 -- Reserve a dispatch table position for the new PPO by adding an entry
153 -- in Default_Prim_Op_Position in Exp_Disp.adb.
155 -- Generate the specification of the new PPO in Make_Predefined_
156 -- Primitive_Spec in Exp_Ch3.adb. The Is_Internal flag of the defining
157 -- identifier of the specification must be set to True.
159 -- Generate the body of the new PPO in Predefined_Primitive_Bodies in
160 -- Exp_Ch3.adb. The Is_Internal flag of the defining identifier of the
161 -- specification must be set to True.
163 -- If the new PPO requires a thunk, add an entry in Freeze_Subprogram
166 -- When generating calls to a PPO, use Find_Prim_Op from Exp_Util.ads
167 -- to retrieve the entity of the operation directly.
169 -- Number of predefined primitive operations added by the Expander
170 -- for a tagged type. If more predefined primitive operations are
171 -- added, the following items must be changed:
173 -- Ada.Tags.Defailt_Prim_Op_Count - indirect use
174 -- Exp_Disp.Default_Prim_Op_Position - indirect use
175 -- Exp_Disp.Set_All_DT_Position - direct use
177 Default_Prim_Op_Count : constant Int := 15;
179 type DT_Access_Action is
190 Get_Remotely_Callable,
194 Register_Interface_Tag,
206 Set_Remotely_Callable,
213 procedure Expand_Dispatching_Call (Call_Node : Node_Id);
214 -- Expand the call to the operation through the dispatch table and perform
215 -- the required tag checks when appropriate. For CPP types the call is
216 -- done through the Vtable (tag checks are not relevant)
218 procedure Expand_Interface_Actuals (Call_Node : Node_Id);
219 -- Ada 2005 (AI-251): Displace all the actuals corresponding to class-wide
220 -- interfaces to reference the interface tag of the actual object
222 procedure Expand_Interface_Conversion
224 Is_Static : Boolean := True);
225 -- Ada 2005 (AI-251): N is a type-conversion node. Reference the base of
226 -- the object to give access to the interface tag associated with the
227 -- secondary dispatch table.
229 function Expand_Interface_Thunk
231 Thunk_Alias : Node_Id;
232 Thunk_Id : Entity_Id) return Node_Id;
233 -- Ada 2005 (AI-251): When a tagged type implements abstract interfaces we
234 -- generate additional subprograms (thunks) to have a layout compatible
235 -- with the C++ ABI. The thunk modifies the value of the first actual of
236 -- the call (that is, the pointer to the object) before transferring
237 -- control to the target function.
239 function Fill_DT_Entry
241 Prim : Entity_Id) return Node_Id;
242 -- Generate the code necessary to fill the appropriate entry of the
243 -- dispatch table of Prim's controlling type with Prim's address.
245 function Fill_Secondary_DT_Entry
248 Thunk_Id : Entity_Id;
249 Iface_DT_Ptr : Entity_Id) return Node_Id;
250 -- (Ada 2005): Generate the code necessary to fill the appropriate entry of
251 -- the secondary dispatch table of Prim's controlling type with Thunk_Id's
254 function Get_Remotely_Callable (Obj : Node_Id) return Node_Id;
255 -- Return an expression that holds True if the object can be transmitted
256 -- onto another partition according to E.4 (18)
258 function Init_Predefined_Interface_Primitives
259 (Typ : Entity_Id) return List_Id;
260 -- Ada 2005 (AI-251): Initialize the entries associated with predefined
261 -- primitives in all the secondary dispatch tables of Typ.
263 function Make_DT_Access_Action
265 Action : DT_Access_Action;
266 Args : List_Id) return Node_Id;
267 -- Generate a call to one of the Dispatch Table Access Subprograms defined
268 -- in Ada.Tags or in Interfaces.Cpp
270 function Make_DT (Typ : Entity_Id) return List_Id;
271 -- Expand the declarations for the Dispatch Table (or the Vtable in
272 -- the case of type whose ancestor is a CPP_Class)
274 function Make_Disp_Asynchronous_Select_Body
275 (Typ : Entity_Id) return Node_Id;
276 -- Ada 2005 (AI-345): Generate the body of the primitive operation of type
277 -- Typ used for dispatching in asynchronous selects. Generate a null body
278 -- if Typ is an interface type.
280 function Make_Disp_Asynchronous_Select_Spec
281 (Typ : Entity_Id) return Node_Id;
282 -- Ada 2005 (AI-345): Generate the specification of the primitive operation
283 -- of type Typ used for dispatching in asynchronous selects.
285 function Make_Disp_Conditional_Select_Body
286 (Typ : Entity_Id) return Node_Id;
287 -- Ada 2005 (AI-345): Generate the body of the primitive operation of type
288 -- Typ used for dispatching in conditional selects. Generate a null body
289 -- if Typ is an interface type.
291 function Make_Disp_Conditional_Select_Spec
292 (Typ : Entity_Id) return Node_Id;
293 -- Ada 2005 (AI-345): Generate the specification of the primitive operation
294 -- of type Typ used for dispatching in conditional selects.
296 function Make_Disp_Get_Prim_Op_Kind_Body
297 (Typ : Entity_Id) return Node_Id;
298 -- Ada 2005 (AI-345): Generate the body of the primitive operation of type
299 -- Typ used for retrieving the callable entity kind during dispatching in
300 -- asynchronous selects. Generate a null body if Typ is an interface type.
302 function Make_Disp_Get_Prim_Op_Kind_Spec
303 (Typ : Entity_Id) return Node_Id;
304 -- Ada 2005 (AI-345): Generate the specification of the primitive operation
305 -- of the type Typ use for retrieving the callable entity kind during
306 -- dispatching in asynchronous selects.
308 function Make_Disp_Get_Task_Id_Body
309 (Typ : Entity_Id) return Node_Id;
310 -- Ada 2005 (AI-345): Generate the body of the primitive operation of type
311 -- Typ used for retrieving the _task_id field of a task interface class-
312 -- wide type. Generate a null body if Typ is an interface or a non-task
315 function Make_Disp_Get_Task_Id_Spec
316 (Typ : Entity_Id) return Node_Id;
317 -- Ada 2005 (AI-345): Generate the specification of the primitive operation
318 -- of type Typ used for retrieving the _task_id field of a task interface
321 function Make_Disp_Timed_Select_Body
322 (Typ : Entity_Id) return Node_Id;
323 -- Ada 2005 (AI-345): Generate the body of the primitive operation of type
324 -- Typ used for dispatching in timed selects. Generate a null body if Nul
325 -- is an interface type.
327 function Make_Disp_Timed_Select_Spec
328 (Typ : Entity_Id) return Node_Id;
329 -- Ada 2005 (AI-345): Generate the specification of the primitive operation
330 -- of type Typ used for dispatching in timed selects.
332 function Make_Select_Specific_Data_Table
333 (Typ : Entity_Id) return List_Id;
334 -- Ada 2005 (AI-345): Create and populate the auxiliary table in the TSD
335 -- of Typ used for dispatching in asynchronous, conditional and timed
336 -- selects. Generate code to set the primitive operation kinds and entry
337 -- indices of primitive operations and primitive wrappers.
339 procedure Make_Secondary_DT
341 Ancestor_Typ : Entity_Id;
345 Acc_Disp_Tables : in out Elist_Id;
346 Result : out List_Id);
347 -- Ada 2005 (AI-251): Expand the declarations for the Secondary Dispatch
348 -- Table of Typ associated with Iface (each abstract interface implemented
349 -- by Typ has a secondary dispatch table). The arguments Typ, Ancestor_Typ
350 -- and Suffix_Index are used to generate an unique external name which
351 -- is added at the end of Acc_Disp_Tables; this external name will be
352 -- used later by the subprogram Exp_Ch3.Build_Init_Procedure.
354 procedure Set_All_DT_Position (Typ : Entity_Id);
355 -- Set the DT_Position field for each primitive operation. In the CPP
356 -- Class case check that no pragma CPP_Virtual is missing and that the
357 -- DT_Position are coherent
359 procedure Set_Default_Constructor (Typ : Entity_Id);
360 -- Typ is a CPP_Class type. Create the Init procedure of that type to
361 -- be the default constructor (i.e. the function returning this type,
362 -- having a pragma CPP_Constructor and no parameter)
364 procedure Write_DT (Typ : Entity_Id);
365 pragma Export (Ada, Write_DT);
366 -- Debugging procedure (to be called within gdb)