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