gcc/ada/exp_atag.ads

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --                             E X P _ A T A G                              --
   6 --                                                                          --
   7 --                                 S p e c                                  --
   8 --                                                                          --
   9 --          Copyright (C) 2006-2020, 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 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.          --
  20 --                                                                          --
  21 -- GNAT was originally developed  by the GNAT team at  New York University. --
  22 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  23 --                                                                          --
  24 ------------------------------------------------------------------------------
  25
  26 --  This package contains routines involved in the frontend expansion of
  27 --  subprograms of package Ada.Tags
  28
  29 with Types; use Types;
  30 with Uintp; use Uintp;
  31
  32 package Exp_Atag is
  33
  34    --  Note: In all the subprograms of this package formal 'Loc' is the source
  35    --  location used in constructing the corresponding nodes.
  36
  37    procedure Build_Common_Dispatching_Select_Statements
  38      (Typ   : Entity_Id;
  39       Stmts : List_Id);
  40    --  Ada 2005 (AI-345): Build statements that are common to the expansion of
  41    --  timed, asynchronous, and conditional select and append them to Stmts.
  42    --  Typ is the tagged type used for dispatching calls.
  43
  44    procedure Build_CW_Membership
  45      (Loc          : Source_Ptr;
  46       Obj_Tag_Node : in out Node_Id;
  47       Typ_Tag_Node : Node_Id;
  48       Related_Nod  : Node_Id;
  49       New_Node     : out Node_Id);
  50    --  Build code that returns true if Obj_Tag is in Typ_Tag'Class. Each DT
  51    --  has a table of ancestors and its inheritance level (Idepth). Obj is in
  52    --  Typ'Class if Typ'Tag is found in the table of ancestors referenced by
  53    --  Obj'Tag. Knowing the level of inheritance of both types, this can be
  54    --  computed in constant time by the formula:
  55    --
  56    --   Index := TSD (Obj'Tag).Idepth - TSD (Typ'Tag).Idepth;
  57    --   Index >= 0 and then TSD (Obj'Tag).Tags_Table (Index) = Typ'Tag
  58    --
  59    --  Related_Nod is the node where the implicit declaration of variable Index
  60    --  is inserted. Obj_Tag_Node is relocated.
  61
  62    function Build_Get_Access_Level
  63      (Loc      : Source_Ptr;
  64       Tag_Node : Node_Id) return Node_Id;
  65    --  Build code that retrieves the accessibility level of the tagged type.
  66    --
  67    --  Generates: TSD (Tag).Access_Level
  68
  69    function Build_Get_Alignment
  70      (Loc      : Source_Ptr;
  71       Tag_Node : Node_Id) return Node_Id;
  72    --  Build code that retrieves the alignment of the tagged type.
  73    --  Generates: TSD (Tag).Alignment
  74
  75    procedure Build_Get_Predefined_Prim_Op_Address
  76      (Loc      : Source_Ptr;
  77       Position : Uint;
  78       Tag_Node : in out Node_Id;
  79       New_Node : out Node_Id);
  80    --  Given a pointer to a dispatch table (T) and a position in the DT, build
  81    --  code that gets the address of the predefined virtual function stored in
  82    --  it (used for dispatching calls). Tag_Node is relocated.
  83    --
  84    --  Generates: Predefined_DT (Tag).D (Position);
  85
  86    procedure Build_Get_Prim_Op_Address
  87      (Loc      : Source_Ptr;
  88       Typ      : Entity_Id;
  89       Position : Uint;
  90       Tag_Node : in out Node_Id;
  91       New_Node : out Node_Id);
  92    --  Build code that retrieves the address of the virtual function stored in
  93    --  a given position of the dispatch table (used for dispatching calls).
  94    --  Tag_Node is relocated.
  95    --
  96    --  Generates: To_Tag (Tag).D (Position);
  97
  98    function Build_Get_Transportable
  99      (Loc      : Source_Ptr;
 100       Tag_Node : Node_Id) return Node_Id;
 101    --  Build code that retrieves the value of the Transportable flag for
 102    --  the given Tag.
 103    --
 104    --  Generates: TSD (Tag).Transportable;
 105
 106    function Build_Inherit_CPP_Prims (Typ : Entity_Id) return List_Id;
 107    --  Build code that copies from Typ's parent the dispatch table slots of
 108    --  inherited primitives and updates slots of overridden primitives. The
 109    --  generated code handles primary and secondary dispatch tables of Typ.
 110
 111    function Build_Inherit_Predefined_Prims
 112      (Loc              : Source_Ptr;
 113       Old_Tag_Node     : Node_Id;
 114       New_Tag_Node     : Node_Id;
 115       Num_Predef_Prims : Nat) return Node_Id;
 116    --  Build code that inherits the predefined primitives of the parent.
 117    --
 118    --  Generates: Predefined_DT (New_T).D (All_Predefined_Prims) :=
 119    --               Predefined_DT (Old_T).D (All_Predefined_Prims);
 120    --
 121    --  Required to build non-library level dispatch tables. Also required
 122    --  when compiling without static dispatch tables support.
 123
 124    function Build_Inherit_Prims
 125      (Loc          : Source_Ptr;
 126       Typ          : Entity_Id;
 127       Old_Tag_Node : Node_Id;
 128       New_Tag_Node : Node_Id;
 129       Num_Prims    : Nat) return Node_Id;
 130    --  Build code that inherits Num_Prims user-defined primitives from the
 131    --  dispatch table of the parent type of tagged type Typ. It is used to
 132    --  copy the dispatch table of the parent in the following cases:
 133    --    a) case of derivations of CPP_Class types
 134    --    b) tagged types whose dispatch table is not statically allocated
 135    --
 136    --  Generates:
 137    --    New_Tag.Prims_Ptr (1 .. Num_Prims) :=
 138    --      Old_Tag.Prims_Ptr (1 .. Num_Prims);
 139
 140    function Build_Offset_To_Top
 141      (Loc       : Source_Ptr;
 142       This_Node : Node_Id) return Node_Id;
 143    --  Build code that references the Offset_To_Top component of the primary
 144    --  or secondary dispatch table associated with This_Node. This subprogram
 145    --  provides a subset of the functionality provided by the function
 146    --  Offset_To_Top of package Ada.Tags, and is only called by the frontend
 147    --  when such routine is not available in a configurable runtime.
 148    --
 149    --  Generates:
 150    --    Offset_To_Top_Ptr
 151    --      (Address!(Tag_Ptr!(This).all) - Offset_To_Top_Offset).all
 152
 153    function Build_Set_Predefined_Prim_Op_Address
 154      (Loc          : Source_Ptr;
 155       Tag_Node     : Node_Id;
 156       Position     : Uint;
 157       Address_Node : Node_Id) return Node_Id;
 158    --  Build code that saves the address of a virtual function in a given
 159    --  Position of the portion of the dispatch table associated with the
 160    --  predefined primitives of Tag. Called from Exp_Disp.Fill_DT_Entry
 161    --  and Exp_Disp.Fill_Secondary_DT_Entry. It is used for:
 162    --   1) Filling the dispatch table of CPP_Class types.
 163    --   2) Late overriding (see Check_Dispatching_Operation).
 164    --
 165    --  Generates: Predefined_DT (Tag).D (Position) := Value
 166
 167    function Build_Set_Prim_Op_Address
 168      (Loc          : Source_Ptr;
 169       Typ          : Entity_Id;
 170       Tag_Node     : Node_Id;
 171       Position     : Uint;
 172       Address_Node : Node_Id) return Node_Id;
 173    --  Build code that saves the address of a virtual function in a given
 174    --  Position of the dispatch table associated with the Tag. Called from
 175    --  Exp_Disp.Fill_DT_Entry and Exp_Disp.Fill_Secondary_DT_Entry. Used for:
 176    --   1) Filling the dispatch table of CPP_Class types.
 177    --   2) Late overriding (see Check_Dispatching_Operation).
 178    --
 179    --  Generates: Tag.D (Position) := Value
 180
 181    function Build_Set_Size_Function
 182      (Loc       : Source_Ptr;
 183       Tag_Node  : Node_Id;
 184       Size_Func : Entity_Id) return Node_Id;
 185    --  Build code that saves in the TSD the address of the function
 186    --  calculating _size of the object.
 187
 188    function Build_Set_Static_Offset_To_Top
 189      (Loc          : Source_Ptr;
 190       Iface_Tag    : Node_Id;
 191       Offset_Value : Node_Id) return Node_Id;
 192    --  Build code that initialize the Offset_To_Top component of the
 193    --  secondary dispatch table referenced by Iface_Tag.
 194    --
 195    --  Generates:
 196    --    Offset_To_Top_Ptr
 197    --      (Address!(Tag_Ptr!(This).all) - Offset_To_Top_Offset).all
 198    --     := Offset_Value
 199
 200 end Exp_Atag;