blob: f47abe86442de589d9e934c6bc0b6d5eac9af4ba [file] [log] [blame]
------------------------------------------------------------------------------
-- --
-- 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;