gcc/ada/exp_ch7.ads

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --                              E X P _ C H 7                               --
   6 --                                                                          --
   7 --                                 S p e c                                  --
   8 --                                                                          --
   9 --          Copyright (C) 1992-2011, 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 with Namet; use Namet;
  27 with Types; use Types;
  28
  29 package Exp_Ch7 is
  30
  31    procedure Expand_N_Package_Body        (N : Node_Id);
  32    procedure Expand_N_Package_Declaration (N : Node_Id);
  33
  34    -----------------------------
  35    -- Finalization Management --
  36    -----------------------------
  37
  38    procedure Build_Controlling_Procs (Typ : Entity_Id);
  39    --  Typ is a record, and array type having controlled components.
  40    --  Create the procedures Deep_Initialize, Deep_Adjust and Deep_Finalize
  41    --  that take care of finalization management at run-time.
  42
  43    procedure Build_Finalization_Collection
  44      (Typ        : Entity_Id;
  45       Ins_Node   : Node_Id := Empty;
  46       Encl_Scope : Entity_Id := Empty);
  47    --  Build a finalization collection for an access type. The designated type
  48    --  may not necessarely be controlled or need finalization actions. The
  49    --  routine creates a wrapper around a user-defined storage pool or the
  50    --  general storage pool for access types. Ins_Nod and Encl_Scope are used
  51    --  in conjunction with anonymous access types. Ins_Node designates the
  52    --  insertion point before which the collection should be added. Encl_Scope
  53    --  is the scope of the context, either the enclosing record or the scope
  54    --  of the related function.
  55
  56    procedure Build_Late_Proc (Typ : Entity_Id; Nam : Name_Id);
  57    --  Build one controlling procedure when a late body overrides one of
  58    --  the controlling operations.
  59
  60    function Build_Object_Declarations
  61      (Loc         : Source_Ptr;
  62       Abort_Id    : Entity_Id;
  63       E_Id        : Entity_Id;
  64       Raised_Id   : Entity_Id;
  65       For_Package : Boolean := False) return List_Id;
  66    --  Subsidiary to Make_Deep_Array_Body and Make_Deep_Record_Body. Return a
  67    --  list containing the object declarations of boolean flag Abort_Id, the
  68    --  exception occurrence E_Id and boolean flag Raised_Id.
  69    --
  70    --    Abort_Id  : constant Boolean :=
  71    --                  Exception_Identity (Get_Current_Excep.all) =
  72    --                    Standard'Abort_Signal'Identity;
  73    --      <or>
  74    --    Abort_Id  : constant Boolean := False;  --  no abort or For_Package
  75    --
  76    --    E_Id      : Exception_Occurrence;
  77    --    Raised_Id : Boolean := False;
  78
  79    function Build_Raise_Statement
  80      (Loc       : Source_Ptr;
  81       Abort_Id  : Entity_Id;
  82       E_Id      : Entity_Id;
  83       Raised_Id : Entity_Id) return Node_Id;
  84    --  Subsidiary to routines Build_Finalizer, Make_Deep_Array_Body and Make_
  85    --  Deep_Record_Body. Generate the following conditional raise statement:
  86    --
  87    --    if Raised_Id then
  88    --       Raise_From_Controlled_Operation (E_Id, Abort_Id);
  89    --    end if;
  90    --
  91    --  Abort_Id is a local boolean flag which is set when the finalization was
  92    --  triggered by an abort, E_Id denotes the defining identifier of a local
  93    --  exception occurrence, Raised_Id is the entity of a local boolean flag.
  94
  95    function CW_Or_Has_Controlled_Part (T : Entity_Id) return Boolean;
  96    --  True if T is a class-wide type, or if it has controlled parts ("part"
  97    --  means T or any of its subcomponents). This is the same as
  98    --  Needs_Finalization, except when pragma Restrictions (No_Finalization)
  99    --  applies, in which case we know that class-wide objects do not contain
 100    --  controlled parts.
 101
 102    function Get_Global_Pool_For_Access_Type (T : Entity_Id) return Entity_Id;
 103    --  Return the pool id for access type T.  This is generally the node
 104    --  corresponding to System.Global_Pool.Global_Pool_Object except on
 105    --  VMS if the access size is 32.
 106
 107    function Has_New_Controlled_Component (E : Entity_Id) return Boolean;
 108    --  E is a type entity. Give the same result as Has_Controlled_Component
 109    --  except for tagged extensions where the result is True only if the
 110    --  latest extension contains a controlled component.
 111
 112    function Make_Adjust_Call
 113      (Obj_Ref    : Node_Id;
 114       Typ        : Entity_Id;
 115       For_Parent : Boolean := False) return Node_Id;
 116    --  Create a call to either Adjust or Deep_Adjust depending on the structure
 117    --  of type Typ. Obj_Ref is an expression with no-side effect (not required
 118    --  to have been previously analyzed) that references the object to be
 119    --  adjusted. Typ is the expected type of Obj_Ref. Flag For_Parent must be
 120    --  set when an adjustment call is being created for field _parent.
 121
 122    function Make_Attach_Call
 123      (Obj_Ref : Node_Id;
 124       Ptr_Typ : Entity_Id) return Node_Id;
 125    --  Create a call to prepend an object to a finalization collection. Obj_Ref
 126    --  is the object, Ptr_Typ is the access type that owns the collection.
 127    --  Generate the following:
 128    --
 129    --    Ada.Finalization.Heap_Managment.Attach
 130    --      (<Ptr_Typ>FC,
 131    --       System.Finalization_Root.Root_Controlled_Ptr (Obj_Ref));
 132
 133    function Make_Detach_Call (Obj_Ref : Node_Id) return Node_Id;
 134    --  Create a call to unhook an object from an arbitrary list. Obj_Ref is the
 135    --  object. Generate the following:
 136    --
 137    --    Ada.Finalization.Heap_Management.Detach
 138    --      (System.Finalization_Root.Root_Controlled_Ptr (Obj_Ref));
 139
 140    function Make_Final_Call
 141      (Obj_Ref    : Node_Id;
 142       Typ        : Entity_Id;
 143       For_Parent : Boolean := False) return Node_Id;
 144    --  Create a call to either Finalize or Deep_Finalize depending on the
 145    --  structure of type Typ. Obj_Ref is an expression (with no-side effect and
 146    --  is not required to have been previously analyzed) that references the
 147    --  object to be finalized. Typ is the expected type of Obj_Ref. Flag For_
 148    --  Parent must be set when a finalization call is being created for field
 149    --  _parent.
 150
 151    procedure Make_Finalize_Address_Body (Typ : Entity_Id);
 152    --  Create the body of TSS routine Finalize_Address if Typ is controlled and
 153    --  does not have a TSS entry for Finalize_Address. The procedure converts
 154    --  an address into a pointer and subsequently calls Deep_Finalize on the
 155    --  dereference.
 156
 157    function Make_Init_Call
 158      (Obj_Ref : Node_Id;
 159       Typ     : Entity_Id) return Node_Id;
 160    --  Obj_Ref is an expression with no-side effect (not required to have been
 161    --  previously analyzed) that references the object to be initialized. Typ
 162    --  is the expected type of Obj_Ref, which is either a controlled type
 163    --  (Is_Controlled) or a type with controlled components (Has_Controlled_
 164    --  Components).
 165
 166    function Make_Handler_For_Ctrl_Operation (Loc : Source_Ptr) return Node_Id;
 167    --  Generate an implicit exception handler with an 'others' choice,
 168    --  converting any occurrence to a raise of Program_Error.
 169
 170    function Make_Local_Deep_Finalize
 171      (Typ : Entity_Id;
 172       Nam : Entity_Id) return Node_Id;
 173    --  Create a special version of Deep_Finalize with identifier Nam. The
 174    --  routine has state information and can parform partial finalization.
 175
 176    function Make_Set_Finalize_Address_Ptr_Call
 177      (Loc     : Source_Ptr;
 178       Typ     : Entity_Id;
 179       Ptr_Typ : Entity_Id) return Node_Id;
 180    --  Generate the following call:
 181    --
 182    --    Set_Finalize_Address_Ptr (<Ptr_Typ>FC, <Typ>FD'Unrestricted_Access);
 183    --
 184    --  where Finalize_Address is the corresponding TSS primitive of type Typ
 185    --  and Ptr_Typ is the access type of the related allocation. Loc is the
 186    --  source location of the related allocator.
 187
 188    --------------------------------------------
 189    -- Task and Protected Object finalization --
 190    --------------------------------------------
 191
 192    function Cleanup_Array
 193      (N   : Node_Id;
 194       Obj : Node_Id;
 195       Typ : Entity_Id) return List_Id;
 196    --  Generate loops to finalize any tasks or simple protected objects that
 197    --  are subcomponents of an array.
 198
 199    function Cleanup_Protected_Object
 200      (N   : Node_Id;
 201       Ref : Node_Id) return Node_Id;
 202    --  Generate code to finalize a protected object without entries
 203
 204    function Cleanup_Record
 205      (N   : Node_Id;
 206       Obj : Node_Id;
 207       Typ : Entity_Id) return List_Id;
 208    --  For each subcomponent of a record that contains tasks or simple
 209    --  protected objects, generate the appropriate finalization call.
 210
 211    function Cleanup_Task
 212      (N   : Node_Id;
 213       Ref : Node_Id) return Node_Id;
 214    --  Generate code to finalize a task
 215
 216    function Has_Simple_Protected_Object (T : Entity_Id) return Boolean;
 217    --  Check whether composite type contains a simple protected component
 218
 219    function Is_Simple_Protected_Type (T : Entity_Id) return Boolean;
 220    --  Determine whether T denotes a protected type without entires whose
 221    --  _object field is of type System.Tasking.Protected_Objects.Protection.
 222
 223    --------------------------------
 224    -- Transient Scope Management --
 225    --------------------------------
 226
 227    procedure Expand_Cleanup_Actions (N : Node_Id);
 228    --  Expand the necessary stuff into a scope to enable finalization of local
 229    --  objects and deallocation of transient data when exiting the scope. N is
 230    --  a "scope node" that is to say one of the following: N_Block_Statement,
 231    --  N_Subprogram_Body, N_Task_Body, N_Entry_Body.
 232
 233    procedure Establish_Transient_Scope (N : Node_Id; Sec_Stack : Boolean);
 234    --  Push a new transient scope on the scope stack. N is the node responsible
 235    --  for the need of a transient scope. If Sec_Stack is True then the
 236    --  secondary stack is brought in, otherwise it isn't.
 237
 238    function Node_To_Be_Wrapped return Node_Id;
 239    --  Return the node to be wrapped if the current scope is transient
 240
 241    procedure Store_Before_Actions_In_Scope (L : List_Id);
 242    --  Append the list L of actions to the end of the before-actions store in
 243    --  the top of the scope stack.
 244
 245    procedure Store_After_Actions_In_Scope (L : List_Id);
 246    --  Append the list L of actions to the beginning of the after-actions store
 247    --  in the top of the scope stack.
 248
 249    procedure Wrap_Transient_Declaration (N : Node_Id);
 250    --  N is an object declaration. Expand the finalization calls after the
 251    --  declaration and make the outer scope being the transient one.
 252
 253    procedure Wrap_Transient_Expression (N : Node_Id);
 254    --  N is a sub-expression. Expand a transient block around an expression
 255
 256    procedure Wrap_Transient_Statement (N : Node_Id);
 257    --  N is a statement. Expand a transient block around an instruction
 258
 259 end Exp_Ch7;