1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1992-2009, 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 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. --
21 -- GNAT was originally developed by the GNAT team at New York University. --
22 -- Extensive contributions were provided by Ada Core Technologies Inc. --
24 ------------------------------------------------------------------------------
26 -- This package contains routines involved in tagged types and dynamic
27 -- dispatching expansion.
29 with Types; use Types;
33 -------------------------------
34 -- SCIL Node Type Definition --
35 -------------------------------
37 -- SCIL nodes are a special kind of nodes added to the tree when the
38 -- CodePeer mode is active. They are stored in the tree as special
39 -- N_Null_Statement nodes that have extra attributes. The information
40 -- available through these extra attributes relies on the kind of SCIL
41 -- node. The SCIL node kind is stored in the Scil_Nkind attribute of
42 -- the N_Null_Statement node, and indicates the type of the SCIL node.
44 type SCIL_Node_Kind is
46 -- What is this for ???
49 -- SCIL node for tag component initialization
52 -- SCIL node for dispatching call. Used by the CodePeer backend to
53 -- locate nodes associated with dispatching calls.
55 Dispatch_Table_Object_Init,
56 -- SCIL node for object declaration containing a dispatch table
58 Dispatch_Table_Tag_Init);
59 -- SCIL node for tag initialization
61 -------------------------------------
62 -- Predefined primitive operations --
63 -------------------------------------
65 -- The predefined primitive operations (PPOs) are subprograms generated
66 -- by GNAT for a particular tagged type. Their role is to provide support
67 -- for different Ada language features such as the attribute 'Size or
68 -- handling of dispatching triggers in select statements. PPOs are created
69 -- when a tagged type is expanded or frozen. These subprograms are later
70 -- collected and inserted into the dispatch table of a tagged type at
71 -- fixed positions. Some of the PPOs that manipulate data in tagged objects
72 -- require the generation of thunks.
74 -- List of predefined primitive operations
76 -- Leading underscores designate reserved names. Bracketed numerical
77 -- values represent dispatch table slot numbers.
79 -- _Size (1) - implementation of the attribute 'Size for any tagged
80 -- type. Constructs of the form Prefix'Size are converted into
83 -- _Alignment (2) - implementation of the attribute 'Alignment for
84 -- any tagged type. Constructs of the form Prefix'Alignment are
85 -- converted into Prefix._Alignment.
87 -- TSS_Stream_Read (3) - implementation of the stream attribute Read
88 -- for any tagged type.
90 -- TSS_Stream_Write (4) - implementation of the stream attribute Write
91 -- for any tagged type.
93 -- TSS_Stream_Input (5) - implementation of the stream attribute Input
94 -- for any tagged type.
96 -- TSS_Stream_Output (6) - implementation of the stream attribute
97 -- Output for any tagged type.
99 -- Op_Eq (7) - implementation of the equality operator for any non-
100 -- limited tagged type.
102 -- _Assign (8) - implementation of the assignment operator for any
103 -- non-limited tagged type.
105 -- TSS_Deep_Adjust (9) - implementation of the finalization operation
106 -- Adjust for any non-limited tagged type.
108 -- TSS_Deep_Finalize (10) - implementation of the finalization
109 -- operation Finalize for any non-limited tagged type.
111 -- _Disp_Asynchronous_Select (11) - used in the expansion of ATC with
112 -- dispatching triggers. Null implementation for limited interfaces,
113 -- full body generation for types that implement limited interfaces,
114 -- not generated for the rest of the cases. See Expand_N_Asynchronous_
115 -- Select in Exp_Ch9 for more information.
117 -- _Disp_Conditional_Select (12) - used in the expansion of conditional
118 -- selects with dispatching triggers. Null implementation for limited
119 -- interfaces, full body generation for types that implement limited
120 -- interfaces, not generated for the rest of the cases. See Expand_N_
121 -- Conditional_Entry_Call in Exp_Ch9 for more information.
123 -- _Disp_Get_Prim_Op_Kind (13) - helper routine used in the expansion
124 -- of ATC with dispatching triggers. Null implementation for limited
125 -- interfaces, full body generation for types that implement limited
126 -- interfaces, not generated for the rest of the cases.
128 -- _Disp_Get_Task_Id (14) - helper routine used in the expansion of
129 -- Abort, attributes 'Callable and 'Terminated for task interface
130 -- class-wide types. Full body generation for task types, null
131 -- implementation for limited interfaces, not generated for the rest
132 -- of the cases. See Expand_N_Attribute_Reference in Exp_Attr and
133 -- Expand_N_Abort_Statement in Exp_Ch9 for more information.
135 -- _Disp_Requeue (15) - used in the expansion of dispatching requeue
136 -- statements. Null implementation is provided for protected, task
137 -- and synchronized interfaces. Protected and task types implementing
138 -- concurrent interfaces receive full bodies. See Expand_N_Requeue_
139 -- Statement in Exp_Ch9 for more information.
141 -- _Disp_Timed_Select (16) - used in the expansion of timed selects
142 -- with dispatching triggers. Null implementation for limited
143 -- interfaces, full body generation for types that implement limited
144 -- interfaces, not generated for the rest of the cases. See Expand_N_
145 -- Timed_Entry_Call for more information.
147 -- Life cycle of predefined primitive operations
149 -- The specifications and bodies of the PPOs are created by
150 -- Make_Predefined_Primitive_Specs and Predefined_Primitive_Bodies
151 -- in Exp_Ch3. The generated specifications are immediately analyzed,
152 -- while the bodies are left as freeze actions to the tagged type for
153 -- which they are created.
155 -- PPOs are collected and added to the Primitive_Operations list of
156 -- a type by the regular analysis mechanism.
158 -- PPOs are frozen by Exp_Ch3.Predefined_Primitive_Freeze
160 -- Thunks for PPOs are created by Make_DT
162 -- Dispatch table positions of PPOs are set by Set_All_DT_Position
164 -- Calls to PPOs proceed as regular dispatching calls. If the PPO
165 -- has a thunk, a call proceeds as a regular dispatching call with
168 -- Guidelines for addition of new predefined primitive operations
170 -- Update the value of constant Max_Predef_Prims in a-tags.ads to
171 -- indicate the new number of PPOs.
173 -- Introduce a new predefined name for the new PPO in Snames.ads and
176 -- Categorize the new PPO name as predefined by adding an entry in
177 -- Is_Predefined_Dispatching_Operation in Exp_Disp.
179 -- Generate the specification of the new PPO in Make_Predefined_
180 -- Primitive_Spec in Exp_Ch3.adb. The Is_Internal flag of the defining
181 -- identifier of the specification must be set to True.
183 -- Generate the body of the new PPO in Predefined_Primitive_Bodies in
184 -- Exp_Ch3.adb. The Is_Internal flag of the defining identifier of the
185 -- specification must be set to True.
187 -- If the new PPO requires a thunk, add an entry in Freeze_Subprogram
190 -- When generating calls to a PPO, use Find_Prim_Op from Exp_Util.ads
191 -- to retrieve the entity of the operation directly.
193 -- Number of predefined primitive operations added by the Expander
194 -- for a tagged type. If more predefined primitive operations are
195 -- added, the following items must be changed:
197 -- Ada.Tags.Max_Predef_Prims - indirect use
198 -- Exp_Disp.Default_Prim_Op_Position - indirect use
199 -- Exp_Disp.Set_All_DT_Position - direct use
201 procedure Apply_Tag_Checks (Call_Node : Node_Id);
202 -- Generate checks required on dispatching calls
204 function Building_Static_DT (Typ : Entity_Id) return Boolean;
205 pragma Inline (Building_Static_DT);
206 -- Returns true when building statically allocated dispatch tables
208 procedure Build_Static_Dispatch_Tables (N : Node_Id);
209 -- N is a library level package declaration or package body. Build the
210 -- static dispatch table of the tagged types defined at library level. In
211 -- case of package declarations with private part the generated nodes are
212 -- added at the end of the list of private declarations. Otherwise they are
213 -- added to the end of the list of public declarations. In case of package
214 -- bodies they are added to the end of the list of declarations of the
217 procedure Expand_Dispatching_Call (Call_Node : Node_Id);
218 -- Expand the call to the operation through the dispatch table and perform
219 -- the required tag checks when appropriate. For CPP types tag checks are
222 procedure Expand_Interface_Actuals (Call_Node : Node_Id);
223 -- Ada 2005 (AI-251): Displace all the actuals corresponding to class-wide
224 -- interfaces to reference the interface tag of the actual object
226 procedure Expand_Interface_Conversion
228 Is_Static : Boolean := True);
229 -- Ada 2005 (AI-251): N is a type-conversion node. Reference the base of
230 -- the object to give access to the interface tag associated with the
231 -- secondary dispatch table.
233 procedure Expand_Interface_Thunk
235 Thunk_Id : out Entity_Id;
236 Thunk_Code : out Node_Id);
237 -- Ada 2005 (AI-251): When a tagged type implements abstract interfaces we
238 -- generate additional subprograms (thunks) associated with each primitive
239 -- Prim to have a layout compatible with the C++ ABI. The thunk displaces
240 -- the pointers to the actuals that depend on the controlling type before
241 -- transferring control to the target subprogram. If there is no need to
242 -- generate the thunk then Thunk_Id and Thunk_Code are set to Empty.
243 -- Otherwise they are set to the defining identifier and the subprogram
244 -- body of the generated thunk.
246 function Get_SCIL_Node_Kind (Node : Node_Id) return SCIL_Node_Kind;
247 -- Returns the kind of an SCIL node
249 function Is_Predefined_Dispatching_Operation (E : Entity_Id) return Boolean;
250 -- Ada 2005 (AI-251): Determines if E is a predefined primitive operation
252 function Is_Predefined_Interface_Primitive (E : Entity_Id) return Boolean;
253 -- Ada 2005 (AI-345): Returns True if E is one of the predefined primitives
254 -- required to implement interfaces.
256 function Make_DT (Typ : Entity_Id; N : Node_Id := Empty) return List_Id;
257 -- Expand the declarations for the Dispatch Table. The node N is the
258 -- declaration that forces the generation of the table. It is used to place
259 -- error messages when the declaration leads to the freezing of a given
260 -- primitive operation that has an incomplete non- tagged formal.
262 function Make_Disp_Asynchronous_Select_Body
263 (Typ : Entity_Id) return Node_Id;
264 -- Ada 2005 (AI-345): Generate the body of the primitive operation of type
265 -- Typ used for dispatching in asynchronous selects. Generate a null body
266 -- if Typ is an interface type.
268 function Make_Disp_Asynchronous_Select_Spec
269 (Typ : Entity_Id) return Node_Id;
270 -- Ada 2005 (AI-345): Generate the specification of the primitive operation
271 -- of type Typ used for dispatching in asynchronous selects.
273 function Make_Disp_Conditional_Select_Body
274 (Typ : Entity_Id) return Node_Id;
275 -- Ada 2005 (AI-345): Generate the body of the primitive operation of type
276 -- Typ used for dispatching in conditional selects. Generate a null body
277 -- if Typ is an interface type.
279 function Make_Disp_Conditional_Select_Spec
280 (Typ : Entity_Id) return Node_Id;
281 -- Ada 2005 (AI-345): Generate the specification of the primitive operation
282 -- of type Typ used for dispatching in conditional selects.
284 function Make_Disp_Get_Prim_Op_Kind_Body
285 (Typ : Entity_Id) return Node_Id;
286 -- Ada 2005 (AI-345): Generate the body of the primitive operation of type
287 -- Typ used for retrieving the callable entity kind during dispatching in
288 -- asynchronous selects. Generate a null body if Typ is an interface type.
290 function Make_Disp_Get_Prim_Op_Kind_Spec
291 (Typ : Entity_Id) return Node_Id;
292 -- Ada 2005 (AI-345): Generate the specification of the primitive operation
293 -- of the type Typ use for retrieving the callable entity kind during
294 -- dispatching in asynchronous selects.
296 function Make_Disp_Get_Task_Id_Body
297 (Typ : Entity_Id) return Node_Id;
298 -- Ada 2005 (AI-345): Generate body of the primitive operation of type Typ
299 -- used for retrieving the _task_id field of a task interface class- wide
300 -- type. Generate a null body if Typ is an interface or a non-task type.
302 function Make_Disp_Get_Task_Id_Spec
303 (Typ : Entity_Id) return Node_Id;
304 -- Ada 2005 (AI-345): Generate the specification of the primitive operation
305 -- of type Typ used for retrieving the _task_id field of a task interface
308 function Make_Disp_Requeue_Body
309 (Typ : Entity_Id) return Node_Id;
310 -- Ada 2005 (AI05-0030): Generate the body of the primitive operation of
311 -- type Typ used for dispatching on requeue statements. Generate a body
312 -- containing a single null-statement if Typ is an interface type.
314 function Make_Disp_Requeue_Spec
315 (Typ : Entity_Id) return Node_Id;
316 -- Ada 2005 (AI05-0030): Generate the specification of the primitive
317 -- operation of type Typ used for dispatching requeue statements.
319 function Make_Disp_Timed_Select_Body
320 (Typ : Entity_Id) return Node_Id;
321 -- Ada 2005 (AI-345): Generate the body of the primitive operation of type
322 -- Typ used for dispatching in timed selects. Generate a body containing
323 -- a single null-statement if Typ is an interface type.
325 function Make_Disp_Timed_Select_Spec
326 (Typ : Entity_Id) return Node_Id;
327 -- Ada 2005 (AI-345): Generate the specification of the primitive operation
328 -- of type Typ used for dispatching in timed selects.
330 function Make_Select_Specific_Data_Table
331 (Typ : Entity_Id) return List_Id;
332 -- Ada 2005 (AI-345): Create and populate the auxiliary table in the TSD
333 -- of Typ used for dispatching in asynchronous, conditional and timed
334 -- selects. Generate code to set the primitive operation kinds and entry
335 -- indices of primitive operations and primitive wrappers.
337 function Make_Tags (Typ : Entity_Id) return List_Id;
338 -- Generate the entities associated with the primary and secondary tags of
339 -- Typ and fill the contents of Access_Disp_Table. In case of library level
340 -- tagged types this routine imports the forward declaration of the tag
341 -- entity, that will be declared and exported by Make_DT.
343 function New_SCIL_Node
344 (SN_Kind : SCIL_Node_Kind;
345 Related_Node : Node_Id;
346 Entity : Entity_Id := Empty;
347 Target_Prim : Entity_Id := Empty) return Node_Id;
348 -- Creates a new Scil node. Related_Node is the AST node associated with
349 -- this Scil node. Entity is the tagged type associated with the Scil node.
350 -- For Dispatching_Call nodes, Target_Prim is the dispatching primitive.
352 function Register_Primitive
354 Prim : Entity_Id) return List_Id;
355 -- Build code to register Prim in the primary or secondary dispatch table.
356 -- If Prim is associated with a secondary dispatch table then generate also
357 -- its thunk and register it in the associated secondary dispatch table.
358 -- In general the dispatch tables are always generated by Make_DT and
359 -- Make_Secondary_DT; this routine is only used in two corner cases:
361 -- 1) To construct the dispatch table of a tagged type whose parent
362 -- is a CPP_Class (see Build_Init_Procedure).
363 -- 2) To handle late overriding of dispatching operations (see
364 -- Check_Dispatching_Operation and Make_DT).
366 -- The caller is responsible for inserting the generated code in the
369 procedure Set_All_DT_Position (Typ : Entity_Id);
370 -- Set the DT_Position field for each primitive operation. In the CPP
371 -- Class case check that no pragma CPP_Virtual is missing and that the
372 -- DT_Position are coherent
374 procedure Set_CPP_Constructors (Typ : Entity_Id);
375 -- Typ is a CPP_Class type. Create the Init procedures of that type
376 -- required to handle its default and non-default constructors. The
377 -- functions to which pragma CPP_Constructor is applied in the sources
378 -- are functions returning this type, and having an implicit access to the
379 -- target object in its first argument; such implicit argument is explicit
380 -- in the IP procedures built here.
382 procedure Set_DTC_Entity_Value
383 (Tagged_Type : Entity_Id;
385 -- Set the definite value of the DTC_Entity value associated with a given
386 -- primitive of a tagged type.
388 procedure Write_DT (Typ : Entity_Id);
389 pragma Export (Ada, Write_DT);
390 -- Debugging procedure (to be called within gdb)