===================================================================
@@ -47,6 +47,7 @@ with Namet; use Namet;
with Nlists; use Nlists;
with Nmake; use Nmake;
with Opt; use Opt;
+with Par_SCO; use Par_SCO;
with Restrict; use Restrict;
with Rident; use Rident;
with Rtsfind; use Rtsfind;
@@ -5066,7 +5067,7 @@ package body Exp_Ch4 is
and then Is_Power_Of_2_For_Shift (Ropnd)
-- We cannot do this transformation in configurable run time mode if we
- -- have 64-bit -- integers and long shifts are not available.
+ -- have 64-bit integers and long shifts are not available.
and then
(Esize (Ltyp) <= 32
@@ -5912,6 +5913,9 @@ package body Exp_Ch4 is
-- 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.
@@ -5922,33 +5926,45 @@ package body Exp_Ch4 is
and then Esize (Root_Type (Exptyp)) <= Esize (Standard_Integer)
and then Is_Unsigned_Type (Exptyp)
and then not Ovflo
- and then Nkind (Parent (N)) in N_Binary_Op
then
- declare
- P : constant Node_Id := Parent (N);
- L : constant Node_Id := Left_Opnd (P);
- R : constant Node_Id := Right_Opnd (P);
+ -- First the multiply and divide cases
- 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
- (Is_Integer_Type (Etype (R)) and then L = N))
- and then not Do_Overflow_Check (P))
-
- or else
- (Nkind (P) = N_Op_Divide
- and then Is_Integer_Type (Etype (L))
- and then Is_Unsigned_Type (Etype (L))
- and then R = N
- and then not Do_Overflow_Check (P))
- then
- Set_Is_Power_Of_2_For_Shift (N);
- return;
- end if;
- end;
+ if 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);
+ R : constant Node_Id := Right_Opnd (P);
+
+ 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
+ (Is_Integer_Type (Etype (R)) and then L = N))
+ and then not Do_Overflow_Check (P))
+ or else
+ (Nkind (P) = N_Op_Divide
+ and then Is_Integer_Type (Etype (L))
+ and then Is_Unsigned_Type (Etype (L))
+ and then R = N
+ and then not Do_Overflow_Check (P))
+ then
+ Set_Is_Power_Of_2_For_Shift (N);
+ return;
+ end if;
+ end;
+
+ -- Now the other cases
+
+ 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;
+ end if;
end if;
-- Fall through if exponentiation must be done using a runtime routine
@@ -8745,6 +8761,12 @@ package body Exp_Ch4 is
if Compile_Time_Known_Value (Left) then
+ -- Mark SCO for left condition as compile time known
+
+ if Generate_SCO and then Comes_From_Source (Left) then
+ Set_SCO_Condition (Left, Expr_Value_E (Left) = Standard_True);
+ end if;
+
-- Rewrite True AND THEN Right / False OR ELSE Right to Right.
-- Any actions associated with Right will be executed unconditionally
-- and can thus be inserted into the tree unconditionally.
@@ -8830,6 +8852,12 @@ package body Exp_Ch4 is
if Compile_Time_Known_Value (Right) then
+ -- Mark SCO for left condition as compile time known
+
+ if Generate_SCO and then Comes_From_Source (Right) then
+ Set_SCO_Condition (Right, Expr_Value_E (Right) = Standard_True);
+ end if;
+
-- Change (Left and then True), (Left or else False) to Left.
-- Note that we know there are no actions associated with the right
-- operand, since we just checked for this case above.
This patch optimizes 2**N to a shift in more contexts. Previously this optimization was applied only when 2**N appeared as the operand of a multiply or divide. Now it applies in other contexts as well. The following test program: function Pow2_Shift (B : Integer; N : Natural) return Natural is begin if B = 0 then return 2 ** N; elsif B = 1 then return 4 * 2 ** N; else return 1 * 2 ** N; end if; end Pow2_Shift; generates the following output with -gnatG: function pow2_shift (b : integer; n : natural) return natural is begin if b = 0 then [constraint_error when not (shift_left!(1, n) >= 0) "range check failed"] return natural(shift_left!(1, n)); elsif b = 1 then [constraint_error when not (shift_left!(4, n) >= 0) "range check failed"] return natural(shift_left!(4, n)); else [constraint_error when not (shift_left!(1, n) >= 0) "range check failed"] return natural(shift_left!(1, n)); end if; end pow2_shift; Tested on x86_64-pc-linux-gnu, committed on trunk 2010-06-14 Robert Dewar <dewar@adacore.com> * exp_ch4.adb (Expand_N_Op_Expon): Optimize 2**N in stand alone context