------------------------------------------------------------------------------ -- -- -- GNAT COMPILER COMPONENTS -- -- -- -- E X P _ C H 7 -- -- -- -- S p e c -- -- -- -- Copyright (C) 1992-2018, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- -- ware Foundation; either version 3, or (at your option) any later ver- -- -- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- -- for more details. You should have received a copy of the GNU General -- -- Public License distributed with GNAT; see file COPYING3. If not, go to -- -- http://www.gnu.org/licenses for a complete copy of the license. -- -- -- -- GNAT was originally developed by the GNAT team at New York University. -- -- Extensive contributions were provided by Ada Core Technologies Inc. -- -- -- ------------------------------------------------------------------------------ with Namet; use Namet; with Types; use Types; package Exp_Ch7 is procedure Expand_N_Package_Body (N : Node_Id); procedure Expand_N_Package_Declaration (N : Node_Id); ----------------------------- -- Finalization Management -- ----------------------------- procedure Build_Anonymous_Master (Ptr_Typ : Entity_Id); -- Build a finalization master for an anonymous access-to-controlled type -- denoted by Ptr_Typ. The master is inserted in the declarations of the -- current unit. procedure Build_Controlling_Procs (Typ : Entity_Id); -- Typ is a record, and array type having controlled components. -- Create the procedures Deep_Initialize, Deep_Adjust and Deep_Finalize -- that take care of finalization management at run-time. -- Support of exceptions from user finalization procedures -- There is a specific mechanism to handle these exceptions, continue -- finalization and then raise PE. This mechanism is used by this package -- but also by exp_intr for Ada.Unchecked_Deallocation. -- There are 3 subprograms to use this mechanism, and the type -- Finalization_Exception_Data carries internal data between these -- subprograms: -- -- 1. Build_Object_Declaration: create the variables for the next two -- subprograms. -- 2. Build_Exception_Handler: create the exception handler for a call -- to a user finalization procedure. -- 3. Build_Raise_Stmt: create code to potentially raise a PE exception -- if an exception was raise in a user finalization procedure. type Finalization_Exception_Data is record Loc : Source_Ptr; -- Sloc for the added nodes Abort_Id : Entity_Id; -- Boolean variable set to true if the finalization was triggered by -- an abort. E_Id : Entity_Id; -- Variable containing the exception occurrence raised by user code Raised_Id : Entity_Id; -- Boolean variable set to true if an exception was raised in user code end record; function Build_Exception_Handler (Data : Finalization_Exception_Data; For_Library : Boolean := False) return Node_Id; -- Subsidiary to Build_Finalizer, Make_Deep_Array_Body and Make_Deep_Record -- _Body. Create an exception handler of the following form: -- -- when others => -- if not Raised_Id then -- Raised_Id := True; -- Save_Occurrence (E_Id, Get_Current_Excep.all.all); -- end if; -- -- If flag For_Library is set (and not in restricted profile): -- -- when others => -- if not Raised_Id then -- Raised_Id := True; -- Save_Library_Occurrence (Get_Current_Excep.all); -- end if; -- -- E_Id denotes the defining identifier of a local exception occurrence. -- Raised_Id is the entity of a local boolean flag. Flag For_Library is -- used when operating at the library level, when enabled the current -- exception will be saved to a global location. procedure Build_Finalization_Master (Typ : Entity_Id; For_Lib_Level : Boolean := False; For_Private : Boolean := False; Context_Scope : Entity_Id := Empty; Insertion_Node : Node_Id := Empty); -- Build a finalization master for an access type. The designated type may -- not necessarily be controlled or need finalization actions depending on -- the context. Flag For_Lib_Level must be set when creating a master for a -- build-in-place function call access result type. Flag For_Private must -- be set when the designated type contains a private component. Parameters -- Context_Scope and Insertion_Node must be used in conjunction with flag -- For_Private. Context_Scope is the scope of the context where the -- finalization master must be analyzed. Insertion_Node is the insertion -- point before which the master is to be inserted. procedure Build_Late_Proc (Typ : Entity_Id; Nam : Name_Id); -- Build one controlling procedure when a late body overrides one of the -- controlling operations. procedure Build_Object_Declarations (Data : out Finalization_Exception_Data; Decls : List_Id; Loc : Source_Ptr; For_Package : Boolean := False); -- Subsidiary to Make_Deep_Array_Body and Make_Deep_Record_Body. Create the -- list List containing the object declarations of boolean flag Abort_Id, -- the exception occurrence E_Id and boolean flag Raised_Id. -- -- Abort_Id : constant Boolean := -- Exception_Identity (Get_Current_Excep.all) = -- Standard'Abort_Signal'Identity; -- -- Abort_Id : constant Boolean := False; -- no abort or For_Package -- -- E_Id : Exception_Occurrence; -- Raised_Id : Boolean := False; function Build_Raise_Statement (Data : Finalization_Exception_Data) return Node_Id; -- Subsidiary to routines Build_Finalizer, Make_Deep_Array_Body and Make_ -- Deep_Record_Body. Generate the following conditional raise statement: -- -- if Raised_Id and then not Abort_Id then -- Raise_From_Controlled_Operation (E_Id); -- end if; -- -- Abort_Id is a local boolean flag which is set when the finalization was -- triggered by an abort, E_Id denotes the defining identifier of a local -- exception occurrence, Raised_Id is the entity of a local boolean flag. function CW_Or_Has_Controlled_Part (T : Entity_Id) return Boolean; -- True if T is a class-wide type, or if it has controlled parts ("part" -- means T or any of its subcomponents). Same as Needs_Finalization, except -- when pragma Restrictions (No_Finalization) applies, in which case we -- know that class-wide objects do not contain controlled parts. function Has_New_Controlled_Component (E : Entity_Id) return Boolean; -- E is a type entity. Give the same result as Has_Controlled_Component -- except for tagged extensions where the result is True only if the -- latest extension contains a controlled component. function Make_Adjust_Call (Obj_Ref : Node_Id; Typ : Entity_Id; Skip_Self : Boolean := False) return Node_Id; -- Create a call to either Adjust or Deep_Adjust depending on the structure -- of type Typ. Obj_Ref is an expression with no side effects (not required -- to have been previously analyzed) that references the object to be -- adjusted. Typ is the expected type of Obj_Ref. When Skip_Self is set, -- only the components (if any) are adjusted. Return Empty if Adjust or -- Deep_Adjust is not available, possibly due to previous errors. function Make_Detach_Call (Obj_Ref : Node_Id) return Node_Id; -- Create a call to unhook an object from an arbitrary list. Obj_Ref is the -- object. Generate the following: -- -- Ada.Finalization.Heap_Management.Detach -- (System.Finalization_Root.Root_Controlled_Ptr (Obj_Ref)); function Make_Final_Call (Obj_Ref : Node_Id; Typ : Entity_Id; Skip_Self : Boolean := False) return Node_Id; -- Create a call to either Finalize or Deep_Finalize, depending on the -- structure of type Typ. Obj_Ref is an expression (with no side effects -- and is not required to have been previously analyzed) that references -- the object to be finalized. Typ is the expected type of Obj_Ref. When -- Skip_Self is set, only the components (if any) are finalized. Return -- Empty if Finalize or Deep_Finalize is not available, possibly due to -- previous errors. procedure Make_Finalize_Address_Body (Typ : Entity_Id); -- Create the body of TSS routine Finalize_Address if Typ is controlled and -- does not have a TSS entry for Finalize_Address. The procedure converts -- an address into a pointer and subsequently calls Deep_Finalize on the -- dereference. function Make_Init_Call (Obj_Ref : Node_Id; Typ : Entity_Id) return Node_Id; -- Create a call to either Initialize or Deep_Initialize, depending on the -- structure of type Typ. Obj_Ref is an expression with no side effects -- (not required to have been previously analyzed) that references the -- object to be initialized. Typ is the expected type of Obj_Ref. Return -- Empty if Initialize or Deep_Initialize is not available, possibly due to -- previous errors. function Make_Handler_For_Ctrl_Operation (Loc : Source_Ptr) return Node_Id; -- Generate an implicit exception handler with an 'others' choice, -- converting any occurrence to a raise of Program_Error. function Make_Local_Deep_Finalize (Typ : Entity_Id; Nam : Entity_Id) return Node_Id; -- Create a special version of Deep_Finalize with identifier Nam. The -- routine has state information and can perform partial finalization. function Make_Set_Finalize_Address_Call (Loc : Source_Ptr; Ptr_Typ : Entity_Id) return Node_Id; -- Associate the Finalize_Address primitive of the designated type with the -- finalization master of access type Ptr_Typ. The returned call is: -- -- Set_Finalize_Address -- (FM, FD'Unrestricted_Access); -------------------------------------------- -- Task and Protected Object finalization -- -------------------------------------------- function Cleanup_Array (N : Node_Id; Obj : Node_Id; Typ : Entity_Id) return List_Id; -- Generate loops to finalize any tasks or simple protected objects that -- are subcomponents of an array. function Cleanup_Protected_Object (N : Node_Id; Ref : Node_Id) return Node_Id; -- Generate code to finalize a protected object without entries function Cleanup_Record (N : Node_Id; Obj : Node_Id; Typ : Entity_Id) return List_Id; -- For each subcomponent of a record that contains tasks or simple -- protected objects, generate the appropriate finalization call. function Cleanup_Task (N : Node_Id; Ref : Node_Id) return Node_Id; -- Generate code to finalize a task function Has_Simple_Protected_Object (T : Entity_Id) return Boolean; -- Check whether composite type contains a simple protected component function Is_Simple_Protected_Type (T : Entity_Id) return Boolean; -- Determine whether T denotes a protected type without entries whose -- _object field is of type System.Tasking.Protected_Objects.Protection. -- Something wrong here, implementation was changed to test Lock_Free -- but this spec does not mention that ??? -------------------------------- -- Transient Scope Management -- -------------------------------- procedure Expand_Cleanup_Actions (N : Node_Id); -- Expand the necessary stuff into a scope to enable finalization of local -- objects and deallocation of transient data when exiting the scope. N is -- a "scope node" that is to say one of the following: N_Block_Statement, -- N_Subprogram_Body, N_Task_Body, N_Entry_Body. procedure Establish_Transient_Scope (N : Node_Id; Manage_Sec_Stack : Boolean); -- Push a new transient scope on the scope stack. N is the node which must -- be serviced by the transient scope. Set Manage_Sec_Stack when the scope -- must mark and release the secondary stack. function Node_To_Be_Wrapped return Node_Id; -- Return the node to be wrapped if the current scope is transient procedure Store_Before_Actions_In_Scope (L : List_Id); -- Append the list L of actions to the end of the before-actions store in -- the top of the scope stack (also analyzes these actions). procedure Store_After_Actions_In_Scope (L : List_Id); -- Prepend the list L of actions to the beginning of the after-actions -- stored in the top of the scope stack (also analyzes these actions). -- -- Note that we are prepending here rather than appending. This means that -- if several calls are made to this procedure for the same scope, the -- actions will be executed in reverse order of the calls (actions for the -- last call executed first). Within the list L for a single call, the -- actions are executed in the order in which they appear in this list. procedure Store_Cleanup_Actions_In_Scope (L : List_Id); -- Prepend the list L of actions to the beginning of the cleanup-actions -- store in the top of the scope stack. procedure Wrap_Transient_Declaration (N : Node_Id); -- N is an object declaration. Expand the finalization calls after the -- declaration and make the outer scope being the transient one. procedure Wrap_Transient_Expression (N : Node_Id); -- N is a sub-expression. Expand a transient block around an expression procedure Wrap_Transient_Statement (N : Node_Id); -- N is a statement. Expand a transient block around an instruction end Exp_Ch7;