From 8ad6af8fc9f0b5df3a6a5f08a95651014fc946df Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Sun, 21 Jun 2020 04:27:07 -0400 Subject: [PATCH] [Ada] Add support for compile time evaluation of Shift_Right_Arithmetic gcc/ada/ * sem_eval.adb (Eval_Intrinsic_Call, Fold_Shift): Add support for Shift_Right_Arithmetic and for signed integers. * exp_ch4.adb (Expand_N_Op_Rotate_Left, Expand_N_Op_Rotate_Right, Expand_N_Op_Shift_Left, Expand_N_Op_Shift_Right_Arithmetic): Minor reformatting and code cleanup to ensure a consistent handling. Update comments and add assertion. --- gcc/ada/exp_ch4.adb | 93 ++++++++++++++++++++++++++++++---------------------- gcc/ada/sem_eval.adb | 84 +++++++++++++++++++++++++++++++++++++++++------ 2 files changed, 127 insertions(+), 50 deletions(-) diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index 30824c6..b61c428 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -10265,15 +10265,17 @@ package body Exp_Ch4 is -- where Bits is the shift count mod Esize (the mod operation here -- deals with ludicrous large shift counts, which are apparently OK). - -- What about nonbinary modulus ??? + if Modify_Tree_For_C then + declare + Loc : constant Source_Ptr := Sloc (N); + Rtp : constant Entity_Id := Etype (Right_Opnd (N)); + Typ : constant Entity_Id := Etype (N); - declare - Loc : constant Source_Ptr := Sloc (N); - Rtp : constant Entity_Id := Etype (Right_Opnd (N)); - Typ : constant Entity_Id := Etype (N); + begin + -- Sem_Intr should prevent getting there with a non binary modulus + + pragma Assert (not Non_Binary_Modulus (Typ)); - begin - if Modify_Tree_For_C then Rewrite (Right_Opnd (N), Make_Op_Rem (Loc, Left_Opnd => Relocate_Node (Right_Opnd (N)), @@ -10298,8 +10300,8 @@ package body Exp_Ch4 is Duplicate_Subexpr_No_Checks (Right_Opnd (N)))))); Analyze_And_Resolve (N, Typ); - end if; - end; + end; + end if; end Expand_N_Op_Rotate_Left; ------------------------------ @@ -10318,22 +10320,24 @@ package body Exp_Ch4 is -- where Bits is the shift count mod Esize (the mod operation here -- deals with ludicrous large shift counts, which are apparently OK). - -- What about nonbinary modulus ??? + if Modify_Tree_For_C then + declare + Loc : constant Source_Ptr := Sloc (N); + Rtp : constant Entity_Id := Etype (Right_Opnd (N)); + Typ : constant Entity_Id := Etype (N); - declare - Loc : constant Source_Ptr := Sloc (N); - Rtp : constant Entity_Id := Etype (Right_Opnd (N)); - Typ : constant Entity_Id := Etype (N); + begin + -- Sem_Intr should prevent getting there with a non binary modulus - begin - Rewrite (Right_Opnd (N), - Make_Op_Rem (Loc, - Left_Opnd => Relocate_Node (Right_Opnd (N)), - Right_Opnd => Make_Integer_Literal (Loc, Esize (Typ)))); + pragma Assert (not Non_Binary_Modulus (Typ)); + + Rewrite (Right_Opnd (N), + Make_Op_Rem (Loc, + Left_Opnd => Relocate_Node (Right_Opnd (N)), + Right_Opnd => Make_Integer_Literal (Loc, Esize (Typ)))); - Analyze_And_Resolve (Right_Opnd (N), Rtp); + Analyze_And_Resolve (Right_Opnd (N), Rtp); - if Modify_Tree_For_C then Rewrite (N, Make_Op_Or (Loc, Left_Opnd => @@ -10351,8 +10355,8 @@ package body Exp_Ch4 is Duplicate_Subexpr_No_Checks (Right_Opnd (N)))))); Analyze_And_Resolve (N, Typ); - end if; - end; + end; + end if; end Expand_N_Op_Rotate_Right; ---------------------------- @@ -10382,6 +10386,10 @@ package body Exp_Ch4 is Hi : Uint; begin + -- Sem_Intr should prevent getting there with a non binary modulus + + pragma Assert (not Non_Binary_Modulus (Typ)); + if Compile_Time_Known_Value (Right) then if Expr_Value (Right) >= Siz then Rewrite (N, Make_Integer_Literal (Loc, 0)); @@ -10439,7 +10447,14 @@ package body Exp_Ch4 is Binary_Op_Validity_Checks (N); -- If we are in Modify_Tree_For_C mode, there is no shift right - -- arithmetic in C, so we rewrite in terms of logical shifts. + -- arithmetic in C, so we rewrite in terms of logical shifts for + -- modular integers, and keep the Shift_Right intrinsic for signed + -- integers: even though doing a shift on a signed integer is not + -- fully guaranteed by the C standard, this is what C compilers + -- implement in practice. + -- Consider also taking advantage of this for modular integers by first + -- performing an unchecked conversion of the modular integer to a signed + -- integer of the same sign, and then convert back. -- Shift_Right (Num, Bits) or -- (if Num >= Sign @@ -10448,26 +10463,24 @@ package body Exp_Ch4 is -- Here Mask is all 1 bits (2**size - 1), and Sign is 2**(size - 1) - -- Note: in almost all C compilers it would work to just shift a - -- signed integer right, but it's undefined and we cannot rely on it. - -- Note: the above works fine for shift counts greater than or equal -- to the word size, since in this case (not (Shift_Right (Mask, bits))) -- generates all 1'bits. - -- What about nonbinary modulus ??? + if Modify_Tree_For_C and then Is_Modular_Integer_Type (Etype (N)) then + declare + Loc : constant Source_Ptr := Sloc (N); + Typ : constant Entity_Id := Etype (N); + Sign : constant Uint := 2 ** (Esize (Typ) - 1); + Mask : constant Uint := (2 ** Esize (Typ)) - 1; + Left : constant Node_Id := Left_Opnd (N); + Right : constant Node_Id := Right_Opnd (N); + Maskx : Node_Id; - declare - Loc : constant Source_Ptr := Sloc (N); - Typ : constant Entity_Id := Etype (N); - Sign : constant Uint := 2 ** (Esize (Typ) - 1); - Mask : constant Uint := (2 ** Esize (Typ)) - 1; - Left : constant Node_Id := Left_Opnd (N); - Right : constant Node_Id := Right_Opnd (N); - Maskx : Node_Id; + begin + -- Sem_Intr should prevent getting there with a non binary modulus - begin - if Modify_Tree_For_C then + pragma Assert (not Non_Binary_Modulus (Typ)); -- Here if not (Shift_Right (Mask, bits)) can be computed at -- compile time as a single constant. @@ -10513,8 +10526,8 @@ package body Exp_Ch4 is Maskx, Make_Integer_Literal (Loc, 0))))); Analyze_And_Resolve (N, Typ); - end if; - end; + end; + end if; end Expand_N_Op_Shift_Right_Arithmetic; -------------------------- diff --git a/gcc/ada/sem_eval.adb b/gcc/ada/sem_eval.adb index 8c13abc..872112d 100644 --- a/gcc/ada/sem_eval.adb +++ b/gcc/ada/sem_eval.adb @@ -2941,9 +2941,14 @@ package body Sem_Eval is end if; case Nam is - when Name_Shift_Left => Eval_Shift (N, E, N_Op_Shift_Left); - when Name_Shift_Right => Eval_Shift (N, E, N_Op_Shift_Right); - when others => null; + when Name_Shift_Left => + Eval_Shift (N, E, N_Op_Shift_Left); + when Name_Shift_Right => + Eval_Shift (N, E, N_Op_Shift_Right); + when Name_Shift_Right_Arithmetic => + Eval_Shift (N, E, N_Op_Shift_Right_Arithmetic); + when others => + null; end case; end Eval_Intrinsic_Call; @@ -4800,13 +4805,11 @@ package body Sem_Eval is end Check_Elab_Call; begin - -- Evaluate logical shift operators on binary modular types - - if Is_Modular_Integer_Type (Typ) - and then not Non_Binary_Modulus (Typ) - and then Compile_Time_Known_Value (Left) + if Compile_Time_Known_Value (Left) and then Compile_Time_Known_Value (Right) then + pragma Assert (not Non_Binary_Modulus (Typ)); + if Op = N_Op_Shift_Left then Check_Elab_Call; @@ -4821,12 +4824,73 @@ package body Sem_Eval is elsif Op = N_Op_Shift_Right then Check_Elab_Call; - -- Fold Shift_Right (X, Y) by computing X / 2**Y + -- Fold Shift_Right (X, Y) by computing abs X / 2**Y Fold_Uint (N, - Expr_Value (Left) / (Uint_2 ** Expr_Value (Right)), + abs Expr_Value (Left) / (Uint_2 ** Expr_Value (Right)), Static => Static); + + elsif Op = N_Op_Shift_Right_Arithmetic then + Check_Elab_Call; + + declare + Two_Y : constant Uint := Uint_2 ** Expr_Value (Right); + Modulus : Uint; + begin + if Is_Modular_Integer_Type (Typ) then + Modulus := Einfo.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) + and then Expr_Value (Left) < Modulus / Uint_2) + or else + (not Is_Modular_Integer_Type (Typ) + and then Expr_Value (Left) >= 0) + then + Fold_Uint (N, Expr_Value (Left) / Two_Y, Static => Static); + + -- -1 (aka all 1's) if Y is larger than the number of bits + -- available or if X = -1. + + elsif Two_Y > Modulus + or else Expr_Value (Left) = Uint_Minus_1 + then + if Is_Modular_Integer_Type (Typ) then + Fold_Uint (N, Modulus - Uint_1, Static => Static); + else + Fold_Uint (N, Uint_Minus_1, Static => Static); + end if; + + -- Large modular integer, compute via multiply/divide the + -- following: X >> Y + (1 << Y - 1) << (RM_Size - Y) + + elsif Is_Modular_Integer_Type (Typ) then + Fold_Uint + (N, + (Expr_Value (Left)) / Two_Y + + (Two_Y - Uint_1) + * Uint_2 ** (RM_Size (Typ) - Expr_Value (Right)), + Static => Static); + + -- Negative signed integer, compute via multiple/divide the + -- following: + -- (Modulus + X) >> Y + (1 << Y - 1) << (RM_Size - Y) - Modulus + + else + Fold_Uint + (N, + (Modulus + Expr_Value (Left)) / Two_Y + + (Two_Y - Uint_1) + * Uint_2 ** (RM_Size (Typ) - Expr_Value (Right)) + - Modulus, + Static => Static); + end if; + end; end if; end if; end Fold_Shift; -- 2.7.4