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-2005, 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    --  Lifecycle 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 in Predefined_Primitive_Freeze in Exp_Ch3.
 126
 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.
 129
 130    --      Dispatch table positions of PPOs are set in Set_All_DT_Position in
 131    --      Exp_Disp.
 132
 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
 135    --      a thunk.
 136
 137    --  Guidelines for addition of new predefined primitive operations
 138
 139    --      Update the value of constant Default_Prim_Op_Count in A-Tags.ads
 140    --      to reflect the new number of PPOs.
 141
 142    --      Introduce a new predefined name for the new PPO in Snames.ads and
 143    --      Snames.adb.
 144
 145    --      Categorize the new PPO name as predefined by adding an entry in
 146    --      Is_Predefined_Dispatching_Operation in Exp_Util.adb.
 147
 148    --      Generate the specification of the new PPO in Make_Predefined_
 149    --      Primitive_Spec in Exp_Ch3.adb. The Is_Internal flag of the defining
 150    --      identifier of the specification must be set to True.
 151
 152    --      Generate the body of the new PPO in Predefined_Primitive_Bodies in
 153    --      Exp_Ch3.adb. The Is_Internal flag of the defining identifier of the
 154    --      specification must be set to True.
 155
 156    --      If the new PPO requires a thunk, add an entry in Freeze_Subprogram
 157    --      in Exp_Ch6.adb.
 158
 159    --      When generating calls to a PPO, use Find_Prim_Op from Exp_Util.ads
 160    --      to retrieve the entity of the operation directly.
 161
 162    --  Number of predefined primitive operations added by the Expander
 163    --  for a tagged type. If more predefined primitive operations are
 164    --  added, the following items must be changed:
 165
 166    --    Ada.Tags.Defailt_Prim_Op_Count    - indirect use
 167    --    Exp_Disp.Default_Prim_Op_Position - indirect use
 168    --    Exp_Disp.Set_All_DT_Position      - direct   use
 169
 170    type DT_Access_Action is
 171       (CW_Membership,
 172        IW_Membership,
 173        DT_Entry_Size,
 174        DT_Prologue_Size,
 175        Get_Access_Level,
 176        Get_Entry_Index,
 177        Get_External_Tag,
 178        Get_Predefined_Prim_Op_Address,
 179        Get_Prim_Op_Address,
 180        Get_Prim_Op_Kind,
 181        Get_RC_Offset,
 182        Get_Remotely_Callable,
 183        Get_Tagged_Kind,
 184        Inherit_DT,
 185        Inherit_TSD,
 186        Register_Interface_Tag,
 187        Register_Tag,
 188        Set_Access_Level,
 189        Set_Entry_Index,
 190        Set_Expanded_Name,
 191        Set_External_Tag,
 192        Set_Interface_Table,
 193        Set_Offset_Index,
 194        Set_OSD,
 195        Set_Predefined_Prim_Op_Address,
 196        Set_Prim_Op_Address,
 197        Set_Prim_Op_Kind,
 198        Set_RC_Offset,
 199        Set_Remotely_Callable,
 200        Set_Signature,
 201        Set_SSD,
 202        Set_TSD,
 203        Set_Tagged_Kind,
 204        TSD_Entry_Size,
 205        TSD_Prologue_Size);
 206
 207    procedure Expand_Dispatching_Call (Call_Node : Node_Id);
 208    --  Expand the call to the operation through the dispatch table and perform
 209    --  the required tag checks when appropriate. For CPP types the call is
 210    --  done through the Vtable (tag checks are not relevant)
 211
 212    procedure Expand_Interface_Actuals    (Call_Node : Node_Id);
 213    --  Ada 2005 (AI-251): Displace all the actuals corresponding to class-wide
 214    --  interfaces to reference the interface tag of the actual object
 215
 216    procedure Expand_Interface_Conversion
 217      (N         : Node_Id;
 218       Is_Static : Boolean := True);
 219    --  Ada 2005 (AI-251): N is a type-conversion node. Reference the base of
 220    --  the object to give access to the interface tag associated with the
 221    --  secondary dispatch table.
 222
 223    function Expand_Interface_Thunk
 224      (N           : Node_Id;
 225       Thunk_Alias : Node_Id;
 226       Thunk_Id    : Entity_Id) return Node_Id;
 227    --  Ada 2005 (AI-251): When a tagged type implements abstract interfaces we
 228    --  generate additional subprograms (thunks) to have a layout compatible
 229    --  with the C++ ABI. The thunk modifies the value of the first actual of
 230    --  the call (that is, the pointer to the object) before transferring
 231    --  control to the target function.
 232
 233    function Fill_DT_Entry
 234      (Loc          : Source_Ptr;
 235       Prim         : Entity_Id) return Node_Id;
 236    --  Generate the code necessary to fill the appropriate entry of the
 237    --  dispatch table of Prim's controlling type with Prim's address.
 238
 239    function Fill_Secondary_DT_Entry
 240      (Loc          : Source_Ptr;
 241       Prim         : Entity_Id;
 242       Thunk_Id     : Entity_Id;
 243       Iface_DT_Ptr : Entity_Id) return Node_Id;
 244    --  (Ada 2005): Generate the code necessary to fill the appropriate entry of
 245    --  the secondary dispatch table of Prim's controlling type with Thunk_Id's
 246    --  address.
 247
 248    function Get_Remotely_Callable (Obj : Node_Id) return Node_Id;
 249    --  Return an expression that holds True if the object can be transmitted
 250    --  onto another partition according to E.4 (18)
 251
 252    function Init_Predefined_Interface_Primitives
 253      (Typ : Entity_Id) return List_Id;
 254    --  Ada 2005 (AI-251): Initialize the entries associated with predefined
 255    --  primitives in all the secondary dispatch tables of Typ.
 256
 257    function Make_DT_Access_Action
 258      (Typ    : Entity_Id;
 259       Action : DT_Access_Action;
 260       Args   : List_Id) return Node_Id;
 261    --  Generate a call to one of the Dispatch Table Access Subprograms defined
 262    --  in Ada.Tags or in Interfaces.Cpp
 263
 264    function Make_DT (Typ : Entity_Id) return List_Id;
 265    --  Expand the declarations for the Dispatch Table (or the Vtable in
 266    --  the case of type whose ancestor is a CPP_Class)
 267
 268    function Make_Disp_Asynchronous_Select_Body
 269      (Typ : Entity_Id) return Node_Id;
 270    --  Ada 2005 (AI-345): Generate the body of the primitive operation of type
 271    --  Typ used for dispatching in asynchronous selects. Generate a null body
 272    --  if Typ is an interface type.
 273
 274    function Make_Disp_Asynchronous_Select_Spec
 275      (Typ : Entity_Id) return Node_Id;
 276    --  Ada 2005 (AI-345): Generate the specification of the primitive operation
 277    --  of type Typ used for dispatching in asynchronous selects.
 278
 279    function Make_Disp_Conditional_Select_Body
 280      (Typ : Entity_Id) return Node_Id;
 281    --  Ada 2005 (AI-345): Generate the body of the primitive operation of type
 282    --  Typ used for dispatching in conditional selects. Generate a null body
 283    --  if Typ is an interface type.
 284
 285    function Make_Disp_Conditional_Select_Spec
 286      (Typ : Entity_Id) return Node_Id;
 287    --  Ada 2005 (AI-345): Generate the specification of the primitive operation
 288    --  of type Typ used for dispatching in conditional selects.
 289
 290    function Make_Disp_Get_Prim_Op_Kind_Body
 291      (Typ : Entity_Id) return Node_Id;
 292    --  Ada 2005 (AI-345): Generate the body of the primitive operation of type
 293    --  Typ used for retrieving the callable entity kind during dispatching in
 294    --  asynchronous selects. Generate a null body if Typ is an interface type.
 295
 296    function Make_Disp_Get_Prim_Op_Kind_Spec
 297      (Typ : Entity_Id) return Node_Id;
 298    --  Ada 2005 (AI-345): Generate the specification of the primitive operation
 299    --  of the type Typ use for retrieving the callable entity kind during
 300    --  dispatching in asynchronous selects.
 301
 302    function Make_Disp_Get_Task_Id_Body
 303      (Typ : Entity_Id) return Node_Id;
 304    --  Ada 2005 (AI-345): Generate the body of the primitive operation of type
 305    --  Typ used for retrieving the _task_id field of a task interface class-
 306    --  wide type. Generate a null body if Typ is an interface or a non-task
 307    --  type.
 308
 309    function Make_Disp_Get_Task_Id_Spec
 310      (Typ : Entity_Id) return Node_Id;
 311    --  Ada 2005 (AI-345): Generate the specification of the primitive operation
 312    --  of type Typ used for retrieving the _task_id field of a task interface
 313    --  class-wide type.
 314
 315    function Make_Disp_Timed_Select_Body
 316      (Typ : Entity_Id) return Node_Id;
 317    --  Ada 2005 (AI-345): Generate the body of the primitive operation of type
 318    --  Typ used for dispatching in timed selects. Generate a null body if Nul
 319    --  is an interface type.
 320
 321    function Make_Disp_Timed_Select_Spec
 322      (Typ : Entity_Id) return Node_Id;
 323    --  Ada 2005 (AI-345): Generate the specification of the primitive operation
 324    --  of type Typ used for dispatching in timed selects.
 325
 326    function Make_Select_Specific_Data_Table
 327      (Typ : Entity_Id) return List_Id;
 328    --  Ada 2005 (AI-345): Create and populate the auxiliary table in the TSD
 329    --  of Typ used for dispatching in asynchronous, conditional and timed
 330    --  selects. Generate code to set the primitive operation kinds and entry
 331    --  indices of primitive operations and primitive wrappers.
 332
 333    procedure Make_Secondary_DT
 334      (Typ             : Entity_Id;
 335       Ancestor_Typ    : Entity_Id;
 336       Suffix_Index    : Int;
 337       Iface           : Entity_Id;
 338       AI_Tag          : Entity_Id;
 339       Acc_Disp_Tables : in out Elist_Id;
 340       Result          : out List_Id);
 341    --  Ada 2005 (AI-251): Expand the declarations for the Secondary Dispatch
 342    --  Table of Typ associated with Iface (each abstract interface implemented
 343    --  by Typ has a secondary dispatch table). The arguments Typ, Ancestor_Typ
 344    --  and Suffix_Index are used to generate an unique external name which
 345    --  is added at the end of Acc_Disp_Tables; this external name will be
 346    --  used later by the subprogram Exp_Ch3.Build_Init_Procedure.
 347
 348    procedure Set_All_DT_Position (Typ : Entity_Id);
 349    --  Set the DT_Position field for each primitive operation. In the CPP
 350    --  Class case check that no pragma CPP_Virtual is missing and that the
 351    --  DT_Position are coherent
 352
 353    procedure Set_Default_Constructor (Typ : Entity_Id);
 354    --  Typ is a CPP_Class type. Create the Init procedure of that type to
 355    --  be the default constructor (i.e. the function returning this type,
 356    --  having a pragma CPP_Constructor and no parameter)
 357
 358    procedure Write_DT (Typ : Entity_Id);
 359    pragma Export (Ada, Write_DT);
 360    --  Debugging procedure (to be called within gdb)
 361
 362 end Exp_Disp;