diff options
Diffstat (limited to 'gcc/ada/sem_eval.adb')
| -rw-r--r-- | gcc/ada/sem_eval.adb | 105 |
1 files changed, 51 insertions, 54 deletions
diff --git a/gcc/ada/sem_eval.adb b/gcc/ada/sem_eval.adb index b7dfe01..fcab3e7 100644 --- a/gcc/ada/sem_eval.adb +++ b/gcc/ada/sem_eval.adb @@ -144,7 +144,7 @@ package body Sem_Eval is Checking_For_Potentially_Static_Expression : Boolean := False; -- Global flag that is set True during Analyze_Static_Expression_Function -- in order to verify that the result expression of a static expression - -- function is a potentially static function (see RM2022 6.8(5.3)). + -- function is a potentially static function (see RM 2022 6.8(5.3)). ----------------------- -- Local Subprograms -- @@ -574,13 +574,11 @@ package body Sem_Eval is Rewrite (N, New_Copy (N)); - if not Is_Floating_Point_Type (T) then - Set_Realval - (N, Corresponding_Integer_Value (N) * Small_Value (T)); - - elsif not UR_Is_Zero (Realval (N)) then + if Is_Floating_Point_Type (T) then Set_Realval (N, Machine_Number (Base_Type (T), Realval (N), N)); Set_Is_Machine_Number (N); + else + Set_Realval (N, Corresponding_Integer_Value (N) * Small_Value (T)); end if; end if; @@ -4989,27 +4987,41 @@ package body Sem_Eval is end if; end Check_Elab_Call; - Modulus, Val : Uint; - begin - if Compile_Time_Known_Value (Left) - and then Compile_Time_Known_Value (Right) + if not (Compile_Time_Known_Value (Left) + and then Compile_Time_Known_Value (Right)) then - pragma Assert (not Non_Binary_Modulus (Typ)); + return; + end if; + + pragma Assert (not Non_Binary_Modulus (Typ)); + pragma Assert (Expr_Value (Right) >= Uint_0); -- Amount is always Natural + + -- Shift by zero bits is a no-op + + if Expr_Value (Right) = Uint_0 then + Fold_Uint (N, Expr_Value (Left), Static => Static); + return; + end if; + declare + Modulus : constant Uint := + (if Is_Modular_Integer_Type (Typ) then Einfo.Entities.Modulus (Typ) + else Uint_2 ** RM_Size (Typ)); + Amount : constant Uint := UI_Min (Expr_Value (Right), RM_Size (Typ)); + -- Shift by an Amount greater than the size is all-zeros or all-ones. + -- Without this "min", we could use huge amounts of time and memory + -- below (e.g. 2**Amount, if Amount were a billion). + + Val : Uint; + begin if Op = N_Op_Shift_Left then Check_Elab_Call; - if Is_Modular_Integer_Type (Typ) then - Modulus := Einfo.Entities.Modulus (Typ); - else - Modulus := Uint_2 ** RM_Size (Typ); - end if; - -- Fold Shift_Left (X, Y) by computing -- (X * 2**Y) rem modulus [- Modulus] - Val := (Expr_Value (Left) * (Uint_2 ** Expr_Value (Right))) + Val := (Expr_Value (Left) * (Uint_2 ** Amount)) rem Modulus; if Is_Modular_Integer_Type (Typ) @@ -5023,49 +5035,32 @@ package body Sem_Eval is elsif Op = N_Op_Shift_Right then Check_Elab_Call; - -- X >> 0 is a no-op + -- Fold X >> Y by computing (X [+ Modulus]) / 2**Y. + -- Note that after a Shift_Right operation (with Y > 0), the + -- result is always positive, even if the original operand was + -- negative. - if Expr_Value (Right) = Uint_0 then - Fold_Uint (N, Expr_Value (Left), Static => Static); - else - if Is_Modular_Integer_Type (Typ) then - Modulus := Einfo.Entities.Modulus (Typ); + declare + M : Unat; + begin + if Expr_Value (Left) >= Uint_0 then + M := Uint_0; else - Modulus := Uint_2 ** RM_Size (Typ); + M := Modulus; end if; - -- Fold X >> Y by computing (X [+ Modulus]) / 2**Y - -- Note that after a Shift_Right operation (with Y > 0), the - -- result is always positive, even if the original operand was - -- negative. - - declare - M : Unat; - begin - if Expr_Value (Left) >= Uint_0 then - M := Uint_0; - else - M := Modulus; - end if; + Fold_Uint + (N, + (Expr_Value (Left) + M) / (Uint_2 ** Amount), + Static => Static); + end; - Fold_Uint - (N, - (Expr_Value (Left) + M) / (Uint_2 ** Expr_Value (Right)), - Static => Static); - end; - end if; elsif Op = N_Op_Shift_Right_Arithmetic then Check_Elab_Call; declare - Two_Y : constant Uint := Uint_2 ** Expr_Value (Right); + Two_Y : constant Uint := Uint_2 ** Amount; begin - if Is_Modular_Integer_Type (Typ) then - Modulus := Einfo.Entities.Modulus (Typ); - else - Modulus := Uint_2 ** RM_Size (Typ); - end if; - -- X / 2**Y if X if positive or a small enough modular integer if (Is_Modular_Integer_Type (Typ) @@ -5096,7 +5091,7 @@ package body Sem_Eval is (N, (Expr_Value (Left)) / Two_Y + (Two_Y - Uint_1) - * Uint_2 ** (RM_Size (Typ) - Expr_Value (Right)), + * Uint_2 ** (RM_Size (Typ) - Amount), Static => Static); -- Negative signed integer, compute via multiple/divide the @@ -5108,13 +5103,15 @@ package body Sem_Eval is (N, (Modulus + Expr_Value (Left)) / Two_Y + (Two_Y - Uint_1) - * Uint_2 ** (RM_Size (Typ) - Expr_Value (Right)) + * Uint_2 ** (RM_Size (Typ) - Amount) - Modulus, Static => Static); end if; end; + else + raise Program_Error; end if; - end if; + end; end Fold_Shift; -------------- |