From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: by sourceware.org (Postfix, from userid 7871) id 1DFFE385840E; Thu, 5 Jan 2023 14:38:15 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 1DFFE385840E DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gcc.gnu.org; s=default; t=1672929495; bh=2b5qyloK4N5q0Qp3EtjQLT+y8VQdaXYog64sDvdF4Cs=; h=From:To:Subject:Date:From; b=k0sw0+furEYUa91G2KuQsl+aFhF+rtYGWc5+z6haSOugHJzdfw4J3NDLh+kbta6y8 c43DHjIN9/6oyFVYobWaIzAkixfhsROx+NqagOA/ca+FUY5LiwswETuoCx2J4HlvpY 4Z40ZYR9VeERtqNTeeeTFOmEgYpwsbharSjYDoZQ= MIME-Version: 1.0 Content-Transfer-Encoding: 7bit Content-Type: text/plain; charset="utf-8" From: Marc Poulhi?s To: gcc-cvs@gcc.gnu.org Subject: [gcc r13-5014] ada: Revert to constrained allocation for string concatenation X-Act-Checkin: gcc X-Git-Author: Eric Botcazou X-Git-Refname: refs/heads/master X-Git-Oldrev: 0776fec1557f60e256cd18a5456ee5ad04cf4262 X-Git-Newrev: 8313c5f600fe935d00b4ff52539e01df67af928d Message-Id: <20230105143815.1DFFE385840E@sourceware.org> Date: Thu, 5 Jan 2023 14:38:15 +0000 (GMT) List-Id: https://gcc.gnu.org/g:8313c5f600fe935d00b4ff52539e01df67af928d commit r13-5014-g8313c5f600fe935d00b4ff52539e01df67af928d Author: Eric Botcazou Date: Thu Dec 15 14:47:44 2022 +0100 ada: Revert to constrained allocation for string concatenation Using an unconstrained allocation is less efficient in the general case. gcc/ada/ * exp_ch3.adb (Expand_N_Object_Declaration): New local variable used throughout instead of testing Is_Special_Return_Object every time. Do not rename an OK_To_Rename object for a special return object. * exp_ch4.adb (Expand_Concatenate): Revert to constrained allocation if the result is allocated on the secondary stack. Diff: --- gcc/ada/exp_ch3.adb | 29 ++++++++++--------- gcc/ada/exp_ch4.adb | 82 ++++++++++++++++++++++------------------------------- 2 files changed, 50 insertions(+), 61 deletions(-) diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb index 7dbf82671aa..a76acf34d66 100644 --- a/gcc/ada/exp_ch3.adb +++ b/gcc/ada/exp_ch3.adb @@ -6230,6 +6230,11 @@ package body Exp_Ch3 is Base_Typ : constant Entity_Id := Base_Type (Typ); Next_N : constant Node_Id := Next (N); + Special_Ret_Obj : constant Boolean := Is_Special_Return_Object (Def_Id); + -- If this is a special return object, it will be allocated differently + -- and ultimately rewritten as a renaming, so initialization activities + -- need to be deferred until after that is done. + function Build_Equivalent_Aggregate return Boolean; -- If the object has a constrained discriminated type and no initial -- value, it may be possible to build an equivalent aggregate instead, @@ -7343,7 +7348,7 @@ package body Exp_Ch3 is end if; end if; - if not Is_Special_Return_Object (Def_Id) then + if not Special_Ret_Obj then Default_Initialize_Object (Init_After); end if; @@ -7403,7 +7408,7 @@ package body Exp_Ch3 is Expander_Mode_Restore; end if; - if not Is_Special_Return_Object (Def_Id) then + if not Special_Ret_Obj then Convert_Aggr_In_Object_Decl (N); end if; @@ -7479,7 +7484,7 @@ package body Exp_Ch3 is -- case, the expansion of the return statement will take care of -- creating the object (via allocator) and initializing it. - if Is_Special_Return_Object (Def_Id) then + if Special_Ret_Obj then -- If the type needs finalization and is not inherently -- limited, then the target is adjusted after the copy @@ -7791,7 +7796,7 @@ package body Exp_Ch3 is if Present (Tag_Assign) then if Present (Following_Address_Clause (N)) then Ensure_Freeze_Node (Def_Id); - elsif not Is_Special_Return_Object (Def_Id) then + elsif not Special_Ret_Obj then Insert_Action_After (Init_After, Tag_Assign); end if; @@ -7931,7 +7936,7 @@ package body Exp_Ch3 is and then ((not Is_Library_Level_Entity (Def_Id) and then Is_Captured_Function_Call (Expr_Q) - and then (not Is_Special_Return_Object (Def_Id) + and then (not Special_Ret_Obj or else Is_Related_To_Func_Return (Entity (Prefix (Expr_Q)))) and then not Is_Class_Wide_Type (Typ)) @@ -7945,12 +7950,14 @@ package body Exp_Ch3 is -- Obj : Typ renames Expr; - or else OK_To_Rename_Ref (Expr_Q) + or else (OK_To_Rename_Ref (Expr_Q) + and then not Special_Ret_Obj) -- Likewise if it is a slice of such a variable or else (Nkind (Expr_Q) = N_Slice - and then OK_To_Rename_Ref (Prefix (Expr_Q)))); + and then OK_To_Rename_Ref (Prefix (Expr_Q)) + and then not Special_Ret_Obj)); -- If the type needs finalization and is not inherently limited, -- then the target is adjusted after the copy and attached to the @@ -7971,9 +7978,7 @@ package body Exp_Ch3 is Obj_Ref => New_Occurrence_Of (Def_Id, Loc), Typ => Base_Typ); - if Present (Adj_Call) - and then not Is_Special_Return_Object (Def_Id) - then + if Present (Adj_Call) and then not Special_Ret_Obj then Insert_Action_After (Init_After, Adj_Call); end if; end if; @@ -8601,9 +8606,7 @@ package body Exp_Ch3 is end; end if; - if Is_Special_Return_Object (Def_Id) - and then Present (Tag_Assign) - then + if Special_Ret_Obj and then Present (Tag_Assign) then Insert_Action_After (Init_After, Tag_Assign); end if; diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index 148b160b792..d9103b3387b 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -2728,7 +2728,6 @@ package body Exp_Ch4 is Len : Unat; J : Nat; Clen : Node_Id; - Decl : Node_Id; Set : Boolean; -- Start of processing for Expand_Concatenate @@ -3255,32 +3254,10 @@ package body Exp_Ch4 is Set_Is_Internal (Ent); Set_Debug_Info_Needed (Ent); - -- If the bound is statically known to be out of range, we do not want - -- to abort, we want a warning and a constraint error at run time. Note - -- that we have arranged that the result will not be treated as a static - -- constant, so we won't get an illegality during the insertion. We also - -- enable all checks (in particular range checks) in case the bounds of - -- Subtyp_Ind are out of range. - - Decl := - Make_Object_Declaration (Loc, - Defining_Identifier => Ent, - Object_Definition => Subtyp_Ind); - Insert_Action (Cnode, Decl); - - -- If the result of the concatenation appears as the initializing - -- expression of an object declaration, we can just rename the - -- result, rather than copying it. - - Set_OK_To_Rename (Ent); - -- If we are concatenating strings and the current scope already uses -- the secondary stack, allocate the result also on the secondary stack -- to avoid putting too much pressure on the primary stack. - -- We use an unconstrained allocation, i.e. we also allocate the bounds, - -- so that the result can be renamed in all contexts. - -- Don't do this if -gnatd.h is set, as this will break the wrapping of -- Cnode in an Expression_With_Actions, see Expand_N_Op_Concat. @@ -3291,33 +3268,32 @@ package body Exp_Ch4 is then -- Generate: -- subtype Axx is String ( .. ) - -- type Ayy is access String; + -- type Ayy is access Axx; -- Rxx : Ayy := new [storage_pool = ss_pool]; - -- Sxx : String renames Rxx.all; + -- Sxx : Axx renames Rxx.all; declare ConstrT : constant Entity_Id := Make_Temporary (Loc, 'A'); Acc_Typ : constant Entity_Id := Make_Temporary (Loc, 'A'); - Alloc : Node_Id; - Deref : Node_Id; - Temp : Entity_Id; + Alloc : Node_Id; + Temp : Entity_Id; begin - Insert_Action (Decl, + Insert_Action (Cnode, Make_Subtype_Declaration (Loc, Defining_Identifier => ConstrT, Subtype_Indication => Subtyp_Ind), Suppress => All_Checks); - Freeze_Itype (ConstrT, Decl); + Freeze_Itype (ConstrT, Cnode); - Insert_Action (Decl, + Insert_Action (Cnode, Make_Full_Type_Declaration (Loc, Defining_Identifier => Acc_Typ, Type_Definition => Make_Access_To_Object_Definition (Loc, - Subtype_Indication => New_Occurrence_Of (Atyp, Loc))), + Subtype_Indication => New_Occurrence_Of (ConstrT, Loc))), Suppress => All_Checks); Mutate_Ekind (Acc_Typ, E_Access_Type); @@ -3335,33 +3311,43 @@ package body Exp_Ch4 is Set_No_Initialization (Alloc); Temp := Make_Temporary (Loc, 'R', Alloc); - Insert_Action (Decl, + Insert_Action (Cnode, Make_Object_Declaration (Loc, Defining_Identifier => Temp, Object_Definition => New_Occurrence_Of (Acc_Typ, Loc), Expression => Alloc), Suppress => All_Checks); - Deref := - Make_Explicit_Dereference (Loc, - Prefix => New_Occurrence_Of (Temp, Loc)); - Set_Etype (Deref, Atyp); - - Rewrite (Decl, + Insert_Action (Cnode, Make_Object_Renaming_Declaration (Loc, Defining_Identifier => Ent, - Subtype_Mark => New_Occurrence_Of (Atyp, Loc), - Name => Deref)); - - -- We do not analyze this renaming declaration because this would - -- change the subtype of Ent back to a constrained string. - - Set_Etype (Ent, Atyp); - Set_Renamed_Object (Ent, Deref); - Set_Analyzed (Decl); + Subtype_Mark => New_Occurrence_Of (ConstrT, Loc), + Name => + Make_Explicit_Dereference (Loc, + Prefix => New_Occurrence_Of (Temp, Loc))), + Suppress => All_Checks); end; + + else + -- If the bound is statically known to be out of range, we do not + -- want to abort, we want a warning and a runtime constraint error. + -- Note that we have arranged that the result will not be treated + -- as a static constant, so we won't get an illegality during this + -- insertion. We also enable checks (in particular range checks) in + -- case the bounds of Subtyp_Ind are out of range. + + Insert_Action (Cnode, + Make_Object_Declaration (Loc, + Defining_Identifier => Ent, + Object_Definition => Subtyp_Ind)); end if; + -- If the result of the concatenation appears as the initializing + -- expression of an object declaration, we can just rename the + -- result, rather than copying it. + + Set_OK_To_Rename (Ent); + -- Catch the static out of range case now if Raises_Constraint_Error (High_Bound)