gcc/ada/exp_disp.ads

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --                             E X P _ D I S P                              --
   6 --                                                                          --
   7 --                                 S p e c                                  --
   8 --                                                                          --
   9 --          Copyright (C) 1992-2007, Free Software Foundation, Inc.         --
  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 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.                                              --
  21 --                                                                          --
  22 -- GNAT was originally developed  by the GNAT team at  New York University. --
  23 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  24 --                                                                          --
  25 ------------------------------------------------------------------------------
  26
  27 --  This package contains routines involved in tagged types and dynamic
  28 --  dispatching expansion.
  29
  30 with Types; use Types;
  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    --      _Alignment (2) - implementation of the attribute 'Alignment for
  57    --      any tagged type. Constructs of the form Prefix'Alignment are
  58    --      converted into Prefix._Alignment.
  59
  60    --      TSS_Stream_Read (3) - implementation of the stream attribute Read
  61    --      for any tagged type.
  62
  63    --      TSS_Stream_Write (4) - implementation of the stream attribute Write
  64    --      for any tagged type.
  65
  66    --      TSS_Stream_Input (5) - implementation of the stream attribute Input
  67    --      for any tagged type.
  68
  69    --      TSS_Stream_Output (6) - implementation of the stream attribute
  70    --      Output for any tagged type.
  71
  72    --      Op_Eq (7) - implementation of the equality operator for any non-
  73    --      limited tagged type.
  74
  75    --      _Assign (8) - implementation of the assignment operator for any
  76    --      non-limited tagged type.
  77
  78    --      TSS_Deep_Adjust (9) - implementation of the finalization operation
  79    --      Adjust for any non-limited tagged type.
  80
  81    --      TSS_Deep_Finalize (10) - implementation of the finalization
  82    --      operation Finalize for any non-limited tagged type.
  83
  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.
  89
  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.
  95
  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.
 100
 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.
 107
 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.
 113
 114    --  Life cycle of predefined primitive operations
 115
 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.
 121
 122    --      PPOs are collected and added to the Primitive_Operations list of
 123    --      a type by the regular analysis mechanism.
 124
 125    --      PPOs are frozen by Exp_Ch3.Predefined_Primitive_Freeze
 126
 127    --      Thunks for PPOs are created by Make_DT
 128
 129    --      Dispatch table positions of PPOs are set by Set_All_DT_Position
 130
 131    --      Calls to PPOs proceed as regular dispatching calls. If the PPO
 132    --      has a thunk, a call proceeds as a regular dispatching call with
 133    --      a thunk.
 134
 135    --  Guidelines for addition of new predefined primitive operations
 136
 137    --      Update the value of constant Max_Predef_Prims in a-tags.ads to
 138    --      indicate the new number of PPOs.
 139
 140    --      Introduce a new predefined name for the new PPO in Snames.ads and
 141    --      Snames.adb.
 142
 143    --      Categorize the new PPO name as predefined by adding an entry in
 144    --      Is_Predefined_Dispatching_Operation in Exp_Util.adb.
 145
 146    --      Generate the specification of the new PPO in Make_Predefined_
 147    --      Primitive_Spec in Exp_Ch3.adb. The Is_Internal flag of the defining
 148    --      identifier of the specification must be set to True.
 149
 150    --      Generate the body of the new PPO in Predefined_Primitive_Bodies in
 151    --      Exp_Ch3.adb. The Is_Internal flag of the defining identifier of the
 152    --      specification must be set to True.
 153
 154    --      If the new PPO requires a thunk, add an entry in Freeze_Subprogram
 155    --      in Exp_Ch6.adb.
 156
 157    --      When generating calls to a PPO, use Find_Prim_Op from Exp_Util.ads
 158    --      to retrieve the entity of the operation directly.
 159
 160    --  Number of predefined primitive operations added by the Expander
 161    --  for a tagged type. If more predefined primitive operations are
 162    --  added, the following items must be changed:
 163
 164    --    Ada.Tags.Max_Predef_Prims         - indirect use
 165    --    Exp_Disp.Default_Prim_Op_Position - indirect use
 166    --    Exp_Disp.Set_All_DT_Position      - direct   use
 167
 168    procedure Build_Static_Dispatch_Tables (N : Node_Id);
 169    --  N is a library level package declaration or package body. Build the
 170    --  static dispatch table of the tagged types defined at library level. In
 171    --  case of package declarations with private part the generated nodes are
 172    --  added at the end of the list of private declarations. Otherwise they are
 173    --  added to the end of the list of public declarations. In case of package
 174    --  bodies they are added to the end of the list of declarations of the
 175    --  package body.
 176
 177    procedure Expand_Dispatching_Call (Call_Node : Node_Id);
 178    --  Expand the call to the operation through the dispatch table and perform
 179    --  the required tag checks when appropriate. For CPP types tag checks are
 180    --  not relevant.
 181
 182    procedure Expand_Interface_Actuals (Call_Node : Node_Id);
 183    --  Ada 2005 (AI-251): Displace all the actuals corresponding to class-wide
 184    --  interfaces to reference the interface tag of the actual object
 185
 186    procedure Expand_Interface_Conversion
 187      (N         : Node_Id;
 188       Is_Static : Boolean := True);
 189    --  Ada 2005 (AI-251): N is a type-conversion node. Reference the base of
 190    --  the object to give access to the interface tag associated with the
 191    --  secondary dispatch table.
 192
 193    procedure Expand_Interface_Thunk
 194      (Prim       : Node_Id;
 195       Thunk_Id   : out Entity_Id;
 196       Thunk_Code : out Node_Id);
 197    --  Ada 2005 (AI-251): When a tagged type implements abstract interfaces we
 198    --  generate additional subprograms (thunks) associated with each primitive
 199    --  Prim to have a layout compatible with the C++ ABI. The thunk displaces
 200    --  the pointers to the actuals that depend on the controlling type before
 201    --  transferring control to the target subprogram. If there is no need to
 202    --  generate the thunk then Thunk_Id and Thunk_Code are set to Empty.
 203    --  Otherwise they are set to the defining identifier and the subprogram
 204    --  body of the generated thunk.
 205
 206    function Make_DT (Typ : Entity_Id; N : Node_Id := Empty) return List_Id;
 207    --  Expand the declarations for the Dispatch Table. The node N is the
 208    --  declaration that forces the generation of the table. It is used to place
 209    --  error messages when the declaration leads to the freezing of a given
 210    --  primitive operation that has an incomplete non- tagged formal.
 211
 212    function Make_Disp_Asynchronous_Select_Body
 213      (Typ : Entity_Id) return Node_Id;
 214    --  Ada 2005 (AI-345): Generate the body of the primitive operation of type
 215    --  Typ used for dispatching in asynchronous selects. Generate a null body
 216    --  if Typ is an interface type.
 217
 218    function Make_Disp_Asynchronous_Select_Spec
 219      (Typ : Entity_Id) return Node_Id;
 220    --  Ada 2005 (AI-345): Generate the specification of the primitive operation
 221    --  of type Typ used for dispatching in asynchronous selects.
 222
 223    function Make_Disp_Conditional_Select_Body
 224      (Typ : Entity_Id) return Node_Id;
 225    --  Ada 2005 (AI-345): Generate the body of the primitive operation of type
 226    --  Typ used for dispatching in conditional selects. Generate a null body
 227    --  if Typ is an interface type.
 228
 229    function Make_Disp_Conditional_Select_Spec
 230      (Typ : Entity_Id) return Node_Id;
 231    --  Ada 2005 (AI-345): Generate the specification of the primitive operation
 232    --  of type Typ used for dispatching in conditional selects.
 233
 234    function Make_Disp_Get_Prim_Op_Kind_Body
 235      (Typ : Entity_Id) return Node_Id;
 236    --  Ada 2005 (AI-345): Generate the body of the primitive operation of type
 237    --  Typ used for retrieving the callable entity kind during dispatching in
 238    --  asynchronous selects. Generate a null body if Typ is an interface type.
 239
 240    function Make_Disp_Get_Prim_Op_Kind_Spec
 241      (Typ : Entity_Id) return Node_Id;
 242    --  Ada 2005 (AI-345): Generate the specification of the primitive operation
 243    --  of the type Typ use for retrieving the callable entity kind during
 244    --  dispatching in asynchronous selects.
 245
 246    function Make_Disp_Get_Task_Id_Body
 247      (Typ : Entity_Id) return Node_Id;
 248    --  Ada 2005 (AI-345): Generate body of the primitive operation of type Typ
 249    --  used for retrieving the _task_id field of a task interface class- wide
 250    --  type. Generate a null body if Typ is an interface or a non-task type.
 251
 252    function Make_Disp_Get_Task_Id_Spec
 253      (Typ : Entity_Id) return Node_Id;
 254    --  Ada 2005 (AI-345): Generate the specification of the primitive operation
 255    --  of type Typ used for retrieving the _task_id field of a task interface
 256    --  class-wide type.
 257
 258    function Make_Disp_Timed_Select_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 dispatching in timed selects. Generates a body containing
 262    --  a single null-statement if Typ is an interface type.
 263
 264    function Make_Disp_Timed_Select_Spec
 265      (Typ : Entity_Id) return Node_Id;
 266    --  Ada 2005 (AI-345): Generate the specification of the primitive operation
 267    --  of type Typ used for dispatching in timed selects.
 268
 269    function Make_Select_Specific_Data_Table
 270      (Typ : Entity_Id) return List_Id;
 271    --  Ada 2005 (AI-345): Create and populate the auxiliary table in the TSD
 272    --  of Typ used for dispatching in asynchronous, conditional and timed
 273    --  selects. Generate code to set the primitive operation kinds and entry
 274    --  indices of primitive operations and primitive wrappers.
 275
 276    function Make_Tags (Typ : Entity_Id) return List_Id;
 277    --  Generate the entities associated with the primary and secondary tags of
 278    --  Typ and fill the contents of Access_Disp_Table. In case of library level
 279    --  tagged types this routine imports the forward declaration of the tag
 280    --  entity, that will be declared and exported by Make_DT.
 281
 282    procedure Register_Primitive
 283      (Loc     : Source_Ptr;
 284       Prim    : Entity_Id;
 285       Ins_Nod : Node_Id);
 286    --  Register Prim in the corresponding primary or secondary dispatch table.
 287    --  If Prim is associated with a secondary dispatch table then generate also
 288    --  its thunk and register it in the associated secondary dispatch table.
 289    --  In general the dispatch tables are always generated by Make_DT and
 290    --  Make_Secondary_DT; this routine is only used in two corner cases:
 291    --    1) To construct the dispatch table of a tagged type whose parent
 292    --       is a CPP_Class (see Build_Init_Procedure).
 293    --    2) To handle late overriding of dispatching operations (see
 294    --       Check_Dispatching_Operation).
 295
 296    procedure Set_All_DT_Position (Typ : Entity_Id);
 297    --  Set the DT_Position field for each primitive operation. In the CPP
 298    --  Class case check that no pragma CPP_Virtual is missing and that the
 299    --  DT_Position are coherent
 300
 301    procedure Set_Default_Constructor (Typ : Entity_Id);
 302    --  Typ is a CPP_Class type. Create the Init procedure of that type to
 303    --  be the default constructor (i.e. the function returning this type,
 304    --  having a pragma CPP_Constructor and no parameter)
 305
 306    procedure Set_DTC_Entity_Value
 307      (Tagged_Type : Entity_Id;
 308       Prim        : Entity_Id);
 309    --  Set the definite value of the DTC_Entity value associated with a given
 310    --  primitive of a tagged type.
 311
 312    procedure Write_DT (Typ : Entity_Id);
 313    pragma Export (Ada, Write_DT);
 314    --  Debugging procedure (to be called within gdb)
 315
 316 end Exp_Disp;