Skip to content

R
riscv-gcc-1
Commit 200b7162 by Bob Duff Committed by Arnaud Charlet
Options

exp_ch6.ads (BIP_Storage_Pool): New "extra implicit parameter" that gets passed… 

exp_ch6.ads (BIP_Storage_Pool): New "extra implicit parameter" that gets passed in the same cases where...

2011-10-13  Bob Duff  <duff@adacore.com>

	* 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.

From-SVN: r179903
parent 9f8d1e5c
Showing with 193 additions and 59 deletions
gcc/ada/ChangeLog
2011-10-13 Bob Duff <duff@adacore.com>
* 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 <rybin@adacore.com>
* gnat_ugn.texi, vms_data.ads: Add an option to control enumeration
......
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;
......
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);
......
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
......
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,
......
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.
......
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,
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment