diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb index 0a4a52714e5..144d20b6f21 100644 --- a/gcc/ada/exp_ch7.adb +++ b/gcc/ada/exp_ch7.adb @@ -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; diff --git a/gcc/ada/exp_ch7.ads b/gcc/ada/exp_ch7.ads index 02c38063407..a062fef3921 100644 --- a/gcc/ada/exp_ch7.ads +++ b/gcc/ada/exp_ch7.ads @@ -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