From 2fedcc18cb4a3c2dec2c658a975deb30cc821537 Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Mon, 4 May 2020 19:56:28 +0200 Subject: [PATCH] [Ada] Improve run-time performance for large initialized allocators gcc/ada/ * exp_aggr.adb (Aggr_Assignment_OK_For_Backend): Move to library level and use a new predicate Is_OK_Aggregate to recognize the aggregates suitable for direct assignment by the back-end. (Convert_Array_Aggr_In_Allocator): If neither in CodePeer mode nor generating C code, generate a direct assignment instead of further expanding if Aggr_Assignment_OK_For_Backend returns true. --- gcc/ada/exp_aggr.adb | 495 ++++++++++++++++++++++++------------------- 1 file changed, 273 insertions(+), 222 deletions(-) diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb index 95f0ddad990..6832d401eb6 100644 --- a/gcc/ada/exp_aggr.adb +++ b/gcc/ada/exp_aggr.adb @@ -246,6 +246,9 @@ package body Exp_Aggr is -- Local Subprograms for Array Aggregate Expansion -- ----------------------------------------------------- + function Aggr_Assignment_OK_For_Backend (N : Node_Id) return Boolean; + -- Returns true if an aggregate assignment can be done by the back end + function Aggr_Size_OK (N : Node_Id; Typ : Entity_Id) return Boolean; -- Very large static aggregates present problems to the back-end, and are -- transformed into assignments and loops. This function verifies that the @@ -343,6 +346,246 @@ package body Exp_Aggr is -- false if this transformation cannot be performed. THis is similar to, -- and reuses part of the machinery in Packed_Array_Aggregate_Handled. + ------------------------------------ + -- Aggr_Assignment_OK_For_Backend -- + ------------------------------------ + + -- Back-end processing by Gigi/gcc is possible only if all the following + -- conditions are met: + + -- 1. N consists of a single OTHERS choice, possibly recursively, or + -- of a single choice, possibly recursively, if it is surrounded by + -- a qualified expression whose subtype mark is unconstrained. + + -- 2. The array type has no null ranges (the purpose of this is to + -- avoid a bogus warning for an out-of-range value). + + -- 3. The array type has no atomic components + + -- 4. The component type is elementary + + -- 5. The component size is a multiple of Storage_Unit + + -- 6. The component size is Storage_Unit or the value is of the form + -- M * (1 + A**1 + A**2 + .. A**(K-1)) where A = 2**(Storage_Unit) + -- and M in 0 .. A-1. This can also be viewed as K occurrences of + -- the Storage_Unit value M, concatenated together. + + -- The ultimate goal is to generate a call to a fast memset routine + -- specifically optimized for the target. + + function Aggr_Assignment_OK_For_Backend (N : Node_Id) return Boolean is + Csiz : Uint := No_Uint; + Ctyp : Entity_Id; + Expr : Node_Id; + High : Node_Id; + Index : Entity_Id; + Low : Node_Id; + Nunits : Int; + Remainder : Uint; + Value : Uint; + + function Is_OK_Aggregate (Aggr : Node_Id) return Boolean; + -- Return true if Aggr is suitable for back-end assignment + + --------------------- + -- Is_OK_Aggregate -- + --------------------- + + function Is_OK_Aggregate (Aggr : Node_Id) return Boolean is + Assoc : constant List_Id := Component_Associations (Aggr); + + begin + -- An "others" aggregate is most likely OK, but see below + + if Is_Others_Aggregate (Aggr) then + null; + + -- An aggregate with a single choice requires a qualified expression + -- whose subtype mark is an unconstrained type because we need it to + -- have the semantics of an "others" aggregate. + + elsif Nkind (Parent (N)) = N_Qualified_Expression + and then not Is_Constrained (Entity (Subtype_Mark (Parent (N)))) + and then Is_Single_Aggregate (Aggr) + then + null; + + -- The other cases are not OK + + else + return False; + end if; + + -- In any case we do not support an iterated association + + return Nkind (First (Assoc)) /= N_Iterated_Component_Association; + end Is_OK_Aggregate; + + begin + -- Back end doesn't know about <> + + if Has_Default_Init_Comps (N) then + return False; + end if; + + -- Recurse as far as possible to find the innermost component type + + Ctyp := Etype (N); + Expr := N; + while Is_Array_Type (Ctyp) loop + if Nkind (Expr) /= N_Aggregate + or else not Is_OK_Aggregate (Expr) + then + return False; + end if; + + Index := First_Index (Ctyp); + while Present (Index) loop + Get_Index_Bounds (Index, Low, High); + + if Is_Null_Range (Low, High) then + return False; + end if; + + Next_Index (Index); + end loop; + + Expr := Expression (First (Component_Associations (Expr))); + + for J in 1 .. Number_Dimensions (Ctyp) - 1 loop + if Nkind (Expr) /= N_Aggregate + or else not Is_OK_Aggregate (Expr) + then + return False; + end if; + + Expr := Expression (First (Component_Associations (Expr))); + end loop; + + if Has_Atomic_Components (Ctyp) then + return False; + end if; + + Csiz := Component_Size (Ctyp); + Ctyp := Component_Type (Ctyp); + + if Is_Atomic_Or_VFA (Ctyp) then + return False; + end if; + end loop; + + -- Access types need to be dealt with specially + + if Is_Access_Type (Ctyp) then + + -- Component_Size is not set by Layout_Type if the component + -- type is an access type ??? + + Csiz := Esize (Ctyp); + + -- Fat pointers are rejected as they are not really elementary + -- for the backend. + + if Csiz /= System_Address_Size then + return False; + end if; + + -- The supported expressions are NULL and constants, others are + -- rejected upfront to avoid being analyzed below, which can be + -- problematic for some of them, for example allocators. + + if Nkind (Expr) /= N_Null and then not Is_Entity_Name (Expr) then + return False; + end if; + + -- Scalar types are OK if their size is a multiple of Storage_Unit + + elsif Is_Scalar_Type (Ctyp) then + pragma Assert (Csiz /= No_Uint); + + if Csiz mod System_Storage_Unit /= 0 then + return False; + end if; + + -- Composite types are rejected + + else + return False; + end if; + + -- If the expression has side effects (e.g. contains calls with + -- potential side effects) reject as well. We only preanalyze the + -- expression to prevent the removal of intended side effects. + + Preanalyze_And_Resolve (Expr, Ctyp); + + if not Side_Effect_Free (Expr) then + return False; + end if; + + -- The expression needs to be analyzed if True is returned + + Analyze_And_Resolve (Expr, Ctyp); + + -- Strip away any conversions from the expression as they simply + -- qualify the real expression. + + while Nkind_In (Expr, N_Unchecked_Type_Conversion, N_Type_Conversion) + loop + Expr := Expression (Expr); + end loop; + + Nunits := UI_To_Int (Csiz) / System_Storage_Unit; + + if Nunits = 1 then + return True; + end if; + + if not Compile_Time_Known_Value (Expr) then + return False; + end if; + + -- The only supported value for floating point is 0.0 + + if Is_Floating_Point_Type (Ctyp) then + return Expr_Value_R (Expr) = Ureal_0; + end if; + + -- For other types, we can look into the value as an integer, which + -- means the representation value for enumeration literals. + + Value := Expr_Rep_Value (Expr); + + if Has_Biased_Representation (Ctyp) then + Value := Value - Expr_Value (Type_Low_Bound (Ctyp)); + end if; + + -- Values 0 and -1 immediately satisfy the last check + + if Value = Uint_0 or else Value = Uint_Minus_1 then + return True; + end if; + + -- We need to work with an unsigned value + + if Value < 0 then + Value := Value + 2**(System_Storage_Unit * Nunits); + end if; + + Remainder := Value rem 2**System_Storage_Unit; + + for J in 1 .. Nunits - 1 loop + Value := Value / 2**System_Storage_Unit; + + if Value rem 2**System_Storage_Unit /= Remainder then + return False; + end if; + end loop; + + return True; + end Aggr_Assignment_OK_For_Backend; + ------------------ -- Aggr_Size_OK -- ------------------ @@ -4107,21 +4350,41 @@ package body Exp_Aggr is Aggr : Node_Id; Target : Node_Id) is - Aggr_Code : List_Id; Typ : constant Entity_Id := Etype (Aggr); Ctyp : constant Entity_Id := Component_Type (Typ); + Aggr_Code : List_Id; + New_Aggr : Node_Id; begin - -- The target is an explicit dereference of the allocated object. - -- Generate component assignments to it, as for an aggregate that - -- appears on the right-hand side of an assignment statement. + -- The target is an explicit dereference of the allocated object + + -- If the assignment can be done directly by the back end, then + -- reset Set_Expansion_Delayed and do not expand further. + + if not CodePeer_Mode + and then not Modify_Tree_For_C + and then Aggr_Assignment_OK_For_Backend (Aggr) + then + New_Aggr := New_Copy_Tree (Aggr); + Set_Expansion_Delayed (New_Aggr, False); + + Aggr_Code := + New_List ( + Make_OK_Assignment_Statement (Sloc (New_Aggr), + Name => Target, + Expression => New_Aggr)); + + -- Or else, generate component assignments to it, as for an aggregate + -- that appears on the right-hand side of an assignment statement. - Aggr_Code := - Build_Array_Aggr_Code (Aggr, - Ctype => Ctyp, - Index => First_Index (Typ), - Into => Target, - Scalar_Comp => Is_Scalar_Type (Ctyp)); + else + Aggr_Code := + Build_Array_Aggr_Code (Aggr, + Ctype => Ctyp, + Index => First_Index (Typ), + Into => Target, + Scalar_Comp => Is_Scalar_Type (Ctyp)); + end if; Insert_Actions_After (Decl, Aggr_Code); end Convert_Array_Aggr_In_Allocator; @@ -5299,9 +5562,6 @@ package body Exp_Aggr is -- If Others_Present (J) is True, then there is an others choice in one -- of the subaggregates of N at dimension J. - function Aggr_Assignment_OK_For_Backend (N : Node_Id) return Boolean; - -- Returns true if an aggregate assignment can be done by the back end - procedure Build_Constrained_Type (Positional : Boolean); -- If the subtype is not static or unconstrained, build a constrained -- type using the computable sizes of the aggregate and its sub- @@ -5333,215 +5593,6 @@ package body Exp_Aggr is -- built directly into the target of the assignment it must be free -- of side effects. - ------------------------------------ - -- Aggr_Assignment_OK_For_Backend -- - ------------------------------------ - - -- Backend processing by Gigi/gcc is possible only if all the following - -- conditions are met: - - -- 1. N consists of a single OTHERS choice, possibly recursively - - -- 2. The array type has no null ranges (the purpose of this is to - -- avoid a bogus warning for an out-of-range value). - - -- 3. The array type has no atomic components - - -- 4. The component type is elementary - - -- 5. The component size is a multiple of Storage_Unit - - -- 6. The component size is Storage_Unit or the value is of the form - -- M * (1 + A**1 + A**2 + .. A**(K-1)) where A = 2**(Storage_Unit) - -- and M in 1 .. A-1. This can also be viewed as K occurrences of - -- the 8-bit value M, concatenated together. - - -- The ultimate goal is to generate a call to a fast memset routine - -- specifically optimized for the target. - - function Aggr_Assignment_OK_For_Backend (N : Node_Id) return Boolean is - Csiz : Uint := No_Uint; - Ctyp : Entity_Id; - Expr : Node_Id; - High : Node_Id; - Index : Entity_Id; - Low : Node_Id; - Nunits : Int; - Remainder : Uint; - Value : Uint; - - begin - -- Back end doesn't know about <> - - if Has_Default_Init_Comps (N) then - return False; - end if; - - -- Recurse as far as possible to find the innermost component type - - Ctyp := Etype (N); - Expr := N; - while Is_Array_Type (Ctyp) loop - if Nkind (Expr) /= N_Aggregate - or else not Is_Others_Aggregate (Expr) - then - return False; - end if; - - Index := First_Index (Ctyp); - while Present (Index) loop - Get_Index_Bounds (Index, Low, High); - - if Is_Null_Range (Low, High) then - return False; - end if; - - Next_Index (Index); - end loop; - - Expr := Expression (First (Component_Associations (Expr))); - - for J in 1 .. Number_Dimensions (Ctyp) - 1 loop - if Nkind (Expr) /= N_Aggregate - or else not Is_Others_Aggregate (Expr) - then - return False; - end if; - - Expr := Expression (First (Component_Associations (Expr))); - end loop; - - if Has_Atomic_Components (Ctyp) then - return False; - end if; - - Csiz := Component_Size (Ctyp); - Ctyp := Component_Type (Ctyp); - - if Is_Atomic_Or_VFA (Ctyp) then - return False; - end if; - end loop; - - -- An Iterated_Component_Association involves a loop (in most cases) - -- and is never static. - - if Nkind (Parent (Expr)) = N_Iterated_Component_Association then - return False; - end if; - - -- Access types need to be dealt with specially - - if Is_Access_Type (Ctyp) then - - -- Component_Size is not set by Layout_Type if the component - -- type is an access type ??? - - Csiz := Esize (Ctyp); - - -- Fat pointers are rejected as they are not really elementary - -- for the backend. - - if Csiz /= System_Address_Size then - return False; - end if; - - -- The supported expressions are NULL and constants, others are - -- rejected upfront to avoid being analyzed below, which can be - -- problematic for some of them, for example allocators. - - if Nkind (Expr) /= N_Null and then not Is_Entity_Name (Expr) then - return False; - end if; - - -- Scalar types are OK if their size is a multiple of Storage_Unit - - elsif Is_Scalar_Type (Ctyp) then - pragma Assert (Csiz /= No_Uint); - - if Csiz mod System_Storage_Unit /= 0 then - return False; - end if; - - -- Composite types are rejected - - else - return False; - end if; - - -- If the expression has side effects (e.g. contains calls with - -- potential side effects) reject as well. We only preanalyze the - -- expression to prevent the removal of intended side effects. - - Preanalyze_And_Resolve (Expr, Ctyp); - - if not Side_Effect_Free (Expr) then - return False; - end if; - - -- The expression needs to be analyzed if True is returned - - Analyze_And_Resolve (Expr, Ctyp); - - -- Strip away any conversions from the expression as they simply - -- qualify the real expression. - - while Nkind_In (Expr, N_Unchecked_Type_Conversion, - N_Type_Conversion) - loop - Expr := Expression (Expr); - end loop; - - Nunits := UI_To_Int (Csiz) / System_Storage_Unit; - - if Nunits = 1 then - return True; - end if; - - if not Compile_Time_Known_Value (Expr) then - return False; - end if; - - -- The only supported value for floating point is 0.0 - - if Is_Floating_Point_Type (Ctyp) then - return Expr_Value_R (Expr) = Ureal_0; - end if; - - -- For other types, we can look into the value as an integer, which - -- means the representation value for enumeration literals. - - Value := Expr_Rep_Value (Expr); - - if Has_Biased_Representation (Ctyp) then - Value := Value - Expr_Value (Type_Low_Bound (Ctyp)); - end if; - - -- Values 0 and -1 immediately satisfy the last check - - if Value = Uint_0 or else Value = Uint_Minus_1 then - return True; - end if; - - -- We need to work with an unsigned value - - if Value < 0 then - Value := Value + 2**(System_Storage_Unit * Nunits); - end if; - - Remainder := Value rem 2**System_Storage_Unit; - - for J in 1 .. Nunits - 1 loop - Value := Value / 2**System_Storage_Unit; - - if Value rem 2**System_Storage_Unit /= Remainder then - return False; - end if; - end loop; - - return True; - end Aggr_Assignment_OK_For_Backend; - ---------------------------- -- Build_Constrained_Type -- ---------------------------- -- 2.30.2