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 -- Predefined primitive operations --
35 -------------------------------------
37 -- The predefined primitive operations (PPOs) are subprograms generated
38 -- by GNAT for a particular tagged type. Their role is to provide support
39 -- for different Ada language features such as the attribute 'Size or
40 -- handling of dispatching triggers in select statements. PPOs are created
41 -- when a tagged type is expanded or frozen. These subprograms are later
42 -- collected and inserted into the dispatch table of a tagged type at
43 -- fixed positions. Some of the PPOs that manipulate data in tagged objects
44 -- require the generation of thunks.
46 -- List of predefined primitive operations
48 -- Leading underscores designate reserved names. Bracketed numerical
49 -- values represent dispatch table slot numbers.
51 -- _Size (1) - implementation of the attribute 'Size for any tagged
52 -- type. Constructs of the form Prefix'Size are converted into
55 -- _Alignment (2) - implementation of the attribute 'Alignment for
56 -- any tagged type. Constructs of the form Prefix'Alignment are
57 -- converted into Prefix._Alignment.
59 -- TSS_Stream_Read (3) - implementation of the stream attribute Read
60 -- for any tagged type.
62 -- TSS_Stream_Write (4) - implementation of the stream attribute Write
63 -- for any tagged type.
65 -- TSS_Stream_Input (5) - implementation of the stream attribute Input
66 -- for any tagged type.
68 -- TSS_Stream_Output (6) - implementation of the stream attribute
69 -- Output for any tagged type.
71 -- Op_Eq (7) - implementation of the equality operator for any non-
72 -- limited tagged type.
74 -- _Assign (8) - implementation of the assignment operator for any
75 -- non-limited tagged type.
77 -- TSS_Deep_Adjust (9) - implementation of the finalization operation
78 -- Adjust for any non-limited tagged type.
80 -- TSS_Deep_Finalize (10) - implementation of the finalization
81 -- operation Finalize for any non-limited tagged type.
83 -- _Disp_Asynchronous_Select (11) - used in the expansion of ATC with
84 -- dispatching triggers. Null implementation for limited interfaces,
85 -- full body generation for types that implement limited interfaces,
86 -- not generated for the rest of the cases. See Expand_N_Asynchronous_
87 -- Select in Exp_Ch9 for more information.
89 -- _Disp_Conditional_Select (12) - used in the expansion of conditional
90 -- selects with dispatching triggers. Null implementation for limited
91 -- interfaces, full body generation for types that implement limited
92 -- interfaces, not generated for the rest of the cases. See Expand_N_
93 -- Conditional_Entry_Call in Exp_Ch9 for more information.
95 -- _Disp_Get_Prim_Op_Kind (13) - helper routine used in the expansion
96 -- of ATC with dispatching triggers. Null implementation for limited
97 -- interfaces, full body generation for types that implement limited
98 -- interfaces, not generated for the rest of the cases.
100 -- _Disp_Get_Task_Id (14) - helper routine used in the expansion of
101 -- Abort, attributes 'Callable and 'Terminated for task interface
102 -- class-wide types. Full body generation for task types, null
103 -- implementation for limited interfaces, not generated for the rest
104 -- of the cases. See Expand_N_Attribute_Reference in Exp_Attr and
105 -- Expand_N_Abort_Statement in Exp_Ch9 for more information.
107 -- _Disp_Requeue (15) - used in the expansion of dispatching requeue
108 -- statements. Null implementation is provided for protected, task
109 -- and synchronized interfaces. Protected and task types implementing
110 -- concurrent interfaces receive full bodies. See Expand_N_Requeue_
111 -- Statement in Exp_Ch9 for more information.
113 -- _Disp_Timed_Select (16) - used in the expansion of timed selects
114 -- with dispatching triggers. Null implementation for limited
115 -- interfaces, full body generation for types that implement limited
116 -- interfaces, not generated for the rest of the cases. See Expand_N_
117 -- Timed_Entry_Call for more information.
119 -- Life cycle of predefined primitive operations
121 -- The specifications and bodies of the PPOs are created by
122 -- Make_Predefined_Primitive_Specs and Predefined_Primitive_Bodies
123 -- in Exp_Ch3. The generated specifications are immediately analyzed,
124 -- while the bodies are left as freeze actions to the tagged type for
125 -- which they are created.
127 -- PPOs are collected and added to the Primitive_Operations list of
128 -- a type by the regular analysis mechanism.
130 -- PPOs are frozen by Exp_Ch3.Predefined_Primitive_Freeze
132 -- Thunks for PPOs are created by Make_DT
134 -- Dispatch table positions of PPOs are set by Set_All_DT_Position
136 -- Calls to PPOs proceed as regular dispatching calls. If the PPO
137 -- has a thunk, a call proceeds as a regular dispatching call with
140 -- Guidelines for addition of new predefined primitive operations
142 -- Update the value of constant Max_Predef_Prims in a-tags.ads to
143 -- indicate the new number of PPOs.
145 -- Introduce a new predefined name for the new PPO in Snames.ads and
148 -- Categorize the new PPO name as predefined by adding an entry in
149 -- Is_Predefined_Dispatching_Operation in Exp_Disp.
151 -- Generate the specification of the new PPO in Make_Predefined_
152 -- Primitive_Spec in Exp_Ch3.adb. The Is_Internal flag of the defining
153 -- identifier of the specification must be set to True.
155 -- Generate the body of the new PPO in Predefined_Primitive_Bodies in
156 -- Exp_Ch3.adb. The Is_Internal flag of the defining identifier of the
157 -- specification must be set to True.
159 -- If the new PPO requires a thunk, add an entry in Freeze_Subprogram
162 -- When generating calls to a PPO, use Find_Prim_Op from Exp_Util.ads
163 -- to retrieve the entity of the operation directly.
165 -- Number of predefined primitive operations added by the Expander
166 -- for a tagged type. If more predefined primitive operations are
167 -- added, the following items must be changed:
169 -- Ada.Tags.Max_Predef_Prims - indirect use
170 -- Exp_Disp.Default_Prim_Op_Position - indirect use
171 -- Exp_Disp.Set_All_DT_Position - direct use
173 procedure Apply_Tag_Checks
(Call_Node
: Node_Id
);
174 -- Generate checks required on dispatching calls
176 function Building_Static_DT
(Typ
: Entity_Id
) return Boolean;
177 pragma Inline
(Building_Static_DT
);
178 -- Returns true when building statically allocated dispatch tables
180 procedure Build_Static_Dispatch_Tables
(N
: Node_Id
);
181 -- N is a library level package declaration or package body. Build the
182 -- static dispatch table of the tagged types defined at library level. In
183 -- case of package declarations with private part the generated nodes are
184 -- added at the end of the list of private declarations. Otherwise they are
185 -- added to the end of the list of public declarations. In case of package
186 -- bodies they are added to the end of the list of declarations of the
189 procedure Expand_Dispatching_Call
(Call_Node
: Node_Id
);
190 -- Expand the call to the operation through the dispatch table and perform
191 -- the required tag checks when appropriate. For CPP types tag checks are
194 procedure Expand_Interface_Actuals
(Call_Node
: Node_Id
);
195 -- Ada 2005 (AI-251): Displace all the actuals corresponding to class-wide
196 -- interfaces to reference the interface tag of the actual object
198 procedure Expand_Interface_Conversion
200 Is_Static
: Boolean := True);
201 -- Ada 2005 (AI-251): N is a type-conversion node. Reference the base of
202 -- the object to give access to the interface tag associated with the
203 -- secondary dispatch table.
205 procedure Expand_Interface_Thunk
207 Thunk_Id
: out Entity_Id
;
208 Thunk_Code
: out Node_Id
);
209 -- Ada 2005 (AI-251): When a tagged type implements abstract interfaces we
210 -- generate additional subprograms (thunks) associated with each primitive
211 -- Prim to have a layout compatible with the C++ ABI. The thunk displaces
212 -- the pointers to the actuals that depend on the controlling type before
213 -- transferring control to the target subprogram. If there is no need to
214 -- generate the thunk then Thunk_Id and Thunk_Code are set to Empty.
215 -- Otherwise they are set to the defining identifier and the subprogram
216 -- body of the generated thunk.
218 function Is_Predefined_Dispatching_Operation
(E
: Entity_Id
) return Boolean;
219 -- Ada 2005 (AI-251): Determines if E is a predefined primitive operation
221 function Is_Predefined_Internal_Operation
(E
: Entity_Id
) return Boolean;
222 -- Similar to the previous one, but excludes stream operations, because
223 -- these may be overridden, and need extra formals, like user-defined
226 function Is_Predefined_Interface_Primitive
(E
: Entity_Id
) return Boolean;
227 -- Ada 2005 (AI-345): Returns True if E is one of the predefined primitives
228 -- required to implement interfaces.
230 function Make_DT
(Typ
: Entity_Id
; N
: Node_Id
:= Empty
) return List_Id
;
231 -- Expand the declarations for the Dispatch Table. The node N is the
232 -- declaration that forces the generation of the table. It is used to place
233 -- error messages when the declaration leads to the freezing of a given
234 -- primitive operation that has an incomplete non- tagged formal.
236 function Make_Disp_Asynchronous_Select_Body
237 (Typ
: Entity_Id
) return Node_Id
;
238 -- Ada 2005 (AI-345): Generate the body of the primitive operation of type
239 -- Typ used for dispatching in asynchronous selects. Generate a null body
240 -- if Typ is an interface type.
242 function Make_Disp_Asynchronous_Select_Spec
243 (Typ
: Entity_Id
) return Node_Id
;
244 -- Ada 2005 (AI-345): Generate the specification of the primitive operation
245 -- of type Typ used for dispatching in asynchronous selects.
247 function Make_Disp_Conditional_Select_Body
248 (Typ
: Entity_Id
) return Node_Id
;
249 -- Ada 2005 (AI-345): Generate the body of the primitive operation of type
250 -- Typ used for dispatching in conditional selects. Generate a null body
251 -- if Typ is an interface type.
253 function Make_Disp_Conditional_Select_Spec
254 (Typ
: Entity_Id
) return Node_Id
;
255 -- Ada 2005 (AI-345): Generate the specification of the primitive operation
256 -- of type Typ used for dispatching in conditional selects.
258 function Make_Disp_Get_Prim_Op_Kind_Body
259 (Typ
: Entity_Id
) return Node_Id
;
260 -- Ada 2005 (AI-345): Generate the body of the primitive operation of type
261 -- Typ used for retrieving the callable entity kind during dispatching in
262 -- asynchronous selects. Generate a null body if Typ is an interface type.
264 function Make_Disp_Get_Prim_Op_Kind_Spec
265 (Typ
: Entity_Id
) return Node_Id
;
266 -- Ada 2005 (AI-345): Generate the specification of the primitive operation
267 -- of the type Typ use for retrieving the callable entity kind during
268 -- dispatching in asynchronous selects.
270 function Make_Disp_Get_Task_Id_Body
271 (Typ
: Entity_Id
) return Node_Id
;
272 -- Ada 2005 (AI-345): Generate body of the primitive operation of type Typ
273 -- used for retrieving the _task_id field of a task interface class- wide
274 -- type. Generate a null body if Typ is an interface or a non-task type.
276 function Make_Disp_Get_Task_Id_Spec
277 (Typ
: Entity_Id
) return Node_Id
;
278 -- Ada 2005 (AI-345): Generate the specification of the primitive operation
279 -- of type Typ used for retrieving the _task_id field of a task interface
282 function Make_Disp_Requeue_Body
283 (Typ
: Entity_Id
) return Node_Id
;
284 -- Ada 2005 (AI05-0030): Generate the body of the primitive operation of
285 -- type Typ used for dispatching on requeue statements. Generate a body
286 -- containing a single null-statement if Typ is an interface type.
288 function Make_Disp_Requeue_Spec
289 (Typ
: Entity_Id
) return Node_Id
;
290 -- Ada 2005 (AI05-0030): Generate the specification of the primitive
291 -- operation of type Typ used for dispatching requeue statements.
293 function Make_Disp_Timed_Select_Body
294 (Typ
: Entity_Id
) return Node_Id
;
295 -- Ada 2005 (AI-345): Generate the body of the primitive operation of type
296 -- Typ used for dispatching in timed selects. Generate a body containing
297 -- a single null-statement if Typ is an interface type.
299 function Make_Disp_Timed_Select_Spec
300 (Typ
: Entity_Id
) return Node_Id
;
301 -- Ada 2005 (AI-345): Generate the specification of the primitive operation
302 -- of type Typ used for dispatching in timed selects.
304 function Make_Select_Specific_Data_Table
305 (Typ
: Entity_Id
) return List_Id
;
306 -- Ada 2005 (AI-345): Create and populate the auxiliary table in the TSD
307 -- of Typ used for dispatching in asynchronous, conditional and timed
308 -- selects. Generate code to set the primitive operation kinds and entry
309 -- indices of primitive operations and primitive wrappers.
311 function Make_Tags
(Typ
: Entity_Id
) return List_Id
;
312 -- Generate the entities associated with the primary and secondary tags of
313 -- Typ and fill the contents of Access_Disp_Table. In case of library level
314 -- tagged types this routine imports the forward declaration of the tag
315 -- entity, that will be declared and exported by Make_DT.
317 function Register_Primitive
319 Prim
: Entity_Id
) return List_Id
;
320 -- Build code to register Prim in the primary or secondary dispatch table.
321 -- If Prim is associated with a secondary dispatch table then generate also
322 -- its thunk and register it in the associated secondary dispatch table.
323 -- In general the dispatch tables are always generated by Make_DT and
324 -- Make_Secondary_DT; this routine is only used in two corner cases:
326 -- 1) To construct the dispatch table of a tagged type whose parent
327 -- is a CPP_Class (see Build_Init_Procedure).
328 -- 2) To handle late overriding of dispatching operations (see
329 -- Check_Dispatching_Operation and Make_DT).
331 -- The caller is responsible for inserting the generated code in the
334 procedure Set_All_DT_Position
(Typ
: Entity_Id
);
335 -- Set the DT_Position field for each primitive operation. In the CPP
336 -- Class case check that no pragma CPP_Virtual is missing and that the
337 -- DT_Position are coherent
339 procedure Set_CPP_Constructors
(Typ
: Entity_Id
);
340 -- Typ is a CPP_Class type. Create the Init procedures of that type
341 -- required to handle its default and non-default constructors. The
342 -- functions to which pragma CPP_Constructor is applied in the sources
343 -- are functions returning this type, and having an implicit access to the
344 -- target object in its first argument; such implicit argument is explicit
345 -- in the IP procedures built here.
347 procedure Set_DTC_Entity_Value
348 (Tagged_Type
: Entity_Id
;
350 -- Set the definite value of the DTC_Entity value associated with a given
351 -- primitive of a tagged type.
353 procedure Write_DT
(Typ
: Entity_Id
);
354 pragma Export
(Ada
, Write_DT
);
355 -- Debugging procedure (to be called within gdb)