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