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

[Ada] Improve speed of discriminated return types

Browse Source 
The compiler now generates faster code for functions that return
discriminated types in many cases where the size is known at compile
time.

2019-08-20  Bob Duff  <duff@adacore.com>

gcc/ada/

	* exp_ch6.adb (Needs_BIP_Alloc_Form): Call
	Requires_Transient_Scope rather than checking constrainedness
	and so forth.  We have previously improved
	Requires_Transient_Scope to return False in various cases,
	notably a limited record with an access discriminant. This
	change takes advantage of that to avoid using the secondary
	stack for functions returning such types.
	(Make_Build_In_Place_Call_In_Allocator): Be consistent by
	calling Needs_BIP_Alloc_Form rather than Is_Constrained and so
	forth.
	* sem_ch4.adb (Analyze_Allocator): The above change causes the
	compiler to generate code that is not legal Ada, in particular
	an uninitialized allocator for indefinite subtype.  This is
	harmless, so we suppress the error message in this case.

From-SVN: r274738
This commit is contained in:
Bob Duff 2019-08-20 09:50:19 +00:00 committed by Pierre-Marie de Rodat
parent 31fde973e5
commit cf0e5ca723
3 changed files with 103 additions and 71 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
gcc/ada/ChangeLog
View File

@ -1,3 +1,20 @@
2019-08-20 Bob Duff <duff@adacore.com>
* exp_ch6.adb (Needs_BIP_Alloc_Form): Call
Requires_Transient_Scope rather than checking constrainedness
and so forth. We have previously improved
Requires_Transient_Scope to return False in various cases,
notably a limited record with an access discriminant. This
change takes advantage of that to avoid using the secondary
stack for functions returning such types.
(Make_Build_In_Place_Call_In_Allocator): Be consistent by
calling Needs_BIP_Alloc_Form rather than Is_Constrained and so
forth.
* sem_ch4.adb (Analyze_Allocator): The above change causes the
compiler to generate code that is not legal Ada, in particular
an uninitialized allocator for indefinite subtype. This is
harmless, so we suppress the error message in this case.
2019-08-20 Gary Dismukes <dismukes@adacore.com> 2019-08-20 Gary Dismukes <dismukes@adacore.com>
* ali.adb, ali.ads, aspects.adb, checks.ads, checks.adb, * ali.adb, ali.ads, aspects.adb, checks.ads, checks.adb,

109
gcc/ada/exp_ch6.adb
View File

