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