From: Eric Botcazou Date: Fri, 10 Apr 2020 21:03:18 +0000 (+0200) Subject: [Ada] Optimize length checks generated for slice assignments X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=ac8806c4c5dad67648be37fda737a664961c1cf1;p=gcc.git [Ada] Optimize length checks generated for slice assignments 2020-06-17 Eric Botcazou gcc/ada/ * exp_attr.adb (Expand_N_Attribute_Reference) : Replace it with a direct reference to an entity which is not a discriminant for constrained array types. Add same condition for scalar types. : Merge with above implementation. * exp_ch4.adb (Optimize_Length_Comparison): Be prepared for a second entity whose length is compared. Rename Prepare_64 to Convert_To_Long_Long_Integer. If the second entity is present, compute the difference of the 'First attributes and compare the sum of 'Last of the second entity with this difference against 'Last of the first entity. Add a special case when the 'First attributes are equal. Suppress overflow checks in all cases. --- diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb index d31f61dcb8c..51cda8299ec 100644 --- a/gcc/ada/exp_attr.adb +++ b/gcc/ada/exp_attr.adb @@ -3398,42 +3398,75 @@ package body Exp_Attr is Analyze_And_Resolve (N, Typ); end Finalization_Size; - ----------- - -- First -- - ----------- - - when Attribute_First => + ----------------- + -- First, Last -- + ----------------- + when Attribute_First + | Attribute_Last + => -- If the prefix type is a constrained packed array type which -- already has a Packed_Array_Impl_Type representation defined, then - -- replace this attribute with a direct reference to 'First of the - -- appropriate index subtype (since otherwise the back end will try - -- to give us the value of 'First for this implementation type). + -- replace this attribute with a direct reference to the attribute of + -- the appropriate index subtype (since otherwise the back end will + -- try to give us the value of 'First for this implementation type). if Is_Constrained_Packed_Array (Ptyp) then Rewrite (N, Make_Attribute_Reference (Loc, - Attribute_Name => Name_First, + Attribute_Name => Attribute_Name (N), Prefix => New_Occurrence_Of (Get_Index_Subtype (N), Loc))); Analyze_And_Resolve (N, Typ); + -- For a constrained array type, if the bound is a reference to an + -- entity which is not a discriminant, just replace with a direct + -- reference. Note that this must be in keeping with what is done + -- for scalar types in order for range checks to be elided in loops. + + elsif Is_Array_Type (Ptyp) and then Is_Constrained (Ptyp) then + declare + Bnd : Node_Id; + + begin + if Id = Attribute_First then + Bnd := Type_Low_Bound (Get_Index_Subtype (N)); + else + Bnd := Type_High_Bound (Get_Index_Subtype (N)); + end if; + + if Is_Entity_Name (Bnd) + and then Ekind (Entity (Bnd)) /= E_Discriminant + then + Rewrite (N, New_Occurrence_Of (Entity (Bnd), Loc)); + end if; + end; + -- For access type, apply access check as needed elsif Is_Access_Type (Ptyp) then Apply_Access_Check (N); - -- For scalar type, if low bound is a reference to an entity, just + -- For scalar type, if the bound is a reference to an entity, just -- replace with a direct reference. Note that we can only have a -- reference to a constant entity at this stage, anything else would -- have already been rewritten. elsif Is_Scalar_Type (Ptyp) then declare - Lo : constant Node_Id := Type_Low_Bound (Ptyp); + Bnd : Node_Id; + begin - if Is_Entity_Name (Lo) then - Rewrite (N, New_Occurrence_Of (Entity (Lo), Loc)); + if Id = Attribute_First then + Bnd := Type_Low_Bound (Ptyp); + else + Bnd := Type_High_Bound (Ptyp); + end if; + + if Is_Entity_Name (Bnd) + and then Ekind (Entity (Bnd)) /= E_Discriminant + then + Rewrite (N, New_Occurrence_Of (Entity (Bnd), Loc)); end if; end; end if; @@ -4103,45 +4136,6 @@ package body Exp_Attr is Analyze_And_Resolve (N); - ---------- - -- Last -- - ---------- - - when Attribute_Last => - - -- If the prefix type is a constrained packed array type which - -- already has a Packed_Array_Impl_Type representation defined, then - -- replace this attribute with a direct reference to 'Last of the - -- appropriate index subtype (since otherwise the back end will try - -- to give us the value of 'Last for this implementation type). - - if Is_Constrained_Packed_Array (Ptyp) then - Rewrite (N, - Make_Attribute_Reference (Loc, - Attribute_Name => Name_Last, - Prefix => New_Occurrence_Of (Get_Index_Subtype (N), Loc))); - Analyze_And_Resolve (N, Typ); - - -- For access type, apply access check as needed - - elsif Is_Access_Type (Ptyp) then - Apply_Access_Check (N); - - -- For scalar type, if high bound is a reference to an entity, just - -- replace with a direct reference. Note that we can only have a - -- reference to a constant entity at this stage, anything else would - -- have already been rewritten. - - elsif Is_Scalar_Type (Ptyp) then - declare - Hi : constant Node_Id := Type_High_Bound (Ptyp); - begin - if Is_Entity_Name (Hi) then - Rewrite (N, New_Occurrence_Of (Entity (Hi), Loc)); - end if; - end; - end if; - -------------- -- Last_Bit -- -------------- diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index aeb41c97fe6..42979975721 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -226,9 +226,10 @@ package body Exp_Ch4 is procedure Optimize_Length_Comparison (N : Node_Id); -- Given an expression, if it is of the form X'Length op N (or the other - -- way round), where N is known at compile time to be 0 or 1, and X is a - -- simple entity, and op is a comparison operator, optimizes it into a - -- comparison of First and Last. + -- way round), where N is known at compile time to be 0 or 1, or something + -- else where the value is known to be positive and in the 32-bit range, + -- and X is a simple entity, and op is a comparison operator, optimizes it + -- into a comparison of X'First and X'Last. procedure Process_If_Case_Statements (N : Node_Id; Stmts : List_Id); -- Inspect and process statement list Stmt of if or case expression N for @@ -13783,58 +13784,65 @@ package body Exp_Ch4 is Comp : Node_Id; -- Comparison operand, set only if Is_Zero is false - Ent : Entity_Id := Empty; - -- Entity whose length is being compared + Ent : array (Pos range 1 .. 2) of Entity_Id := (Empty, Empty); + -- Entities whose length is being compared - Index : Node_Id := Empty; - -- Integer_Literal node for length attribute expression, or Empty + Index : array (Pos range 1 .. 2) of Node_Id := (Empty, Empty); + -- Integer_Literal nodes for length attribute expressions, or Empty -- if there is no such expression present. - Ityp : Entity_Id; - -- Type of array index to which 'Length is applied - Op : Node_Kind := Nkind (N); -- Kind of comparison operator, gets flipped if operands backwards + function Convert_To_Long_Long_Integer (N : Node_Id) return Node_Id; + -- Given a discrete expression, returns a Long_Long_Integer typed + -- expression representing the underlying value of the expression. + -- This is done with an unchecked conversion to Long_Long_Integer. + -- We use unchecked conversion to handle the enumeration type case. + function Is_Optimizable (N : Node_Id) return Boolean; -- Tests N to see if it is an optimizable comparison value (defined as -- constant zero or one, or something else where the value is known to - -- be positive and in the range of 32-bits, and where the corresponding - -- Length value is also known to be 32-bits. If result is true, sets - -- Is_Zero, Ityp, and Comp accordingly. + -- be positive and in the range of 32 bits and where the corresponding + -- Length value is also known to be 32 bits). If result is true, sets + -- Is_Zero and Comp accordingly. - function Is_Entity_Length (N : Node_Id) return Boolean; + function Is_Entity_Length (N : Node_Id; Num : Pos) return Boolean; -- Tests if N is a length attribute applied to a simple entity. If so, -- returns True, and sets Ent to the entity, and Index to the integer -- literal provided as an attribute expression, or to Empty if none. + -- Num is the index designating the relevant slot in Ent and Index. -- Also returns True if the expression is a generated type conversion -- whose expression is of the desired form. This latter case arises -- when Apply_Universal_Integer_Attribute_Check installs a conversion -- to check for being in range, which is not needed in this context. -- Returns False if neither condition holds. - function Prepare_64 (N : Node_Id) return Node_Id; - -- Given a discrete expression, returns a Long_Long_Integer typed - -- expression representing the underlying value of the expression. - -- This is done with an unchecked conversion to the result type. We - -- use unchecked conversion to handle the enumeration type case. + ---------------------------------- + -- Convert_To_Long_Long_Integer -- + ---------------------------------- + + function Convert_To_Long_Long_Integer (N : Node_Id) return Node_Id is + begin + return Unchecked_Convert_To (Standard_Long_Long_Integer, N); + end Convert_To_Long_Long_Integer; ---------------------- -- Is_Entity_Length -- ---------------------- - function Is_Entity_Length (N : Node_Id) return Boolean is + function Is_Entity_Length (N : Node_Id; Num : Pos) return Boolean is begin if Nkind (N) = N_Attribute_Reference and then Attribute_Name (N) = Name_Length and then Is_Entity_Name (Prefix (N)) then - Ent := Entity (Prefix (N)); + Ent (Num) := Entity (Prefix (N)); if Present (Expressions (N)) then - Index := First (Expressions (N)); + Index (Num) := First (Expressions (N)); else - Index := Empty; + Index (Num) := Empty; end if; return True; @@ -13842,7 +13850,7 @@ package body Exp_Ch4 is elsif Nkind (N) = N_Type_Conversion and then not Comes_From_Source (N) then - return Is_Entity_Length (Expression (N)); + return Is_Entity_Length (Expression (N), Num); else return False; @@ -13859,6 +13867,8 @@ package body Exp_Ch4 is Lo : Uint; Hi : Uint; Indx : Node_Id; + Dbl : Boolean; + Ityp : Entity_Id; begin if Compile_Time_Known_Value (N) then @@ -13887,37 +13897,36 @@ package body Exp_Ch4 is return False; end if; + -- Tests if N is also a length attribute applied to a simple entity + + Dbl := Is_Entity_Length (N, 2); + -- Comparison value was within range, so now we must check the index - -- value to make sure it is also within 32-bits. + -- value to make sure it is also within 32 bits. - Indx := First_Index (Etype (Ent)); + for K in Pos range 1 .. 2 loop + Indx := First_Index (Etype (Ent (K))); - if Present (Index) then - for J in 2 .. UI_To_Int (Intval (Index)) loop - Next_Index (Indx); - end loop; - end if; + if Present (Index (K)) then + for J in 2 .. UI_To_Int (Intval (Index (K))) loop + Next_Index (Indx); + end loop; + end if; - Ityp := Etype (Indx); + Ityp := Etype (Indx); - if Esize (Ityp) > 32 then - return False; - end if; + if Esize (Ityp) > 32 then + return False; + end if; + + exit when not Dbl; + end loop; Is_Zero := False; Comp := N; return True; end Is_Optimizable; - ---------------- - -- Prepare_64 -- - ---------------- - - function Prepare_64 (N : Node_Id) return Node_Id is - begin - return Unchecked_Convert_To (Standard_Long_Long_Integer, N); - end Prepare_64; - -- Start of processing for Optimize_Length_Comparison begin @@ -13935,14 +13944,14 @@ package body Exp_Ch4 is -- Ent'Length op 0/1 - if Is_Entity_Length (Left_Opnd (N)) + if Is_Entity_Length (Left_Opnd (N), 1) and then Is_Optimizable (Right_Opnd (N)) then null; -- 0/1 op Ent'Length - elsif Is_Entity_Length (Right_Opnd (N)) + elsif Is_Entity_Length (Right_Opnd (N), 1) and then Is_Optimizable (Left_Opnd (N)) then -- Flip comparison to opposite sense @@ -14036,41 +14045,96 @@ package body Exp_Ch4 is Left := Make_Attribute_Reference (Loc, - Prefix => New_Occurrence_Of (Ent, Loc), + Prefix => New_Occurrence_Of (Ent (1), Loc), Attribute_Name => Name_First); - if Present (Index) then - Set_Expressions (Left, New_List (New_Copy (Index))); + if Present (Index (1)) then + Set_Expressions (Left, New_List (New_Copy (Index (1)))); end if; -- If general value case, then do the addition of (n - 1), and -- also add the needed conversions to type Long_Long_Integer. + -- If n = Y'Length, we rewrite X'First + (n - 1) op X'Last into: + + -- Y'Last + (X'First - Y'First) op X'Last + + -- in the hope that X'First - Y'First can be computed statically. + if Present (Comp) then - Left := - Make_Op_Add (Loc, - Left_Opnd => Prepare_64 (Left), - Right_Opnd => - Make_Op_Subtract (Loc, - Left_Opnd => Prepare_64 (Comp), - Right_Opnd => Make_Integer_Literal (Loc, 1))); + if Present (Ent (2)) then + declare + Y_First : constant Node_Id := + Make_Attribute_Reference (Loc, + Prefix => New_Occurrence_Of (Ent (2), Loc), + Attribute_Name => Name_First); + Y_Last : constant Node_Id := + Make_Attribute_Reference (Loc, + Prefix => New_Occurrence_Of (Ent (2), Loc), + Attribute_Name => Name_Last); + R : Compare_Result; + + begin + if Present (Index (2)) then + Set_Expressions (Y_First, New_List (New_Copy (Index (2)))); + Set_Expressions (Y_Last, New_List (New_Copy (Index (2)))); + end if; + + Analyze (Left); + Analyze (Y_First); + + -- If X'First = Y'First, rewrite it into a direct comparison + -- of Y'Last and X'Last without conversions. + + R := Compile_Time_Compare (Left, Y_First, Assume_Valid => True); + + if R = EQ then + Left := Y_Last; + Comp := Empty; + + -- Otherwise, use the above formula + + else + Left := + Make_Op_Add (Loc, + Left_Opnd => Convert_To_Long_Long_Integer (Y_Last), + Right_Opnd => + Make_Op_Subtract (Loc, + Left_Opnd => + Convert_To_Long_Long_Integer (Left), + Right_Opnd => + Convert_To_Long_Long_Integer (Y_First))); + end if; + end; + + -- General value case + + else + Left := + Make_Op_Add (Loc, + Left_Opnd => Convert_To_Long_Long_Integer (Left), + Right_Opnd => + Make_Op_Subtract (Loc, + Left_Opnd => Convert_To_Long_Long_Integer (Comp), + Right_Opnd => Make_Integer_Literal (Loc, 1))); + end if; end if; -- Build the Last reference we will use Right := Make_Attribute_Reference (Loc, - Prefix => New_Occurrence_Of (Ent, Loc), + Prefix => New_Occurrence_Of (Ent (1), Loc), Attribute_Name => Name_Last); - if Present (Index) then - Set_Expressions (Right, New_List (New_Copy (Index))); + if Present (Index (1)) then + Set_Expressions (Right, New_List (New_Copy (Index (1)))); end if; -- If general operand, convert Last reference to Long_Long_Integer if Present (Comp) then - Right := Prepare_64 (Right); + Right := Convert_To_Long_Long_Integer (Right); end if; -- Check for cases to optimize @@ -14147,11 +14211,10 @@ package body Exp_Ch4 is raise Program_Error; end if; - -- Rewrite and finish up + -- Rewrite and finish up (we can suppress overflow checks, see above) Rewrite (N, Result); - Analyze_And_Resolve (N, Typ); - return; + Analyze_And_Resolve (N, Typ, Suppress => Overflow_Check); end Optimize_Length_Comparison; --------------------------------