From 00e1556e5185b61d05ddc694678d9ac3ae6eca75 Mon Sep 17 00:00:00 2001 From: charlet Date: Fri, 22 May 2015 10:30:37 +0000 Subject: [PATCH] 2015-05-22 Robert Dewar * atree.adb, atree.ads, treepr.adb: Change name Needs_Actuals_Check to Check_Actuals. * exp_ch4.adb (Expand_N_Op_Expon): Optimize 2**x in modular and overflow cases. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@223538 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/ChangeLog | 7 +++ gcc/ada/atree.adb | 40 +++++++------- gcc/ada/atree.ads | 14 ++--- gcc/ada/exp_ch4.adb | 151 +++++++++++++++++++++++++++++++++++++++++++--------- gcc/ada/treepr.adb | 4 +- 5 files changed, 162 insertions(+), 54 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 13b58f869bd..346fb54550b 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,10 @@ +2015-05-22 Robert Dewar + + * atree.adb, atree.ads, treepr.adb: Change name Needs_Actuals_Check to + Check_Actuals. + * exp_ch4.adb (Expand_N_Op_Expon): Optimize 2**x in modular + and overflow cases. + 2015-05-22 Eric Botcazou * exp_pakd.adb (Install_PAT): Propagate representation aspects diff --git a/gcc/ada/atree.adb b/gcc/ada/atree.adb index 457fa622d77..870d7ffa79e 100644 --- a/gcc/ada/atree.adb +++ b/gcc/ada/atree.adb @@ -594,9 +594,9 @@ package body Atree is Set_Is_Ignored_Ghost_Node (New_Id); end if; - -- Clear Needs_Actual_Check to False + -- Clear Check_Actuals to False - Set_Needs_Actuals_Check (New_Id, False); + Set_Check_Actuals (New_Id, False); -- Specifically copy Paren_Count to deal with creating new table entry -- if the parentheses count is at the maximum possible value already. @@ -655,6 +655,15 @@ package body Atree is (Nodes.Table (E + 2).Field12'Unrestricted_Access)).Convention := Val; end Basic_Set_Convention; + ------------------- + -- Check_Actuals -- + ------------------- + + function Check_Actuals (N : Node_Id) return Boolean is + begin + return Flags.Table (N).Check_Actuals; + end Check_Actuals; + -------------------------- -- Check_Error_Detected -- -------------------------- @@ -1493,15 +1502,6 @@ package body Atree is Nodes.Table (New_Node).Rewrite_Ins := True; end Mark_Rewrite_Insertion; - ------------------------- - -- Needs_Actuals_Check -- - ------------------------- - - function Needs_Actuals_Check (N : Node_Id) return Boolean is - begin - return Flags.Table (N).Needs_Actuals_Check; - end Needs_Actuals_Check; - -------------- -- New_Copy -- -------------- @@ -2053,6 +2053,15 @@ package body Atree is Nodes.Table (N).Analyzed := Val; end Set_Analyzed; + ----------------------- + -- Set_Check_Actuals -- + ----------------------- + + procedure Set_Check_Actuals (N : Node_Id; Val : Boolean := True) is + begin + Flags.Table (N).Check_Actuals := Val; + end Set_Check_Actuals; + --------------------------- -- Set_Comes_From_Source -- --------------------------- @@ -2110,15 +2119,6 @@ package body Atree is Flags.Table (N).Is_Ignored_Ghost_Node := Val; end Set_Is_Ignored_Ghost_Node; - ----------------------------- - -- Set_Needs_Actuals_Check -- - ----------------------------- - - procedure Set_Needs_Actuals_Check (N : Node_Id; Val : Boolean := True) is - begin - Flags.Table (N).Needs_Actuals_Check := Val; - end Set_Needs_Actuals_Check; - ----------------------- -- Set_Original_Node -- ----------------------- diff --git a/gcc/ada/atree.ads b/gcc/ada/atree.ads index c3f9c5c7b64..e217ca0f462 100644 --- a/gcc/ada/atree.ads +++ b/gcc/ada/atree.ads @@ -608,6 +608,9 @@ package Atree is function Analyzed (N : Node_Id) return Boolean; pragma Inline (Analyzed); + function Check_Actuals (N : Node_Id) return Boolean; + pragma Inline (Check_Actuals); + function Comes_From_Source (N : Node_Id) return Boolean; pragma Inline (Comes_From_Source); @@ -620,9 +623,6 @@ package Atree is function Is_Ignored_Ghost_Node (N : Node_Id) return Boolean; pragma Inline (Is_Ignored_Ghost_Node); - function Needs_Actuals_Check (N : Node_Id) return Boolean; - pragma Inline (Needs_Actuals_Check); - function Nkind (N : Node_Id) return Node_Kind; pragma Inline (Nkind); @@ -898,6 +898,9 @@ package Atree is procedure Set_Analyzed (N : Node_Id; Val : Boolean := True); pragma Inline (Set_Analyzed); + procedure Set_Check_Actuals (N : Node_Id; Val : Boolean := True); + pragma Inline (Set_Check_Actuals); + procedure Set_Comes_From_Source (N : Node_Id; Val : Boolean); pragma Inline (Set_Comes_From_Source); -- Note that this routine is very rarely used, since usually the default @@ -914,9 +917,6 @@ package Atree is procedure Set_Is_Ignored_Ghost_Node (N : Node_Id; Val : Boolean := True); pragma Inline (Set_Is_Ignored_Ghost_Node); - procedure Set_Needs_Actuals_Check (N : Node_Id; Val : Boolean := True); - pragma Inline (Set_Needs_Actuals_Check); - procedure Set_Original_Node (N : Node_Id; Val : Node_Id); pragma Inline (Set_Original_Node); -- Note that this routine is used only in very peculiar cases. In normal @@ -4142,7 +4142,7 @@ package Atree is -- policy Ignore. The name of the flag should be Flag4, however this -- requires changing the names of all remaining 300+ flags. - Needs_Actuals_Check : Boolean; + Check_Actuals : Boolean; -- Flag set to indicate that the marked node is subject to the check -- for writable actuals. See xxx for more details. Again it would be -- more uniform to use some Flagx here, but that would be disruptive. diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index 076bfafafcc..b6326fc8613 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -7653,34 +7653,40 @@ package body Exp_Ch4 is end if; end if; - -- Case of (2 ** expression) appearing as an argument of an integer - -- multiplication, or as the right argument of a division of a non- - -- negative integer. In such cases we leave the node untouched, setting - -- the flag Is_Natural_Power_Of_2_for_Shift set, then the expansion - -- of the higher level node converts it into a shift. - - -- Another case is 2 ** N in any other context. We simply convert - -- this to 1 * 2 ** N, and then the above transformation applies. - - -- Note: this transformation is not applicable for a modular type with - -- a non-binary modulus in the multiplication case, since we get a wrong - -- result if the shift causes an overflow before the modular reduction. + -- Deal with optimizing 2 ** expression to shift where possible -- Note: we used to check that Exptyp was an unsigned type. But that is -- an unnecessary check, since if Exp is negative, we have a run-time -- error that is either caught (so we get the right result) or we have -- suppressed the check, in which case the code is erroneous anyway. - if Nkind (Base) = N_Integer_Literal + if Is_Integer_Type (Rtyp) + + -- The base value must be safe, compile-time known, and exactly 2 + + and then Nkind (Base) = N_Integer_Literal and then CRT_Safe_Compile_Time_Known_Value (Base) and then Expr_Value (Base) = Uint_2 + + -- We only handle cases where the right type is a integer + and then Is_Integer_Type (Root_Type (Exptyp)) and then Esize (Root_Type (Exptyp)) <= Esize (Standard_Integer) - and then not Ovflo + + -- This transformation is not applicable for a modular type with a + -- nonbinary modulus because we do not handle modular reduction in + -- a correct manner if we attempt this transformation in this case. + + and then not Non_Binary_Modulus (Typ) then - -- First the multiply and divide cases + -- Handle the cases where our parent is a division or multiplication + -- specially. In these cases we can convert to using a shift at the + -- parent level if we are not doing overflow checking, since it is + -- too tricky to combine the overflow check at the parent level. - if Nkind_In (Parent (N), N_Op_Divide, N_Op_Multiply) then + if not Ovflo + and then Nkind_In (Parent (N), N_Op_Divide, N_Op_Multiply) + then declare P : constant Node_Id := Parent (N); L : constant Node_Id := Left_Opnd (P); @@ -7688,7 +7694,6 @@ package body Exp_Ch4 is begin if (Nkind (P) = N_Op_Multiply - and then not Non_Binary_Modulus (Typ) and then ((Is_Integer_Type (Etype (L)) and then R = N) or else @@ -7707,15 +7712,111 @@ package body Exp_Ch4 is end if; end; - -- Now the other cases where we convert to 1 * (2 ** K) + -- Here we just have 2 ** N on its own, so we can convert this to a + -- shift node. We are prepared to deal with overflow here, and we + -- also have to handle proper modular reduction for binary modular. - elsif not Non_Binary_Modulus (Typ) then - Rewrite (N, - Make_Op_Multiply (Loc, - Left_Opnd => Make_Integer_Literal (Loc, 1), - Right_Opnd => Relocate_Node (N))); - Analyze_And_Resolve (N, Typ); - return; + else + declare + OK : Boolean; + Lo : Uint; + Hi : Uint; + + MaxS : Uint; + -- Maximum shift count with no overflow + + TestS : Boolean; + -- Set True if we must test the shift count + + begin + -- Compute maximum shift based on the underlying size. For a + -- modular type this is one less than the size. + + if Is_Modular_Integer_Type (Typ) then + + -- For modular integer types, this is the size of the value + -- being shifted minus one. Any larger values will cause + -- modular reduction to a result of zero. Note that we do + -- want the RM_Size here (e.g. mod 2 ** 7, we want a result + -- of 6, since 2**7 should be reduced to zero). + + MaxS := RM_Size (Rtyp) - 1; + + -- For signed integer types, we use the size of the value + -- being shifted minus 2. Larger values cause overflow. + + else + MaxS := Esize (Rtyp) - 2; + end if; + + -- Determine range to see if it can be larger than MaxS + + Determine_Range + (Right_Opnd (N), OK, Lo, Hi, Assume_Valid => True); + TestS := (not OK) or else Hi > MaxS; + + -- Signed integer case + + if Is_Signed_Integer_Type (Typ) then + + -- Generate overflow check if overflow is active. Note that + -- we can simply ignore the possibility of overflow if the + -- flag is not set (means that overflow cannot happen or + -- that overflow checks are suppressed). + + if Ovflo and TestS then + Insert_Action (N, + Make_Raise_Constraint_Error (Loc, + Condition => + Make_Op_Gt (Loc, + Left_Opnd => Duplicate_Subexpr (Right_Opnd (N)), + Right_Opnd => Make_Integer_Literal (Loc, MaxS)), + Reason => CE_Overflow_Check_Failed)); + end if; + + -- Now rewrite node as Shift_Left (1, right-operand) + + Rewrite (N, + Make_Op_Shift_Left (Loc, + Left_Opnd => Make_Integer_Literal (Loc, Uint_1), + Right_Opnd => Right_Opnd (N))); + + -- Modular integer case + + else pragma Assert (Is_Modular_Integer_Type (Typ)); + + -- If shift count can be greater than MaxS, we need to wrap + -- the shift in a test that will reduce the result value to + -- zero if this shift count is exceeded. + + if TestS then + Rewrite (N, + Make_If_Expression (Loc, + Expressions => New_List ( + Make_Op_Gt (Loc, + Left_Opnd => Duplicate_Subexpr (Right_Opnd (N)), + Right_Opnd => Make_Integer_Literal (Loc, MaxS)), + + Make_Integer_Literal (Loc, Uint_0), + + Make_Op_Shift_Left (Loc, + Left_Opnd => Make_Integer_Literal (Loc, Uint_1), + Right_Opnd => Right_Opnd (N))))); + + -- If we know shift count cannot be greater than MaxS, then + -- it is safe to just rewrite as a shift with no test. + + else + Rewrite (N, + Make_Op_Shift_Left (Loc, + Left_Opnd => Make_Integer_Literal (Loc, Uint_1), + Right_Opnd => Right_Opnd (N))); + end if; + end if; + + Analyze_And_Resolve (N, Typ); + return; + end; end if; end if; diff --git a/gcc/ada/treepr.adb b/gcc/ada/treepr.adb index a7f79cfe194..8ad81b9ed1c 100644 --- a/gcc/ada/treepr.adb +++ b/gcc/ada/treepr.adb @@ -1382,8 +1382,8 @@ package body Treepr is Print_Header_Flag ("ignored ghost"); end if; - if Needs_Actuals_Check (N) then - Print_Header_Flag ("needs actuals check"); + if Check_Actuals (N) then + Print_Header_Flag ("check actuals"); end if; if Enumerate then -- 2.11.4.GIT