OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

exp_ch7.ads, [...] (Find_Final_List): If the access type is anonymous, use finalization list of enclosing dynamic scope.

Browse Source 
2007-04-06  Ed Schonberg  <schonberg@adacore.com>
	    Bob Duff  <duff@adacore.com>
	    Cyrille Comar  <comar@adacore.com>

	* exp_ch7.ads, exp_ch7.adb (Find_Final_List): If the access type is
	anonymous, use finalization list of enclosing dynamic scope.
	(Expand_N_Package_Declaration): For a library package declaration
	without a corresponding body, generate RACW subprogram bodies in the
	spec (just as we do for the task activation call).
	(Convert_View): Split Is_Abstract flag into Is_Abstract_Subprogram and
	Is_Abstract_Type. Make sure these are called only when appropriate.
	Remove all code for DSP option
	(CW_Or_Controlled_Type): new subprogram.

From-SVN: r123563
This commit is contained in:
Ed Schonberg 2007-04-06 11:20:23 +02:00 committed by Arnaud Charlet
parent dee4682a7a
commit afe4375b43
2 changed files with 167 additions and 95 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

130
gcc/ada/exp_ch7.adb
View File

@ -35,9 +35,11 @@ with Errout; use Errout;
with Exp_Ch9; use Exp_Ch9;
with Exp_Ch11; use Exp_Ch11;
with Exp_Dbug; use Exp_Dbug;
with Exp_Dist; use Exp_Dist;
with Exp_Tss; use Exp_Tss;
with Exp_Util; use Exp_Util;
with Freeze; use Freeze;
with Lib; use Lib;
with Hostparm; use Hostparm;
with Nlists; use Nlists;
with Nmake; use Nmake;
@ -46,7 +48,6 @@ with Output; use Output;
with Restrict; use Restrict;
with Rident; use Rident;
with Rtsfind; use Rtsfind;
with Targparm; use Targparm;
with Sinfo; use Sinfo;
with Sem; use Sem;
with Sem_Ch3; use Sem_Ch3;
@ -900,6 +901,15 @@ package body Exp_Ch7 is
and then Controlled_Type (Corresponding_Record_Type (T)));
end Controlled_Type;
---------------------------
-- CW_Or_Controlled_Type --
---------------------------
function CW_Or_Controlled_Type (T : Entity_Id) return Boolean is
begin
return Is_Class_Wide_Type (T) or else Controlled_Type (T);
end CW_Or_Controlled_Type;
--------------------------
-- Controller_Component --
--------------------------
@ -977,7 +987,7 @@ package body Exp_Ch7 is
Atyp := Etype (Arg);
end if;
if Is_Abstract (Proc) and then Is_Tagged_Type (Ftyp) then
if Is_Abstract_Subprogram (Proc) and then Is_Tagged_Type (Ftyp) then
return Unchecked_Convert_To (Class_Wide_Type (Ftyp), Arg);
elsif Ftyp /= Atyp
@ -1020,17 +1030,12 @@ package body Exp_Ch7 is
Loc : constant Source_Ptr := Sloc (N);
Wrap_Node : Node_Id;
Sec_Stk : constant Boolean :=
Sec_Stack and not Functions_Return_By_DSP_On_Target;
-- We never need a secondary stack if functions return by DSP
begin
-- Do not create a transient scope if we are already inside one
for S in reverse Scope_Stack.First .. Scope_Stack.Last loop
if Scope_Stack.Table (S).Is_Transient then
if Sec_Stk then
if Sec_Stack then
Set_Uses_Sec_Stack (Scope_Stack.Table (S).Entity);
end if;
@ -1064,7 +1069,7 @@ package body Exp_Ch7 is
New_Scope (New_Internal_Entity (E_Block, Current_Scope, Loc, 'B'));
Set_Scope_Is_Transient;
if Sec_Stk then
if Sec_Stack then
Set_Uses_Sec_Stack (Current_Scope);
Check_Restriction (No_Secondary_Stack, N);
end if;
@ -1546,12 +1551,12 @@ package body Exp_Ch7 is
-- Expand_N_Package_Body --
---------------------------
-- Add call to Activate_Tasks if body is an activator (actual
-- processing is in chapter 9).
-- Add call to Activate_Tasks if body is an activator (actual processing
-- is in chapter 9).
-- Generate subprogram descriptor for elaboration routine
-- ENcode entity names in package body
-- Encode entity names in package body
procedure Expand_N_Package_Body (N : Node_Id) is
Ent : constant Entity_Id := Corresponding_Spec (N);
@ -1583,14 +1588,76 @@ package body Exp_Ch7 is
-- whether a body will eventually appear.
procedure Expand_N_Package_Declaration (N : Node_Id) is
Spec : constant Node_Id := Specification (N);
Decls : List_Id;
No_Body : Boolean;
-- True in the case of a package declaration that is a compilation unit
-- and for which no associated body will be compiled in
-- this compilation.
begin
if Nkind (Parent (N)) = N_Compilation_Unit
and then not Body_Required (Parent (N))
No_Body := False;
-- Case of a package declaration other than a compilation unit
if Nkind (Parent (N)) /= N_Compilation_Unit then
null;
-- Case of a compilation unit that does not require a body
elsif not Body_Required (Parent (N))
and then not Unit_Requires_Body (Defining_Entity (N))
and then Present (Activation_Chain_Entity (N))
then
No_Body := True;
-- Special case of generating calling stubs for a remote call interface
-- package: even though the package declaration requires one, the
-- body won't be processed in this compilation (so any stubs for RACWs
-- declared in the package must be generated here, along with the
-- spec).
elsif Parent (N) = Cunit (Main_Unit)
and then Is_Remote_Call_Interface (Defining_Entity (N))
and then Distribution_Stub_Mode = Generate_Caller_Stub_Body
then
No_Body := True;
end if;
-- For a package declaration that implies no associated body, generate
-- task activation call and RACW supporting bodies now (since we won't
-- have a specific separate compilation unit for that).
if No_Body then
New_Scope (Defining_Entity (N));
Build_Task_Activation_Call (N);
if Has_RACW (Defining_Entity (N)) then
-- Generate RACW subprogram bodies
Decls := Private_Declarations (Spec);
if No (Decls) then
Decls := Visible_Declarations (Spec);
end if;
if No (Decls) then
Decls := New_List;
Set_Visible_Declarations (Spec, Decls);
end if;
Append_RACW_Bodies (Decls, Defining_Entity (N));
Analyze_List (Decls);
end if;
if Present (Activation_Chain_Entity (N)) then
-- Generate task activation call as last step of elaboration
Build_Task_Activation_Call (N);
end if;
Pop_Scope;
end if;
@ -1652,12 +1719,18 @@ package body Exp_Ch7 is
Selector_Name => Make_Identifier (Loc, Name_F));
-- Case of a dynamically allocated object. The final list is the
-- corresponding list controller (The next entity in the scope of
-- the access type with the right type). If the type comes from a
-- With_Type clause, no controller was created, and we use the
-- global chain instead.
-- corresponding list controller (the next entity in the scope of the
-- access type with the right type). If the type comes from a With_Type
-- clause, no controller was created, we use the global chain instead.
elsif Is_Access_Type (E) then
-- An anonymous access type either has a list created for it when the
-- allocator is a for an access parameter or an access discriminant,
-- or else it uses the list of the enclosing dynamic scope, when the
-- context is a declaration or an assignment.
elsif Is_Access_Type (E)
and then Ekind (E) /= E_Anonymous_Access_Type
then
if not From_With_Type (E) then
return
Make_Selected_Component (Loc,
@ -2589,7 +2662,7 @@ package body Exp_Ch7 is
if Prim = Finalize_Case or else Prim = Adjust_Case then
Handler := New_List (
Make_Exception_Handler (Loc,
Make_Implicit_Exception_Handler (Loc,
Exception_Choices => New_List (Make_Others_Choice (Loc)),
Statements => New_List (
Make_Raise_Program_Error (Loc,
@ -3025,10 +3098,8 @@ package body Exp_Ch7 is
Set_Uses_Sec_Stack (Current_Scope, False);
if not Requires_Transient_Scope (Etype (S)) then
if not Functions_Return_By_DSP_On_Target then
Set_Uses_Sec_Stack (S, True);
Check_Restriction (No_Secondary_Stack, Action);
end if;
Set_Uses_Sec_Stack (S, True);
Check_Restriction (No_Secondary_Stack, Action);
end if;
exit;
@ -3046,11 +3117,8 @@ package body Exp_Ch7 is
elsif K = E_Procedure
or else K = E_Block
then
if not Functions_Return_By_DSP_On_Target then
Set_Uses_Sec_Stack (S, True);
Check_Restriction (No_Secondary_Stack, Action);
end if;
Set_Uses_Sec_Stack (S, True);
Check_Restriction (No_Secondary_Stack, Action);
Set_Uses_Sec_Stack (Current_Scope, False);
exit;

132
gcc/ada/exp_ch7.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2006, 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- --
@ -60,15 +60,21 @@ package Exp_Ch7 is
function Controlled_Type (T : Entity_Id) return Boolean;
-- True if T potentially needs finalization actions
function CW_Or_Controlled_Type (T : Entity_Id) return Boolean;
-- True if T is either a potentially controlled type or a class-wide type.
-- Note that in normal mode, class-wide types are potentially controlled so
-- this function is different from Controlled_Type only under restrictions
-- No_Finalization.
function Find_Final_List
(E : Entity_Id;
Ref : Node_Id := Empty) return Node_Id;
-- E is an entity representing a controlled object, a controlled type
-- or a scope. If Ref is not empty, it is a reference to a controlled
-- record, the closest Final list is in the controller component of
-- the record containing Ref otherwise this function returns a
-- reference to the final list attached to the closest dynamic scope
-- (that can be E itself) creating this final list if necessary.
-- E is an entity representing a controlled object, a controlled type or a
-- scope. If Ref is not empty, it is a reference to a controlled record,
-- the closest Final list is in the controller component of the record
-- containing Ref otherwise this function returns a reference to the final
-- list attached to the closest dynamic scope (that can be E itself)
-- creating this final list if necessary.
function Has_New_Controlled_Component (E : Entity_Id) return Boolean;
-- E is a type entity. Give the same resul as Has_Controlled_Component
@ -79,30 +85,28 @@ package Exp_Ch7 is
(Obj_Ref : Node_Id;
Flist_Ref : Node_Id;
With_Attach : Node_Id) return Node_Id;
-- Attach the referenced object to the referenced Final Chain
-- 'Flist_Ref' With_Attach is an expression of type Short_Short_Integer
-- which can be either '0' to signify no attachment, '1' for
-- attachement to a simply linked list or '2' for attachement to a
-- doubly linked list.
-- Attach the referenced object to the referenced Final Chain 'Flist_Ref'
-- With_Attach is an expression of type Short_Short_Integer which can be
-- either '0' to signify no attachment, '1' for attachement to a simply
-- linked list or '2' for attachement to a doubly linked list.
function Make_Init_Call
(Ref : Node_Id;
Typ : Entity_Id;
Flist_Ref : Node_Id;
With_Attach : Node_Id) return List_Id;
-- Ref is an expression (with no-side effect and is not required to
-- have been previously analyzed) that references the object to be
-- initialized. Typ is the expected type of Ref, which is a controlled
-- type (Is_Controlled) or a type with controlled components
-- (Has_Controlled). With_Attach is an integer expression representing
-- the level of attachment, see Attach_To_Final_List's Nb_Link param
-- documentation in s-finimp.ads.
-- Ref is an expression (with no-side effect and is not required to have
-- been previously analyzed) that references the object to be initialized.
-- Typ is the expected type of Ref, which is either a controlled type
-- (Is_Controlled) or a type with controlled components (Has_Controlled).
-- With_Attach is an integer expression which is the attchment level,
-- see System.Finalization_Implementation.Attach_To_Final_List for the
-- documentation of Nb_Link.
--
-- This function will generate the appropriate calls to make
-- sure that the objects referenced by Ref are initialized. The
-- generate code is quite different depending on the fact the type
-- IS_Controlled or HAS_Controlled but this is not the problem of the
-- caller, the details are in the body.
-- This function will generate the appropriate calls to make sure that the
-- objects referenced by Ref are initialized. The generated code is quite
-- different for an IS_Controlled type or a HAS_Controlled type, but this
-- is not the problem for the caller, the details are in the body.
function Make_Adjust_Call
(Ref : Node_Id;
@ -110,23 +114,23 @@ package Exp_Ch7 is
Flist_Ref : Node_Id;
With_Attach : Node_Id;
Allocator : Boolean := False) return List_Id;
-- Ref is an expression (with no-side effect and is not required to
-- have been previously analyzed) that references the object to be
-- adjusted. Typ is the expected type of Ref, which is a controlled
-- type (Is_Controlled) or a type with controlled components
-- (Has_Controlled). With_Attach is an integer expression representing
-- the level of attachment, see Attach_To_Final_List's Nb_Link param
-- documentation in s-finimp.ads. Note: if Typ is Finalize_Storage_Only
-- and the object is at library level, then With_Attach will be ignored,
-- and a zero link level will be passed to Attach_To_Final_List.
-- Ref is an expression (with no-side effect and is not required to have
-- been previously analyzed) that references the object to be adjusted. Typ
-- is the expected type of Ref, which is a controlled type (Is_Controlled)
-- or a type with controlled components (Has_Controlled). With_Attach is an
-- integer expression giving the attachment level (see documentation of
-- Attach_To_Final_List.Nb_Link param documentation in s-finimp.ads.
-- Note: if Typ is Finalize_Storage_Only and the object is at library
-- level, then With_Attach will be ignored, and a zero link level will be
-- passed to Attach_To_Final_List.
--
-- This function will generate the appropriate calls to make
-- sure that the objects referenced by Ref are adjusted. The generated
-- code is quite different depending on the fact the type IS_Controlled
-- or HAS_Controlled but this is not the problem of the caller, the
-- details are in the body. The objects must be attached when the adjust
-- takes place after an initialization expression but not when it takes
-- place after a regular assignment.
-- This function will generate the appropriate calls to make sure that the
-- objects referenced by Ref are adjusted. The generated code is quite
-- different depending on the fact the type IS_Controlled or HAS_Controlled
-- but this is not the problem of the caller, the details are in the body.
-- The objects must be attached when the adjust takes place after an
-- initialization expression but not when it takes place after a regular
-- assignment.
--
-- If Allocator is True, we are adjusting a newly-created object. The
-- existing chaining pointers should not be left unchanged, because they
@ -138,21 +142,21 @@ package Exp_Ch7 is
(Ref : Node_Id;
Typ : Entity_Id;
With_Detach : Node_Id) return List_Id;
-- 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 Ref, which is a
-- controlled type (Is_Controlled) or a type with controlled
-- components (Has_Controlled). With_Detach is a boolean expression
-- indicating whether to detach the controlled object from whatever
-- finalization list it is currently attached to.
-- 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 Ref, which is a controlled type
-- (Is_Controlled) or a type with controlled components (Has_Controlled).
-- With_Detach is a boolean expression indicating whether to detach the
-- controlled object from whatever finalization list it is currently
-- attached to.
--
-- This function will generate the appropriate calls to make
-- sure that the objects referenced by Ref are finalized. The generated
-- code is quite different depending on the fact the type IS_Controlled
-- or HAS_Controlled but this is not the problem of the caller, the
-- details are in the body. The objects must be detached when finalizing
-- an unchecked deallocated object but not when finalizing the target of
-- an assignment, it is not necessary either on scope exit.
-- This function will generate the appropriate calls to make sure that the
-- objects referenced by Ref are finalized. The generated code is quite
-- different depending on the fact the type IS_Controlled or HAS_Controlled
-- but this is not the problem of the caller, the details are in the body.
-- The objects must be detached when finalizing an unchecked deallocated
-- object but not when finalizing the target of an assignment, it is not
-- necessary either on scope exit.
procedure Expand_Ctrl_Function_Call (N : Node_Id);
-- Expand a call to a function returning a controlled value. That is to
@ -167,8 +171,8 @@ package Exp_Ch7 is
(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.
-- Generate loops to finalize any tasks or simple protected objects that
-- are subcomponents of an array.
function Cleanup_Protected_Object
(N : Node_Id;
@ -191,10 +195,10 @@ package Exp_Ch7 is
-- Check whether composite type contains a simple protected component
function Is_Simple_Protected_Type (T : Entity_Id) return Boolean;
-- Check whether argument is a protected type without entries.
-- Protected types with entries are controlled, and their cleanup
-- is handled by the standard finalization machinery. For simple
-- protected types we generate inline code to release their locks.
-- Check whether argument is a protected type without entries. Protected
-- types with entries are controlled, and their cleanup is handled by the
-- standard finalization machinery. For simple protected types we generate
-- inline code to release their locks.
--------------------------------
-- Transient Scope Management --
@ -215,12 +219,12 @@ package Exp_Ch7 is
-- 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
-- Append the list L of actions to the end of the before-actions store in
-- the top of the scope stack
procedure Store_After_Actions_In_Scope (L : List_Id);
-- Append the list L of actions to the beginning of the after-actions
-- store in the top of the scope stack
-- Append the list L of actions to the beginning of the after-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