| ------------------------------------------------------------------------------ |
| -- -- |
| -- GNAT COMPILER COMPONENTS -- |
| -- -- |
| -- E X P _ C H 7 -- |
| -- -- |
| -- S p e c -- |
| -- -- |
| -- Copyright (C) 1992-2015, 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_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_Anonymous : 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 necessarely be controlled or need finalization actions depending on |
| -- the context. Flag For_Anonymous must be set when creating a master for |
| -- an anonymous access 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 flags For_Anonymous |
| -- and 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 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; |
| -- <or> |
| -- 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 effect (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. |
| |
| function Make_Attach_Call |
| (Obj_Ref : Node_Id; |
| Ptr_Typ : Entity_Id) return Node_Id; |
| -- Create a call to prepend an object to a finalization collection. Obj_Ref |
| -- is the object, Ptr_Typ is the access type that owns the collection. This |
| -- is used only for .NET/JVM, that is, when VM_Target /= No_VM. |
| -- Generate the following: |
| -- |
| -- Ada.Finalization.Heap_Management.Attach |
| -- (<Ptr_Typ>FC, |
| -- System.Finalization_Root.Root_Controlled_Ptr (Obj_Ref)); |
| |
| 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 effect |
| -- 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. |
| |
| 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; |
| -- Obj_Ref is an expression with no-side effect (not required to have been |
| -- previously analyzed) that references the object to be initialized. Typ |
| -- is the expected type of Obj_Ref, which is either a controlled type |
| -- (Is_Controlled) or a type with controlled components (Has_Controlled_ |
| -- Components). |
| |
| 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 parform 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: |
| -- Generate the following call: |
| -- |
| -- Set_Finalize_Address |
| -- (<Ptr_Typ>FM, <Desig_Typ>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 entires 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; Sec_Stack : Boolean); |
| -- Push a new transient scope on the scope stack. N is the node responsible |
| -- for the need of a transient scope. If Sec_Stack is True then the |
| -- secondary stack is brought in, otherwise it isn't. |
| |
| 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; |