@ -5615,7 +5615,23 @@ package body Exp_Ch6 is
Set_Comes_From_Extended_Return_Statement (Return_Stmt); Set_Comes_From_Extended_Return_Statement (Return_Stmt);
Rewrite (N, Result); Rewrite (N, Result);
Analyze (N, Suppress => All_Checks);
declare
T : constant Entity_Id := Etype (Ret_Obj_Id);
begin
Analyze (N, Suppress => All_Checks);
-- In some cases, analysis of N can set the Etype of an N_Identifier
-- to a subtype of the Etype of the Entity of the N_Identifier, which
-- gigi doesn't like. Reset the Etypes correctly here.
if Nkind (Expression (Return_Stmt)) = N_Identifier
and then Entity (Expression (Return_Stmt)) = Ret_Obj_Id
then
Set_Etype (Ret_Obj_Id, T);
Set_Etype (Expression (Return_Stmt), T);
end if;
end;
end Expand_N_Extended_Return_Statement; end Expand_N_Extended_Return_Statement;
---------------------------- ----------------------------
@ -8108,13 +8124,41 @@ package body Exp_Ch6 is
-- since it is already attached on the related finalization master. -- since it is already attached on the related finalization master.
-- Here and in related routines, we must examine the full view of the -- Here and in related routines, we must examine the full view of the
-- type, because the view at the point of call may differ from that -- type, because the view at the point of call may differ from the
-- that in the function body, and the expansion mechanism depends on -- one in the function body, and the expansion mechanism depends on
-- the characteristics of the full view. -- the characteristics of the full view.
if Is_Constrained (Underlying_Type (Result_Subt)) if Needs_BIP_Alloc_Form (Function_Id) then
and then not Needs_Finalization (Underlying_Type (Result_Subt)) Temp_Init := Empty;
then
-- Case of a user-defined storage pool. Pass an allocation parameter
-- indicating that the function should allocate its result in the
-- pool, and pass the pool. Use 'Unrestricted_Access because the
-- pool may not be aliased.
if Present (Associated_Storage_Pool (Acc_Type)) then
Alloc_Form := User_Storage_Pool;
Pool :=
Make_Attribute_Reference (Loc,
Prefix =>
New_Occurrence_Of
(Associated_Storage_Pool (Acc_Type), Loc),
Attribute_Name => Name_Unrestricted_Access);
-- No user-defined pool; pass an allocation parameter indicating that
-- the function should allocate its result on the heap.
else
Alloc_Form := Global_Heap;
Pool := Make_Null (No_Location);
end if;
-- The caller does not provide the return object in this case, so we
-- have to pass null for the object access actual.
Return_Obj_Actual := Empty;
else
-- Replace the initialized allocator of form "new T'(Func (...))" -- Replace the initialized allocator of form "new T'(Func (...))"
-- with an uninitialized allocator of form "new T", where T is the -- with an uninitialized allocator of form "new T", where T is the
-- result subtype of the called function. The call to the function -- result subtype of the called function. The call to the function
@ -8163,35 +8207,6 @@ package body Exp_Ch6 is
-- perform the allocation of the return object, so we pass parameters -- perform the allocation of the return object, so we pass parameters
-- indicating that. -- indicating that.
else
Temp_Init := Empty;
-- Case of a user-defined storage pool. Pass an allocation parameter
-- indicating that the function should allocate its result in the
-- pool, and pass the pool. Use 'Unrestricted_Access because the
-- pool may not be aliased.
if Present (Associated_Storage_Pool (Acc_Type)) then
Alloc_Form := User_Storage_Pool;
Pool :=
Make_Attribute_Reference (Loc,
Prefix =>
New_Occurrence_Of
(Associated_Storage_Pool (Acc_Type), Loc),
Attribute_Name => Name_Unrestricted_Access);
-- No user-defined pool; pass an allocation parameter indicating that
-- the function should allocate its result on the heap.
else
Alloc_Form := Global_Heap;
Pool := Make_Null (No_Location);
end if;
-- The caller does not provide the return object in this case, so we
-- have to pass null for the object access actual.
Return_Obj_Actual := Empty;
end if; end if;
-- Declare the temp object -- Declare the temp object
@ -9279,30 +9294,8 @@ package body Exp_Ch6 is
function Needs_BIP_Alloc_Form (Func_Id : Entity_Id) return Boolean is function Needs_BIP_Alloc_Form (Func_Id : Entity_Id) return Boolean is
pragma Assert (Is_Build_In_Place_Function (Func_Id)); pragma Assert (Is_Build_In_Place_Function (Func_Id));
Func_Typ : constant Entity_Id := Underlying_Type (Etype (Func_Id)); Func_Typ : constant Entity_Id := Underlying_Type (Etype (Func_Id));
begin begin
-- A build-in-place function needs to know which allocation form to return Requires_Transient_Scope (Func_Typ);
-- use when:
--
-- 1) The result subtype is unconstrained. In this case, depending on
-- the context of the call, the object may need to be created in the
-- secondary stack, the heap, or a user-defined storage pool.
--
-- 2) The result subtype is tagged. In this case the function call may
-- dispatch on result and thus needs to be treated in the same way as
-- calls to functions with class-wide results, because a callee that
-- can be dispatched to may have any of various result subtypes, so
-- if any of the possible callees would require an allocation form to
-- be passed then they all do.
--
-- 3) The result subtype needs finalization actions. In this case, based
-- on the context of the call, the object may need to be created at
-- the caller site, in the heap, or in a user-defined storage pool.
return
not Is_Constrained (Func_Typ)
or else Is_Tagged_Type (Func_Typ)
or else Needs_Finalization (Func_Typ);
end Needs_BIP_Alloc_Form; end Needs_BIP_Alloc_Form;
-------------------------------------- --------------------------------------

48
gcc/ada/sem_ch4.adb
View File

@ -796,25 +796,47 @@ package body Sem_Ch4 is
("\constraint with discriminant values required", N); ("\constraint with discriminant values required", N);
end if; end if;
-- Limited Ada 2005 and general nonlimited case -- Limited Ada 2005 and general nonlimited case.
-- This is an error, except in the case of an
-- uninitialized allocator that is generated
-- for a build-in-place function return of a
-- discriminated but compile-time-known-size
-- type.
else else
Error_Msg_N if Original_Node (N) /= N
("uninitialized unconstrained allocation not " and then Nkind (Original_Node (N)) = N_Allocator
& "allowed", N); then
declare
Qual : constant Node_Id :=
Expression (Original_Node (N));
pragma Assert
(Nkind (Qual) = N_Qualified_Expression);
Call : constant Node_Id := Expression (Qual);
pragma Assert
(Is_Expanded_Build_In_Place_Call (Call));
begin
null;
end;
if Is_Array_Type (Type_Id) then else
Error_Msg_N Error_Msg_N
("\qualified expression or constraint with " ("uninitialized unconstrained allocation not "
& "array bounds required", N); & "allowed", N);
elsif Has_Unknown_Discriminants (Type_Id) then if Is_Array_Type (Type_Id) then
Error_Msg_N ("\qualified expression required", N); Error_Msg_N
("\qualified expression or constraint with "
& "array bounds required", N);
else pragma Assert (Has_Discriminants (Type_Id)); elsif Has_Unknown_Discriminants (Type_Id) then
Error_Msg_N Error_Msg_N ("\qualified expression required", N);
("\qualified expression or constraint with "
& "discriminant values required", N); else pragma Assert (Has_Discriminants (Type_Id));
Error_Msg_N
("\qualified expression or constraint with "
& "discriminant values required", N);
end if;
end if; end if;
end if; end if;
end if; end if;