From: charlet Date: Thu, 13 Oct 2011 10:37:33 +0000 (+0000) Subject: 2011-10-13 Bob Duff X-Git-Url: http://git.sourceforge.jp/view?a=commitdiff_plain;h=52b3bcf2efa74aba858df98905b42b9535c9a565;p=pf3gnuchains%2Fgcc-fork.git 2011-10-13 Bob Duff * exp_ch6.ads (BIP_Storage_Pool): New "extra implicit parameter" that gets passed in the same cases where BIP_Alloc_Form is passed (caller-unknown-size results). BIP_Storage_Pool is used when BIP_Alloc_Form = User_Storage_Pool. In that case, a pointer to the user-defined storage pool is passed at the call site, and this pool is used in callee to allocate the result. * exp_ch6.adb (Add_Unconstrained_Actuals_To_Build_In_Place_Call): New version of Add_Alloc_Form_Actual_To_Build_In_Place_Call. Passes the additional BIP_Storage_Pool actual. (Expand_N_Extended_Return_Statement): Allocate the function result using the user-defined storage pool, if BIP_Alloc_Form = User_Storage_Pool. * sem_ch6.adb: Add the "extra formal" for BIP_Storage_Pool. * exp_ch4.adb: Don't overwrite storage pool set by Expand_N_Extended_Return_Statement. * s-stopoo.ads, rtsfind.ads (Root_Storage_Pool_Ptr): New type, for use in build-in-place function calls within allocators where the access type has a user-defined storage pool. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@179903 138bc75d-0d04-0410-961f-82ee72b054a4 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 003158f5cbd..61da1c3f507 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,24 @@ +2011-10-13 Bob Duff + + * exp_ch6.ads (BIP_Storage_Pool): New "extra implicit parameter" + that gets passed in the same cases where BIP_Alloc_Form is passed + (caller-unknown-size results). BIP_Storage_Pool is used when + BIP_Alloc_Form = User_Storage_Pool. In that case, a pointer + to the user-defined storage pool is passed at the call site, + and this pool is used in callee to allocate the result. + * exp_ch6.adb (Add_Unconstrained_Actuals_To_Build_In_Place_Call): New + version of Add_Alloc_Form_Actual_To_Build_In_Place_Call. Passes + the additional BIP_Storage_Pool actual. + (Expand_N_Extended_Return_Statement): Allocate the function + result using the user-defined storage pool, if BIP_Alloc_Form = + User_Storage_Pool. + * sem_ch6.adb: Add the "extra formal" for BIP_Storage_Pool. + * exp_ch4.adb: Don't overwrite storage pool set by + Expand_N_Extended_Return_Statement. + * s-stopoo.ads, rtsfind.ads (Root_Storage_Pool_Ptr): New type, + for use in build-in-place function calls within allocators + where the access type has a user-defined storage pool. + 2011-10-13 Sergey Rybin * gnat_ugn.texi, vms_data.ads: Add an option to control enumeration diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index 677eec74dd5..638c7902843 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -3526,23 +3526,28 @@ package body Exp_Ch4 is end if; -- Set the storage pool and find the appropriate version of Allocate to - -- call. + -- call. But don't overwrite the storage pool if it is already set, + -- which can happen for build-in-place function returns (see + -- Exp_Ch4.Expand_N_Extended_Return_Statement). - Pool := Associated_Storage_Pool (Root_Type (PtrT)); - Set_Storage_Pool (N, Pool); + if No (Storage_Pool (N)) then + Pool := Associated_Storage_Pool (Root_Type (PtrT)); - if Present (Pool) then - if Is_RTE (Pool, RE_SS_Pool) then - if VM_Target = No_VM then - Set_Procedure_To_Call (N, RTE (RE_SS_Allocate)); - end if; + if Present (Pool) then + Set_Storage_Pool (N, Pool); - elsif Is_Class_Wide_Type (Etype (Pool)) then - Set_Procedure_To_Call (N, RTE (RE_Allocate_Any)); + if Is_RTE (Pool, RE_SS_Pool) then + if VM_Target = No_VM then + Set_Procedure_To_Call (N, RTE (RE_SS_Allocate)); + end if; - else - Set_Procedure_To_Call (N, - Find_Prim_Op (Etype (Pool), Name_Allocate)); + elsif Is_Class_Wide_Type (Etype (Pool)) then + Set_Procedure_To_Call (N, RTE (RE_Allocate_Any)); + + else + Set_Procedure_To_Call (N, + Find_Prim_Op (Etype (Pool), Name_Allocate)); + end if; end if; end if; diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index 8955e5d9174..e7b04a3beb3 100644 --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -94,15 +94,18 @@ package body Exp_Ch6 is -- along directly to the build-in-place function. Finally, if Return_Object -- is empty, then pass a null literal as the actual. - procedure Add_Alloc_Form_Actual_To_Build_In_Place_Call + procedure Add_Unconstrained_Actuals_To_Build_In_Place_Call (Function_Call : Node_Id; Function_Id : Entity_Id; Alloc_Form : BIP_Allocation_Form := Unspecified; - Alloc_Form_Exp : Node_Id := Empty); - -- Ada 2005 (AI-318-02): Add an actual indicating the form of allocation, - -- if any, to be done by a build-in-place function. If Alloc_Form_Exp is - -- present, then use it, otherwise pass a literal corresponding to the - -- Alloc_Form parameter (which must not be Unspecified in that case). + Alloc_Form_Exp : Node_Id := Empty; + Pool_Actual : Node_Id := Make_Null (No_Location)); + -- Ada 2005 (AI-318-02): Add the actuals needed for a build-in-place + -- function call that returns a caller-unknown-size result (BIP_Alloc_Form + -- and BIP_Storage_Pool). If Alloc_Form_Exp is present, then use it, + -- otherwise pass a literal corresponding to the Alloc_Form parameter + -- (which must not be Unspecified in that case). Pool_Actual is the + -- parameter to pass to BIP_Storage_Pool. procedure Add_Finalization_Master_Actual_To_Build_In_Place_Call (Func_Call : Node_Id; @@ -252,18 +255,20 @@ package body Exp_Ch6 is end Add_Access_Actual_To_Build_In_Place_Call; -------------------------------------------------- - -- Add_Alloc_Form_Actual_To_Build_In_Place_Call -- + -- Add_Unconstrained_Actuals_To_Build_In_Place_Call -- -------------------------------------------------- - procedure Add_Alloc_Form_Actual_To_Build_In_Place_Call + procedure Add_Unconstrained_Actuals_To_Build_In_Place_Call (Function_Call : Node_Id; Function_Id : Entity_Id; Alloc_Form : BIP_Allocation_Form := Unspecified; - Alloc_Form_Exp : Node_Id := Empty) + Alloc_Form_Exp : Node_Id := Empty; + Pool_Actual : Node_Id := Make_Null (No_Location)) is Loc : constant Source_Ptr := Sloc (Function_Call); Alloc_Form_Actual : Node_Id; Alloc_Form_Formal : Node_Id; + Pool_Formal : Node_Id; begin -- The allocation form generally doesn't need to be passed in the case @@ -305,7 +310,15 @@ package body Exp_Ch6 is Add_Extra_Actual_To_Call (Function_Call, Alloc_Form_Formal, Alloc_Form_Actual); - end Add_Alloc_Form_Actual_To_Build_In_Place_Call; + + -- Pass the Storage_Pool parameter + + Pool_Formal := Build_In_Place_Formal (Function_Id, BIP_Storage_Pool); + Analyze_And_Resolve (Pool_Actual, Etype (Pool_Formal)); + Add_Extra_Actual_To_Call + (Function_Call, Pool_Formal, Pool_Actual); + + end Add_Unconstrained_Actuals_To_Build_In_Place_Call; ----------------------------------------------------------- -- Add_Finalization_Master_Actual_To_Build_In_Place_Call -- @@ -541,6 +554,8 @@ package body Exp_Ch6 is case Kind is when BIP_Alloc_Form => return "BIPalloc"; + when BIP_Storage_Pool => + return "BIPstoragepool"; when BIP_Finalization_Master => return "BIPfinalizationmaster"; when BIP_Master => @@ -4638,11 +4653,12 @@ package body Exp_Ch6 is Alloc_Expr : Node_Id) return Node_Id is begin + pragma Assert (Is_Build_In_Place_Function (Func_Id)); + -- Processing for build-in-place object allocation. This is disabled -- on .NET/JVM because the targets do not support pools. if VM_Target = No_VM - and then Is_Build_In_Place_Function (Func_Id) and then Needs_Finalization (Ret_Typ) then declare @@ -5121,8 +5137,12 @@ package body Exp_Ch6 is Alloc_Obj_Id : Entity_Id; Alloc_Obj_Decl : Node_Id; Alloc_If_Stmt : Node_Id; - Heap_Allocator : Node_Id; SS_Allocator : Node_Id; + Heap_Allocator : Node_Id; + + Pool_Decl : Node_Id; + Pool_Allocator : Node_Id; + Pool_Id : constant Entity_Id := Make_Temporary (Loc, 'P'); begin -- Reuse the itype created for the function's implicit @@ -5216,6 +5236,25 @@ package body Exp_Ch6 is Set_No_Initialization (Heap_Allocator); end if; + -- The Pool_Allocator is just like the Heap_Allocator, + -- except we set Storage_Pool and Procedure_To_Call so it + -- will use the user-defined storage pool. + + Pool_Allocator := New_Copy_Tree (Heap_Allocator); + Pool_Decl := + Make_Object_Renaming_Declaration (Loc, + Defining_Identifier => Pool_Id, + Subtype_Mark => + New_Reference_To (RTE (RE_Root_Storage_Pool), Loc), + Name => + Make_Explicit_Dereference (Loc, + New_Reference_To + (Build_In_Place_Formal + (Par_Func, BIP_Storage_Pool), Loc))); + Set_Storage_Pool (Pool_Allocator, Pool_Id); + Set_Procedure_To_Call + (Pool_Allocator, RTE (RE_Allocate_Any)); + -- If the No_Allocators restriction is active, then only -- an allocator for secondary stack allocation is needed. -- It's OK for such allocators to have Comes_From_Source @@ -5225,22 +5264,25 @@ package body Exp_Ch6 is if Restriction_Active (No_Allocators) then SS_Allocator := Heap_Allocator; Heap_Allocator := Make_Null (Loc); + Pool_Allocator := Make_Null (Loc); - -- Otherwise the heap allocator may be needed, so we make - -- another allocator for secondary stack allocation. + -- Otherwise the heap and pool allocators may be needed, + -- so we make another allocator for secondary stack + -- allocation. else SS_Allocator := New_Copy_Tree (Heap_Allocator); - -- The heap allocator is marked Comes_From_Source - -- since it corresponds to an explicit user-written - -- allocator (that is, it will only be executed on - -- behalf of callers that call the function as - -- initialization for such an allocator). This - -- prevents errors when No_Implicit_Heap_Allocations - -- is in force. + -- The heap and pool allocators are marked + -- Comes_From_Source since they correspond to an + -- explicit user-written allocator (that is, it will + -- only be executed on behalf of callers that call the + -- function as initialization for such an + -- allocator). This prevents errors when + -- No_Implicit_Heap_Allocations is in force. Set_Comes_From_Source (Heap_Allocator, True); + Set_Comes_From_Source (Pool_Allocator, True); end if; -- The allocator is returned on the secondary stack. We @@ -5269,10 +5311,12 @@ package body Exp_Ch6 is -- Create an if statement to test the BIP_Alloc_Form -- formal and initialize the access object to either the - -- BIP_Object_Access formal (BIP_Alloc_Form = 0), the - -- result of allocating the object in the secondary stack - -- (BIP_Alloc_Form = 1), or else an allocator to create - -- the return object in the heap (BIP_Alloc_Form = 2). + -- BIP_Object_Access formal (BIP_Alloc_Form = + -- Caller_Allocation), the result of allocating the + -- object in the secondary stack (BIP_Alloc_Form = + -- Secondary_Stack), or else an allocator to create the + -- return object in the heap or user-defined pool + -- (BIP_Alloc_Form = Global_Heap or User_Storage_Pool). -- ??? An unchecked type conversion must be made in the -- case of assigning the access object formal to the @@ -5320,15 +5364,34 @@ package body Exp_Ch6 is Make_Assignment_Statement (Loc, Name => New_Reference_To (Alloc_Obj_Id, Loc), - Expression => SS_Allocator)))), + Expression => SS_Allocator))), + + Make_Elsif_Part (Loc, + Condition => + Make_Op_Eq (Loc, + Left_Opnd => + New_Reference_To (Obj_Alloc_Formal, Loc), + Right_Opnd => + Make_Integer_Literal (Loc, + UI_From_Int (BIP_Allocation_Form'Pos + (Global_Heap)))), + + Then_Statements => New_List ( + Build_Heap_Allocator + (Temp_Id => Alloc_Obj_Id, + Temp_Typ => Ref_Type, + Func_Id => Par_Func, + Ret_Typ => Return_Obj_Typ, + Alloc_Expr => Heap_Allocator)))), Else_Statements => New_List ( + Pool_Decl, Build_Heap_Allocator (Temp_Id => Alloc_Obj_Id, Temp_Typ => Ref_Type, Func_Id => Par_Func, Ret_Typ => Return_Obj_Typ, - Alloc_Expr => Heap_Allocator))); + Alloc_Expr => Pool_Allocator))); -- If a separate initialization assignment was created -- earlier, append that following the assignment of the @@ -7592,7 +7655,7 @@ package body Exp_Ch6 is -- called as a dispatching operation and must be treated similarly -- to functions with unconstrained result subtypes. - Add_Alloc_Form_Actual_To_Build_In_Place_Call + Add_Unconstrained_Actuals_To_Build_In_Place_Call (Func_Call, Function_Id, Alloc_Form => Caller_Allocation); Add_Finalization_Master_Actual_To_Build_In_Place_Call @@ -7623,11 +7686,29 @@ package body Exp_Ch6 is -- operations. ??? else - -- Pass an allocation parameter indicating that the function should - -- allocate its result on the heap. + -- No user-defined pool; pass an allocation parameter indicating that + -- the function should allocate its result on the heap. + + if No (Associated_Storage_Pool (Acc_Type)) then - Add_Alloc_Form_Actual_To_Build_In_Place_Call - (Func_Call, Function_Id, Alloc_Form => Global_Heap); + Add_Unconstrained_Actuals_To_Build_In_Place_Call + (Func_Call, Function_Id, Alloc_Form => Global_Heap); + + -- User-defined pool; pass an allocation parameter indicating that + -- the function should allocate its result in the pool, and pass the + -- pool. We need 'Unrestricted_Access here, because 'Access is + -- illegal, because the storage pool is not aliased. + + else + Add_Unconstrained_Actuals_To_Build_In_Place_Call + (Func_Call, Function_Id, Alloc_Form => User_Storage_Pool, + Pool_Actual => + Make_Attribute_Reference (Loc, + Prefix => + New_Reference_To + (Associated_Storage_Pool (Acc_Type), Loc), + Attribute_Name => Name_Unrestricted_Access)); + end if; Add_Finalization_Master_Actual_To_Build_In_Place_Call (Func_Call, Function_Id, Acc_Type); @@ -7796,7 +7877,7 @@ package body Exp_Ch6 is -- called as a dispatching operation and must be treated similarly -- to functions with unconstrained result subtypes. - Add_Alloc_Form_Actual_To_Build_In_Place_Call + Add_Unconstrained_Actuals_To_Build_In_Place_Call (Func_Call, Function_Id, Alloc_Form => Caller_Allocation); Add_Finalization_Master_Actual_To_Build_In_Place_Call @@ -7820,7 +7901,7 @@ package body Exp_Ch6 is -- Pass an allocation parameter indicating that the function should -- allocate its result on the secondary stack. - Add_Alloc_Form_Actual_To_Build_In_Place_Call + Add_Unconstrained_Actuals_To_Build_In_Place_Call (Func_Call, Function_Id, Alloc_Form => Secondary_Stack); Add_Finalization_Master_Actual_To_Build_In_Place_Call @@ -7898,7 +7979,7 @@ package body Exp_Ch6 is -- controlling result, because dispatching calls to the function needs -- to be treated effectively the same as calls to class-wide functions. - Add_Alloc_Form_Actual_To_Build_In_Place_Call + Add_Unconstrained_Actuals_To_Build_In_Place_Call (Func_Call, Func_Id, Alloc_Form => Caller_Allocation); Add_Finalization_Master_Actual_To_Build_In_Place_Call @@ -8047,19 +8128,23 @@ package body Exp_Ch6 is -- has an unconstrained or tagged result type). if Needs_BIP_Alloc_Form (Enclosing_Func) then - Add_Alloc_Form_Actual_To_Build_In_Place_Call + Add_Unconstrained_Actuals_To_Build_In_Place_Call (Func_Call, Function_Id, Alloc_Form_Exp => New_Reference_To (Build_In_Place_Formal (Enclosing_Func, BIP_Alloc_Form), + Loc), + Pool_Actual => + New_Reference_To + (Build_In_Place_Formal (Enclosing_Func, BIP_Storage_Pool), Loc)); -- Otherwise, if enclosing function has a constrained result subtype, -- then caller allocation will be used. else - Add_Alloc_Form_Actual_To_Build_In_Place_Call + Add_Unconstrained_Actuals_To_Build_In_Place_Call (Func_Call, Function_Id, Alloc_Form => Caller_Allocation); end if; @@ -8102,7 +8187,7 @@ package body Exp_Ch6 is -- called as a dispatching operation and must be treated similarly -- to functions with unconstrained result subtypes. - Add_Alloc_Form_Actual_To_Build_In_Place_Call + Add_Unconstrained_Actuals_To_Build_In_Place_Call (Func_Call, Function_Id, Alloc_Form => Caller_Allocation); -- In other unconstrained cases, pass an indication to do the allocation @@ -8111,7 +8196,7 @@ package body Exp_Ch6 is -- scope is established to ensure eventual cleanup of the result. else - Add_Alloc_Form_Actual_To_Build_In_Place_Call + Add_Unconstrained_Actuals_To_Build_In_Place_Call (Func_Call, Function_Id, Alloc_Form => Secondary_Stack); diff --git a/gcc/ada/exp_ch6.ads b/gcc/ada/exp_ch6.ads index 06145f525e0..8c278680a40 100644 --- a/gcc/ada/exp_ch6.ads +++ b/gcc/ada/exp_ch6.ads @@ -88,15 +88,20 @@ package Exp_Ch6 is type BIP_Formal_Kind is -- Ada 2005 (AI-318-02): This type defines the kinds of implicit extra - -- formals created for build-in-place functions. The order of the above + -- formals created for build-in-place functions. The order of these -- enumeration literals matches the order in which the formals are -- declared. See Sem_Ch6.Create_Extra_Formals. (BIP_Alloc_Form, - -- Present if result subtype is unconstrained, or if the result type - -- is tagged. Indicates whether the return object is allocated by the - -- caller or callee, and if the callee, whether to use the secondary - -- stack or the heap. See Create_Extra_Formals. + -- Present if result subtype is unconstrained or tagged. Indicates + -- whether the return object is allocated by the caller or callee, and + -- if the callee, whether to use the secondary stack or the heap. See + -- Create_Extra_Formals. + + BIP_Storage_Pool, + -- Present if result subtype is unconstrained or tagged. If + -- BIP_Alloc_Form = User_Storage_Pool, this is a pointer to the pool + -- (of type access to Root_Storage_Pool'Class). Otherwise null. BIP_Finalization_Master, -- Present if result type needs finalization. Pointer to caller's @@ -114,8 +119,7 @@ package Exp_Ch6 is -- the return object, or null if BIP_Alloc_Form indicates allocated by -- callee. -- - -- ??? We also need to be able to pass in some way to access a user- - -- defined storage pool at some point. And perhaps a constrained flag. + -- ??? We might also need to be able to pass in a constrained flag. function BIP_Formal_Suffix (Kind : BIP_Formal_Kind) return String; -- Ada 2005 (AI-318-02): Returns a string to be used as the suffix of names diff --git a/gcc/ada/rtsfind.ads b/gcc/ada/rtsfind.ads index 07bf0121a56..05247e036db 100644 --- a/gcc/ada/rtsfind.ads +++ b/gcc/ada/rtsfind.ads @@ -1346,6 +1346,7 @@ package Rtsfind is RE_Storage_Offset, -- System.Storage_Elements RE_To_Address, -- System.Storage_Elements + RE_Root_Storage_Pool_Ptr, -- System.Storage_Pools RE_Allocate_Any, -- System.Storage_Pools RE_Deallocate_Any, -- System.Storage_Pools RE_Root_Storage_Pool, -- System.Storage_Pools @@ -2542,6 +2543,7 @@ package Rtsfind is RE_Storage_Offset => System_Storage_Elements, RE_To_Address => System_Storage_Elements, + RE_Root_Storage_Pool_Ptr => System_Storage_Pools, RE_Allocate_Any => System_Storage_Pools, RE_Deallocate_Any => System_Storage_Pools, RE_Root_Storage_Pool => System_Storage_Pools, diff --git a/gcc/ada/s-stopoo.ads b/gcc/ada/s-stopoo.ads index 1c4d12754a0..e2d66ff747d 100644 --- a/gcc/ada/s-stopoo.ads +++ b/gcc/ada/s-stopoo.ads @@ -65,6 +65,14 @@ private type Root_Storage_Pool is abstract new Ada.Finalization.Limited_Controlled with null record; + type Root_Storage_Pool_Ptr is access all Root_Storage_Pool'Class; + for Root_Storage_Pool_Ptr'Storage_Size use 0; + -- Type of the BIP_Storage_Pool extra parameter (see Exp_Ch6). The + -- Storage_Size clause is necessary, because otherwise we have a + -- chicken&egg problem; we can't be creating collection finalization code + -- in this low-level package, because that involves Pool_Global, which + -- imports this package. + -- ??? Are these two still needed? It might be possible to use Subpools. -- Allocate_Any_Controlled / Deallocate_Any_Controlled for non-controlled -- objects. diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index 3c5e3f834fe..26dac7789d5 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -6482,6 +6482,15 @@ package body Sem_Ch6 is Add_Extra_Formal (E, Standard_Natural, E, BIP_Formal_Suffix (BIP_Alloc_Form)); + + -- Whenever we need BIP_Alloc_Form, we also need + -- BIP_Storage_Pool, in case BIP_Alloc_Form indicates to use a + -- user-defined pool. + + Discard := + Add_Extra_Formal + (E, RTE (RE_Root_Storage_Pool_Ptr), + E, BIP_Formal_Suffix (BIP_Storage_Pool)); end if; -- In the case of functions whose result type needs finalization,