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-2014, 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    --  Support of exceptions from user finalization procedures
  44
  45    --  There is a specific mechanism to handle these exceptions, continue
  46    --  finalization and then raise PE. This mechanism is used by this package
  47    --  but also by exp_intr for Ada.Unchecked_Deallocation.
  48
  49    --  There are 3 subprograms to use this mechanism, and the type
  50    --  Finalization_Exception_Data carries internal data between these
  51    --  subprograms:
  52    --
  53    --    1. Build_Object_Declaration: create the variables for the next two
  54    --       subprograms.
  55    --    2. Build_Exception_Handler: create the exception handler for a call
  56    --       to a user finalization procedure.
  57    --    3. Build_Raise_Stmt: create code to potentially raise a PE exception
  58    --       if an exception was raise in a user finalization procedure.
  59
  60    type Finalization_Exception_Data is record
  61       Loc : Source_Ptr;
  62       --  Sloc for the added nodes
  63
  64       Abort_Id : Entity_Id;
  65       --  Boolean variable set to true if the finalization was triggered by
  66       --  an abort.
  67
  68       E_Id : Entity_Id;
  69       --  Variable containing the exception occurrence raised by user code
  70
  71       Raised_Id : Entity_Id;
  72       --  Boolean variable set to true if an exception was raised in user code
  73    end record;
  74
  75    function Build_Exception_Handler
  76      (Data        : Finalization_Exception_Data;
  77       For_Library : Boolean := False) return Node_Id;
  78    --  Subsidiary to Build_Finalizer, Make_Deep_Array_Body and Make_Deep_Record
  79    --  _Body. Create an exception handler of the following form:
  80    --
  81    --    when others =>
  82    --       if not Raised_Id then
  83    --          Raised_Id := True;
  84    --          Save_Occurrence (E_Id, Get_Current_Excep.all.all);
  85    --       end if;
  86    --
  87    --  If flag For_Library is set (and not in restricted profile):
  88    --
  89    --    when others =>
  90    --       if not Raised_Id then
  91    --          Raised_Id := True;
  92    --          Save_Library_Occurrence (Get_Current_Excep.all);
  93    --       end if;
  94    --
  95    --  E_Id denotes the defining identifier of a local exception occurrence.
  96    --  Raised_Id is the entity of a local boolean flag. Flag For_Library is
  97    --  used when operating at the library level, when enabled the current
  98    --  exception will be saved to a global location.
  99
 100    procedure Build_Finalization_Master
 101      (Typ        : Entity_Id;
 102       Ins_Node   : Node_Id := Empty;
 103       Encl_Scope : Entity_Id := Empty);
 104    --  Build a finalization master for an access type. The designated type may
 105    --  not necessarely be controlled or need finalization actions. The routine
 106    --  creates a wrapper around a user-defined storage pool or the general
 107    --  storage pool for access types. Ins_Nod and Encl_Scope are used in
 108    --  conjunction with anonymous access types. Ins_Node designates the
 109    --  insertion point before which the collection should be added. Encl_Scope
 110    --  is the scope of the context, either the enclosing record or the scope
 111    --  of the related function.
 112
 113    procedure Build_Late_Proc (Typ : Entity_Id; Nam : Name_Id);
 114    --  Build one controlling procedure when a late body overrides one of
 115    --  the controlling operations.
 116
 117    procedure Build_Object_Declarations
 118      (Data        : out Finalization_Exception_Data;
 119       Decls       : List_Id;
 120       Loc         : Source_Ptr;
 121       For_Package : Boolean := False);
 122    --  Subsidiary to Make_Deep_Array_Body and Make_Deep_Record_Body. Create the
 123    --  list List containing the object declarations of boolean flag Abort_Id,
 124    --  the exception occurrence E_Id and boolean flag Raised_Id.
 125    --
 126    --    Abort_Id  : constant Boolean :=
 127    --                  Exception_Identity (Get_Current_Excep.all) =
 128    --                    Standard'Abort_Signal'Identity;
 129    --      <or>
 130    --    Abort_Id  : constant Boolean := False;  --  no abort or For_Package
 131    --
 132    --    E_Id      : Exception_Occurrence;
 133    --    Raised_Id : Boolean := False;
 134
 135    function Build_Raise_Statement
 136      (Data : Finalization_Exception_Data) return Node_Id;
 137    --  Subsidiary to routines Build_Finalizer, Make_Deep_Array_Body and Make_
 138    --  Deep_Record_Body. Generate the following conditional raise statement:
 139    --
 140    --    if Raised_Id and then not Abort_Id then
 141    --       Raise_From_Controlled_Operation (E_Id);
 142    --    end if;
 143    --
 144    --  Abort_Id is a local boolean flag which is set when the finalization was
 145    --  triggered by an abort, E_Id denotes the defining identifier of a local
 146    --  exception occurrence, Raised_Id is the entity of a local boolean flag.
 147
 148    function CW_Or_Has_Controlled_Part (T : Entity_Id) return Boolean;
 149    --  True if T is a class-wide type, or if it has controlled parts ("part"
 150    --  means T or any of its subcomponents). Same as Needs_Finalization, except
 151    --  when pragma Restrictions (No_Finalization) applies, in which case we
 152    --  know that class-wide objects do not contain controlled parts.
 153
 154    function Has_New_Controlled_Component (E : Entity_Id) return Boolean;
 155    --  E is a type entity. Give the same result as Has_Controlled_Component
 156    --  except for tagged extensions where the result is True only if the
 157    --  latest extension contains a controlled component.
 158
 159    function Make_Adjust_Call
 160      (Obj_Ref   : Node_Id;
 161       Typ       : Entity_Id;
 162       Skip_Self : Boolean := False) return Node_Id;
 163    --  Create a call to either Adjust or Deep_Adjust depending on the structure
 164    --  of type Typ. Obj_Ref is an expression with no-side effect (not required
 165    --  to have been previously analyzed) that references the object to be
 166    --  adjusted. Typ is the expected type of Obj_Ref. When Skip_Self is set,
 167    --  only the components (if any) are adjusted.
 168
 169    function Make_Attach_Call
 170      (Obj_Ref : Node_Id;
 171       Ptr_Typ : Entity_Id) return Node_Id;
 172    --  Create a call to prepend an object to a finalization collection. Obj_Ref
 173    --  is the object, Ptr_Typ is the access type that owns the collection. This
 174    --  is used only for .NET/JVM, that is, when VM_Target /= No_VM.
 175    --  Generate the following:
 176    --
 177    --    Ada.Finalization.Heap_Management.Attach
 178    --      (<Ptr_Typ>FC,
 179    --       System.Finalization_Root.Root_Controlled_Ptr (Obj_Ref));
 180
 181    function Make_Detach_Call (Obj_Ref : Node_Id) return Node_Id;
 182    --  Create a call to unhook an object from an arbitrary list. Obj_Ref is the
 183    --  object. Generate the following:
 184    --
 185    --    Ada.Finalization.Heap_Management.Detach
 186    --      (System.Finalization_Root.Root_Controlled_Ptr (Obj_Ref));
 187
 188    function Make_Final_Call
 189      (Obj_Ref   : Node_Id;
 190       Typ       : Entity_Id;
 191       Skip_Self : Boolean := False) return Node_Id;
 192    --  Create a call to either Finalize or Deep_Finalize depending on the
 193    --  structure of type Typ. Obj_Ref is an expression (with no-side effect
 194    --  and is not required to have been previously analyzed) that references
 195    --  the object to be finalized. Typ is the expected type of Obj_Ref. When
 196    --  Skip_Self is set, only the components (if any) are finalized.
 197
 198    procedure Make_Finalize_Address_Body (Typ : Entity_Id);
 199    --  Create the body of TSS routine Finalize_Address if Typ is controlled and
 200    --  does not have a TSS entry for Finalize_Address. The procedure converts
 201    --  an address into a pointer and subsequently calls Deep_Finalize on the
 202    --  dereference.
 203
 204    function Make_Init_Call
 205      (Obj_Ref : Node_Id;
 206       Typ     : Entity_Id) return Node_Id;
 207    --  Obj_Ref is an expression with no-side effect (not required to have been
 208    --  previously analyzed) that references the object to be initialized. Typ
 209    --  is the expected type of Obj_Ref, which is either a controlled type
 210    --  (Is_Controlled) or a type with controlled components (Has_Controlled_
 211    --  Components).
 212
 213    function Make_Handler_For_Ctrl_Operation (Loc : Source_Ptr) return Node_Id;
 214    --  Generate an implicit exception handler with an 'others' choice,
 215    --  converting any occurrence to a raise of Program_Error.
 216
 217    function Make_Local_Deep_Finalize
 218      (Typ : Entity_Id;
 219       Nam : Entity_Id) return Node_Id;
 220    --  Create a special version of Deep_Finalize with identifier Nam. The
 221    --  routine has state information and can parform partial finalization.
 222
 223    function Make_Set_Finalize_Address_Call
 224      (Loc     : Source_Ptr;
 225       Typ     : Entity_Id;
 226       Ptr_Typ : Entity_Id) return Node_Id;
 227    --  Generate the following call:
 228    --
 229    --    Set_Finalize_Address (<Ptr_Typ>FM, <Typ>FD'Unrestricted_Access);
 230    --
 231    --  where Finalize_Address is the corresponding TSS primitive of type Typ
 232    --  and Ptr_Typ is the access type of the related allocation. Loc is the
 233    --  source location of the related allocator.
 234
 235    --------------------------------------------
 236    -- Task and Protected Object finalization --
 237    --------------------------------------------
 238
 239    function Cleanup_Array
 240      (N   : Node_Id;
 241       Obj : Node_Id;
 242       Typ : Entity_Id) return List_Id;
 243    --  Generate loops to finalize any tasks or simple protected objects that
 244    --  are subcomponents of an array.
 245
 246    function Cleanup_Protected_Object
 247      (N   : Node_Id;
 248       Ref : Node_Id) return Node_Id;
 249    --  Generate code to finalize a protected object without entries
 250
 251    function Cleanup_Record
 252      (N   : Node_Id;
 253       Obj : Node_Id;
 254       Typ : Entity_Id) return List_Id;
 255    --  For each subcomponent of a record that contains tasks or simple
 256    --  protected objects, generate the appropriate finalization call.
 257
 258    function Cleanup_Task
 259      (N   : Node_Id;
 260       Ref : Node_Id) return Node_Id;
 261    --  Generate code to finalize a task
 262
 263    function Has_Simple_Protected_Object (T : Entity_Id) return Boolean;
 264    --  Check whether composite type contains a simple protected component
 265
 266    function Is_Simple_Protected_Type (T : Entity_Id) return Boolean;
 267    --  Determine whether T denotes a protected type without entires whose
 268    --  _object field is of type System.Tasking.Protected_Objects.Protection.
 269    --  Something wrong here, implementation was changed to test Lock_Free
 270    --  but this spec does not mention that ???
 271
 272    --------------------------------
 273    -- Transient Scope Management --
 274    --------------------------------
 275
 276    procedure Expand_Cleanup_Actions (N : Node_Id);
 277    --  Expand the necessary stuff into a scope to enable finalization of local
 278    --  objects and deallocation of transient data when exiting the scope. N is
 279    --  a "scope node" that is to say one of the following: N_Block_Statement,
 280    --  N_Subprogram_Body, N_Task_Body, N_Entry_Body.
 281
 282    procedure Establish_Transient_Scope (N : Node_Id; Sec_Stack : Boolean);
 283    --  Push a new transient scope on the scope stack. N is the node responsible
 284    --  for the need of a transient scope. If Sec_Stack is True then the
 285    --  secondary stack is brought in, otherwise it isn't.
 286
 287    function Node_To_Be_Wrapped return Node_Id;
 288    --  Return the node to be wrapped if the current scope is transient
 289
 290    procedure Store_Before_Actions_In_Scope (L : List_Id);
 291    --  Append the list L of actions to the end of the before-actions store in
 292    --  the top of the scope stack (also analyzes these actions).
 293
 294    procedure Store_After_Actions_In_Scope (L : List_Id);
 295    --  Prepend the list L of actions to the beginning of the after-actions
 296    --  stored in the top of the scope stack (also analyzes these actions).
 297    --
 298    --  Note that we are prepending here rather than appending. This means that
 299    --  if several calls are made to this procedure for the same scope, the
 300    --  actions will be executed in reverse order of the calls (actions for the
 301    --  last call executed first). Within the list L for a single call, the
 302    --  actions are executed in the order in which they appear in this list.
 303
 304    procedure Store_Cleanup_Actions_In_Scope (L : List_Id);
 305    --  Prepend the list L of actions to the beginning of the cleanup-actions
 306    --  store in the top of the scope stack.
 307
 308    procedure Wrap_Transient_Declaration (N : Node_Id);
 309    --  N is an object declaration. Expand the finalization calls after the
 310    --  declaration and make the outer scope being the transient one.
 311
 312    procedure Wrap_Transient_Expression (N : Node_Id);
 313    --  N is a sub-expression. Expand a transient block around an expression
 314
 315    procedure Wrap_Transient_Statement (N : Node_Id);
 316    --  N is a statement. Expand a transient block around an instruction
 317
 318 end Exp_Ch7;