summaryrefslogtreecommitdiff
path: root/gcc/ada/exp_disp.ads
blob: 4ec53e127f733f00ee387fa9f9bbcae7d38ea1e0 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
------------------------------------------------------------------------------
--                                                                          --
--                         GNAT COMPILER COMPONENTS                         --
--                                                                          --
--                             E X P _ D I S P                              --
--                                                                          --
--                                 GS p e c                                  --
--                                                                          --
--          Copyright (C) 1992-2015, Free Software Foundation, Inc.         --
--                                                                          --
-- GNAT is free software;  you can  redistribute it  and/or modify it under --
-- terms of the  GNU General Public License as published  by the Free Soft- --
-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
-- for  more details.  You should have  received  a copy of the GNU General --
-- Public License  distributed with GNAT; see file COPYING3.  If not, go to --
-- http://www.gnu.org/licenses for a complete copy of the license.          --
--                                                                          --
-- GNAT was originally developed  by the GNAT team at  New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc.      --
--                                                                          --
------------------------------------------------------------------------------

--  This package contains routines involved in tagged types and dynamic
--  dispatching expansion.

with Types; use Types;
with Uintp; use Uintp;

package Exp_Disp is

   -------------------------------------
   -- Predefined primitive operations --
   -------------------------------------

   --  The predefined primitive operations (PPOs) are subprograms generated
   --  by GNAT for a particular tagged type. Their role is to provide support
   --  for different Ada language features such as the attribute 'Size or
   --  handling of dispatching triggers in select statements. PPOs are created
   --  when a tagged type is expanded or frozen. These subprograms are later
   --  collected and inserted into the dispatch table of a tagged type at
   --  fixed positions. Some of the PPOs that manipulate data in tagged objects
   --  require the generation of thunks.

   --  List of predefined primitive operations

   --    Leading underscores designate reserved names. Bracketed numerical
   --    values represent dispatch table slot numbers.

   --      _Size (1) - implementation of the attribute 'Size for any tagged
   --      type. Constructs of the form Prefix'Size are converted into
   --      Prefix._Size.

   --      TSS_Stream_Read (2) - implementation of the stream attribute Read
   --      for any tagged type.

   --      TSS_Stream_Write (3) - implementation of the stream attribute Write
   --      for any tagged type.

   --      TSS_Stream_Input (4) - implementation of the stream attribute Input
   --      for any tagged type.

   --      TSS_Stream_Output (5) - implementation of the stream attribute
   --      Output for any tagged type.

   --      Op_Eq (6) - implementation of the equality operator for any non-
   --      limited tagged type.

   --      _Assign (7) - implementation of the assignment operator for any
   --      non-limited tagged type.

   --      TSS_Deep_Adjust (8) - implementation of the finalization operation
   --      Adjust for any non-limited tagged type.

   --      TSS_Deep_Finalize (9) - implementation of the finalization
   --      operation Finalize for any non-limited tagged type.

   --      _Disp_Asynchronous_Select (10) - used in the expansion of ATC with
   --      dispatching triggers. Null implementation for limited interfaces,
   --      full body generation for types that implement limited interfaces,
   --      not generated for the rest of the cases. See Expand_N_Asynchronous_
   --      Select in Exp_Ch9 for more information.

   --      _Disp_Conditional_Select (11) - used in the expansion of conditional
   --      selects with dispatching triggers. Null implementation for limited
   --      interfaces, full body generation for types that implement limited
   --      interfaces, not generated for the rest of the cases. See Expand_N_
   --      Conditional_Entry_Call in Exp_Ch9 for more information.

   --      _Disp_Get_Prim_Op_Kind (12) - helper routine used in the expansion
   --      of ATC with dispatching triggers. Null implementation for limited
   --      interfaces, full body generation for types that implement limited
   --      interfaces, not generated for the rest of the cases.

   --      _Disp_Get_Task_Id (13) - helper routine used in the expansion of
   --      Abort, attributes 'Callable and 'Terminated for task interface
   --      class-wide types. Full body generation for task types, null
   --      implementation for limited interfaces, not generated for the rest
   --      of the cases. See Expand_N_Attribute_Reference in Exp_Attr and
   --      Expand_N_Abort_Statement in Exp_Ch9 for more information.

   --      _Disp_Requeue (14) - used in the expansion of dispatching requeue
   --      statements. Null implementation is provided for protected, task
   --      and synchronized interfaces. Protected and task types implementing
   --      concurrent interfaces receive full bodies. See Expand_N_Requeue_
   --      Statement in Exp_Ch9 for more information.

   --      _Disp_Timed_Select (15) - used in the expansion of timed selects
   --      with dispatching triggers. Null implementation for limited
   --      interfaces, full body generation for types that implement limited
   --      interfaces, not generated for the rest of the cases. See Expand_N_
   --      Timed_Entry_Call for more information.

   --  Life cycle of predefined primitive operations

   --      The specifications and bodies of the PPOs are created by
   --      Make_Predefined_Primitive_Specs and Predefined_Primitive_Bodies
   --      in Exp_Ch3. The generated specifications are immediately analyzed,
   --      while the bodies are left as freeze actions to the tagged type for
   --      which they are created.

   --      PPOs are collected and added to the Primitive_Operations list of
   --      a type by the regular analysis mechanism.

   --      PPOs are frozen by Exp_Ch3.Predefined_Primitive_Freeze

   --      Thunks for PPOs are created by Make_DT

   --      Dispatch table positions of PPOs are set by Set_All_DT_Position

   --      Calls to PPOs proceed as regular dispatching calls. If the PPO
   --      has a thunk, a call proceeds as a regular dispatching call with
   --      a thunk.

   --  Guidelines for addition of new predefined primitive operations

   --      Update the value of constant Max_Predef_Prims in a-tags.ads to
   --      indicate the new number of PPOs.

   --      Introduce a new predefined name for the new PPO in Snames.ads and
   --      Snames.adb.

   --      Categorize the new PPO name as predefined by adding an entry in
   --      Is_Predefined_Dispatching_Operation in Exp_Disp.

   --      Generate the specification of the new PPO in Make_Predefined_
   --      Primitive_Spec in Exp_Ch3.adb. The Is_Internal flag of the defining
   --      identifier of the specification must be set to True.

   --      Generate the body of the new PPO in Predefined_Primitive_Bodies in
   --      Exp_Ch3.adb. The Is_Internal flag of the defining identifier of the
   --      specification must be set to True.

   --      If the new PPO requires a thunk, add an entry in Freeze_Subprogram
   --      in Exp_Ch6.adb.

   --      When generating calls to a PPO, use Find_Prim_Op from Exp_Util.ads
   --      to retrieve the entity of the operation directly.

   --  Number of predefined primitive operations added by the Expander
   --  for a tagged type. If more predefined primitive operations are
   --  added, the following items must be changed:

   --    Ada.Tags.Max_Predef_Prims         - indirect use
   --    Exp_Disp.Default_Prim_Op_Position - indirect use
   --    Exp_Disp.Set_All_DT_Position      - direct   use

   procedure Apply_Tag_Checks (Call_Node : Node_Id);
   --  Generate checks required on dispatching calls

   function Building_Static_DT (Typ : Entity_Id) return Boolean;
   pragma Inline (Building_Static_DT);
   --  Returns true when building statically allocated dispatch tables

   procedure Build_Static_Dispatch_Tables (N : Node_Id);
   --  N is a library level package declaration or package body. Build the
   --  static dispatch table of the tagged types defined at library level. In
   --  case of package declarations with private part the generated nodes are
   --  added at the end of the list of private declarations. Otherwise they are
   --  added to the end of the list of public declarations. In case of package
   --  bodies they are added to the end of the list of declarations of the
   --  package body.

   function Convert_Tag_To_Interface
     (Typ : Entity_Id; Expr : Node_Id) return Node_Id;
   pragma Inline (Convert_Tag_To_Interface);
   --  This function is used in class-wide interface conversions; the expanded
   --  code generated to convert a tagged object to a class-wide interface type
   --  involves referencing the tag component containing the secondary dispatch
   --  table associated with the interface. Given the expression Expr that
   --  references a tag component, we cannot generate an unchecked conversion
   --  to leave the expression decorated with the class-wide interface type Typ
   --  because an unchecked conversion cannot be seen as a no-op. An unchecked
   --  conversion is conceptually a function call and therefore the RM allows
   --  the backend to obtain a copy of the value of the actual object and store
   --  it in some other place (like a register); in such case the interface
   --  conversion is not equivalent to a displacement of the pointer to the
   --  interface and any further displacement fails. Although the functionality
   --  of this function is simple and could be done directly, the purpose of
   --  this routine is to leave well documented in the sources these
   --  occurrences.

   --  If Expr is an N_Selected_Component that references a tag generate:
   --     type ityp is non null access Typ;
   --     ityp!(Expr'Address).all

   --  if Expr is an N_Function_Call to Ada.Tags.Displace then generate:
   --     type ityp is non null access Typ;
   --     ityp!(Expr).all

   function CPP_Num_Prims (Typ : Entity_Id) return Nat;
   --  Return the number of primitives of the C++ part of the dispatch table.
   --  For types that are not derivations of CPP types return 0.

   procedure Expand_Dispatching_Call (Call_Node : Node_Id);
   --  Expand the call to the operation through the dispatch table and perform
   --  the required tag checks when appropriate. For CPP types tag checks are
   --  not relevant.

   procedure Expand_Interface_Actuals (Call_Node : Node_Id);
   --  Ada 2005 (AI-251): Displace all the actuals corresponding to class-wide
   --  interfaces to reference the interface tag of the actual object

   procedure Expand_Interface_Conversion (N : Node_Id);
   --  Ada 2005 (AI-251): N is a type-conversion node. Displace the pointer
   --  to the object to give access to the interface tag associated with the
   --  dispatch table of the target type.

   procedure Expand_Interface_Thunk
     (Prim       : Node_Id;
      Thunk_Id   : out Entity_Id;
      Thunk_Code : out Node_Id);
   --  Ada 2005 (AI-251): When a tagged type implements abstract interfaces we
   --  generate additional subprograms (thunks) associated with each primitive
   --  Prim to have a layout compatible with the C++ ABI. The thunk displaces
   --  the pointers to the actuals that depend on the controlling type before
   --  transferring control to the target subprogram. If there is no need to
   --  generate the thunk then Thunk_Id and Thunk_Code are set to Empty.
   --  Otherwise they are set to the defining identifier and the subprogram
   --  body of the generated thunk.

   function Has_CPP_Constructors (Typ : Entity_Id) return Boolean;
   --  Returns true if the type has CPP constructors

   function Is_Expanded_Dispatching_Call (N : Node_Id) return Boolean;
   --  Returns true if N is the expanded code of a dispatching call

   function Is_Predefined_Dispatching_Operation (E : Entity_Id) return Boolean;
   --  Ada 2005 (AI-251): Determines if E is a predefined primitive operation

   function Is_Predefined_Internal_Operation (E : Entity_Id) return Boolean;
   --  Similar to the previous one, but excludes stream operations, because
   --  these may be overridden, and need extra formals, like user-defined
   --  operations.

   function Is_Predefined_Interface_Primitive (E : Entity_Id) return Boolean;
   --  Ada 2005 (AI-345): Returns True if E is one of the predefined primitives
   --  required to implement interfaces.

   function Make_DT (Typ : Entity_Id; N : Node_Id := Empty) return List_Id;
   --  Expand the declarations for the Dispatch Table. The node N is the
   --  declaration that forces the generation of the table. It is used to place
   --  error messages when the declaration leads to the freezing of a given
   --  primitive operation that has an incomplete non- tagged formal.

   function Make_Disp_Asynchronous_Select_Body
     (Typ : Entity_Id) return Node_Id;
   --  Ada 2005 (AI-345): Generate the body of the primitive operation of type
   --  Typ used for dispatching in asynchronous selects. Generate a null body
   --  if Typ is an interface type.

   function Make_Disp_Asynchronous_Select_Spec
     (Typ : Entity_Id) return Node_Id;
   --  Ada 2005 (AI-345): Generate the specification of the primitive operation
   --  of type Typ used for dispatching in asynchronous selects.

   function Make_Disp_Conditional_Select_Body
     (Typ : Entity_Id) return Node_Id;
   --  Ada 2005 (AI-345): Generate the body of the primitive operation of type
   --  Typ used for dispatching in conditional selects. Generate a null body
   --  if Typ is an interface type.

   function Make_Disp_Conditional_Select_Spec
     (Typ : Entity_Id) return Node_Id;
   --  Ada 2005 (AI-345): Generate the specification of the primitive operation
   --  of type Typ used for dispatching in conditional selects.

   function Make_Disp_Get_Prim_Op_Kind_Body
     (Typ : Entity_Id) return Node_Id;
   --  Ada 2005 (AI-345): Generate the body of the primitive operation of type
   --  Typ used for retrieving the callable entity kind during dispatching in
   --  asynchronous selects. Generate a null body if Typ is an interface type.

   function Make_Disp_Get_Prim_Op_Kind_Spec
     (Typ : Entity_Id) return Node_Id;
   --  Ada 2005 (AI-345): Generate the specification of the primitive operation
   --  of the type Typ use for retrieving the callable entity kind during
   --  dispatching in asynchronous selects.

   function Make_Disp_Get_Task_Id_Body
     (Typ : Entity_Id) return Node_Id;
   --  Ada 2005 (AI-345): Generate body of the primitive operation of type Typ
   --  used for retrieving the _task_id field of a task interface class- wide
   --  type. Generate a null body if Typ is an interface or a non-task type.

   function Make_Disp_Get_Task_Id_Spec
     (Typ : Entity_Id) return Node_Id;
   --  Ada 2005 (AI-345): Generate the specification of the primitive operation
   --  of type Typ used for retrieving the _task_id field of a task interface
   --  class-wide type.

   function Make_Disp_Requeue_Body
     (Typ : Entity_Id) return Node_Id;
   --  Ada 2005 (AI05-0030): Generate the body of the primitive operation of
   --  type Typ used for dispatching on requeue statements. Generate a body
   --  containing a single null-statement if Typ is an interface type.

   function Make_Disp_Requeue_Spec
     (Typ : Entity_Id) return Node_Id;
   --  Ada 2005 (AI05-0030): Generate the specification of the primitive
   --  operation of type Typ used for dispatching requeue statements.

   function Make_Disp_Timed_Select_Body
     (Typ : Entity_Id) return Node_Id;
   --  Ada 2005 (AI-345): Generate the body of the primitive operation of type
   --  Typ used for dispatching in timed selects. Generate a body containing
   --  a single null-statement if Typ is an interface type.

   function Make_Disp_Timed_Select_Spec
     (Typ : Entity_Id) return Node_Id;
   --  Ada 2005 (AI-345): Generate the specification of the primitive operation
   --  of type Typ used for dispatching in timed selects.

   function Make_Select_Specific_Data_Table
     (Typ : Entity_Id) return List_Id;
   --  Ada 2005 (AI-345): Create and populate the auxiliary table in the TSD
   --  of Typ used for dispatching in asynchronous, conditional and timed
   --  selects. Generate code to set the primitive operation kinds and entry
   --  indexes of primitive operations and primitive wrappers.

   function Make_Tags (Typ : Entity_Id) return List_Id;
   --  Generate the entities associated with the primary and secondary tags of
   --  Typ and fill the contents of Access_Disp_Table. In case of library level
   --  tagged types this routine imports the forward declaration of the tag
   --  entity, that will be declared and exported by Make_DT.

   function Register_Primitive
     (Loc     : Source_Ptr;
      Prim    : Entity_Id) return List_Id;
   --  Build code to register Prim in the primary or secondary dispatch table.
   --  If Prim is associated with a secondary dispatch table then generate also
   --  its thunk and register it in the associated secondary dispatch table.
   --  In general the dispatch tables are always generated by Make_DT and
   --  Make_Secondary_DT; this routine is only used in two corner cases:
   --
   --    1) To construct the dispatch table of a tagged type whose parent
   --       is a CPP_Class (see Build_Init_Procedure).
   --    2) To handle late overriding of dispatching operations (see
   --       Check_Dispatching_Operation and Make_DT).
   --
   --  The caller is responsible for inserting the generated code in the
   --  proper place.

   procedure Set_All_DT_Position (Typ : Entity_Id);
   --  Set the DT_Position field for each primitive operation. In the CPP
   --  Class case check that no pragma CPP_Virtual is missing and that the
   --  DT_Position are coherent

   procedure Set_CPP_Constructors (Typ : Entity_Id);
   --  Typ is a CPP_Class type. Create the Init procedures of that type
   --  required to handle its default and non-default constructors. The
   --  functions to which pragma CPP_Constructor is applied in the sources
   --  are functions returning this type, and having an implicit access to the
   --  target object in its first argument; such implicit argument is explicit
   --  in the IP procedures built here.

   procedure Set_DT_Position_Value (Prim  : Entity_Id; Value : Uint);
   --  Set the position of a dispatching primitive its dispatch table. For
   --  subprogram wrappers propagate the value to the wrapped subprogram.

   procedure Set_DTC_Entity_Value (Tagged_Type : Entity_Id; Prim : Entity_Id);
   --  Set the definite value of the DTC_Entity value associated with a given
   --  primitive of a tagged type. For subprogram wrappers, propagate the value
   --  to the wrapped subprogram.

   procedure Write_DT (Typ : Entity_Id);
   pragma Export (Ada, Write_DT);
   --  Debugging procedure (to be called within gdb)

end Exp_Disp;