public inbox for gcc-cvs@sourceware.org
help / color / mirror / Atom feed
* [gcc/devel/autopar_devel] [Ada] Narrow large arithmetic and comparison operations
@ 2020-08-22 22:49 Giuliano Belinassi
  0 siblings, 0 replies; only message in thread
From: Giuliano Belinassi @ 2020-08-22 22:49 UTC (permalink / raw)
  To: gcc-cvs

https://gcc.gnu.org/g:0b37b7ad61e42c9e166d9f24a80492e4a9ac095c

commit 0b37b7ad61e42c9e166d9f24a80492e4a9ac095c
Author: Eric Botcazou <ebotcazou@adacore.com>
Date:   Fri Apr 24 22:50:50 2020 +0200

    [Ada] Narrow large arithmetic and comparison operations
    
    2020-06-18  Eric Botcazou  <ebotcazou@adacore.com>
    
    gcc/ada/
    
            * exp_ch4.adb (Narrow_Large_Operation): New procedure to try
            and narrow large arithmetic and comparison operations.
            (Expand_N_In): Call it.
            (Expand_N_Op_Abs): Likewise.
            (Expand_N_Op_Add): Likewise.
            (Expand_N_Op_Divide): Likewise.
            (Expand_N_Op_Eq): Likewise.
            (Expand_N_Op_Ge): Likewise.
            (Expand_N_Op_Gt): Likewise.
            (Expand_N_Op_Le): Likewise.
            (Expand_N_Op_Lt): Likewise.
            (Expand_N_Op_Minus): Likewise.
            (Expand_N_Op_Mod): Likewise.
            (Expand_N_Op_Multiply): Likewise.
            (Expand_N_Op_Ne): Likewise.
            (Expand_N_Op_Plus): Likewise.
            (Expand_N_Op_Rem): Likewise.
            (Expand_N_Op_Subtract): Likewise.
            (Expand_N_Type_Conversion): Use Convert_To procedure.
            * exp_ch9.adb (Is_Pure_Barrier) <N_Identifier>: Skip all
            numeric types.
            <N_Type_Conversion>: Use explicit criterion.

Diff:
---
 gcc/ada/exp_ch4.adb | 356 ++++++++++++++++++++++++++++++++++++++++++++++++++--
 gcc/ada/exp_ch9.adb |  12 +-
 2 files changed, 350 insertions(+), 18 deletions(-)

diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index d421a59591b..1302009fcdd 100644
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -224,6 +224,11 @@ package body Exp_Ch4 is
    --  skipped if the operation is done in Bignum mode but that's fine, since
    --  the Bignum call takes care of everything.
 
+   procedure Narrow_Large_Operation (N : Node_Id);
+   --  Try to compute the result of a large operation in a narrower type than
+   --  its nominal type. This is mainly aimed to get rid of operations done in
+   --  Universal_Integer that can be generated for attributes.
+
    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, or something
@@ -6545,6 +6550,12 @@ package body Exp_Ch4 is
             end if;
          end;
 
+         --  Try to narrow the operation
+
+         if Ltyp = Universal_Integer and then Nkind (N) = N_In then
+            Narrow_Large_Operation (N);
+         end if;
+
          --  For all other cases of an explicit range, nothing to be done
 
          goto Leave;
@@ -7224,6 +7235,7 @@ package body Exp_Ch4 is
    procedure Expand_N_Op_Abs (N : Node_Id) is
       Loc  : constant Source_Ptr := Sloc (N);
       Expr : constant Node_Id    := Right_Opnd (N);
+      Typ  : constant Entity_Id  := Etype (N);
 
    begin
       Unary_Op_Validity_Checks (N);
@@ -7235,9 +7247,19 @@ package body Exp_Ch4 is
          return;
       end if;
 
+      --  Try to narrow the operation
+
+      if Typ = Universal_Integer then
+         Narrow_Large_Operation (N);
+
+         if Nkind (N) /= N_Op_Abs then
+            return;
+         end if;
+      end if;
+
       --  Deal with software overflow checking
 
-      if Is_Signed_Integer_Type (Etype (N))
+      if Is_Signed_Integer_Type (Typ)
         and then Do_Overflow_Check (N)
       then
          --  The only case to worry about is when the argument is equal to the
@@ -7297,6 +7319,16 @@ package body Exp_Ch4 is
          end if;
       end if;
 
+      --  Try to narrow the operation
+
+      if Typ = Universal_Integer then
+         Narrow_Large_Operation (N);
+
+         if Nkind (N) /= N_Op_Add then
+            return;
+         end if;
+      end if;
+
       --  Arithmetic overflow checks for signed integer/fixed point types
 
       if Is_Signed_Integer_Type (Typ) or else Is_Fixed_Point_Type (Typ) then
@@ -7474,6 +7506,16 @@ package body Exp_Ch4 is
          return;
       end if;
 
+      --  Try to narrow the operation
+
+      if Typ = Universal_Integer then
+         Narrow_Large_Operation (N);
+
+         if Nkind (N) /= N_Op_Divide then
+            return;
+         end if;
+      end if;
+
       --  Convert x / 2 ** y to Shift_Right (x, y). Note that the fact that
       --  Is_Power_Of_2_For_Shift is set means that we know that our left
       --  operand is an unsigned integer, as required for this to work.
@@ -8437,6 +8479,12 @@ package body Exp_Ch4 is
 
       Rewrite_Comparison (N);
 
+      --  Try to narrow the operation
+
+      if Typl = Universal_Integer and then Nkind (N) = N_Op_Eq then
+         Narrow_Large_Operation (N);
+      end if;
+
       --  Special optimization of length comparison
 
       Optimize_Length_Comparison (N);
@@ -9053,6 +9101,12 @@ package body Exp_Ch4 is
 
       Rewrite_Comparison (N);
 
+      --  Try to narrow the operation
+
+      if Typ1 = Universal_Integer and then Nkind (N) = N_Op_Ge then
+         Narrow_Large_Operation (N);
+      end if;
+
       Optimize_Length_Comparison (N);
    end Expand_N_Op_Ge;
 
@@ -9096,6 +9150,12 @@ package body Exp_Ch4 is
 
       Rewrite_Comparison (N);
 
+      --  Try to narrow the operation
+
+      if Typ1 = Universal_Integer and then Nkind (N) = N_Op_Gt then
+         Narrow_Large_Operation (N);
+      end if;
+
       Optimize_Length_Comparison (N);
    end Expand_N_Op_Gt;
 
@@ -9139,6 +9199,12 @@ package body Exp_Ch4 is
 
       Rewrite_Comparison (N);
 
+      --  Try to narrow the operation
+
+      if Typ1 = Universal_Integer and then Nkind (N) = N_Op_Le then
+         Narrow_Large_Operation (N);
+      end if;
+
       Optimize_Length_Comparison (N);
    end Expand_N_Op_Le;
 
@@ -9182,6 +9248,12 @@ package body Exp_Ch4 is
 
       Rewrite_Comparison (N);
 
+      --  Try to narrow the operation
+
+      if Typ1 = Universal_Integer and then Nkind (N) = N_Op_Lt then
+         Narrow_Large_Operation (N);
+      end if;
+
       Optimize_Length_Comparison (N);
    end Expand_N_Op_Lt;
 
@@ -9203,8 +9275,18 @@ package body Exp_Ch4 is
          return;
       end if;
 
+      --  Try to narrow the operation
+
+      if Typ = Universal_Integer then
+         Narrow_Large_Operation (N);
+
+         if Nkind (N) /= N_Op_Minus then
+            return;
+         end if;
+      end if;
+
       if not Backend_Overflow_Checks_On_Target
-         and then Is_Signed_Integer_Type (Etype (N))
+         and then Is_Signed_Integer_Type (Typ)
          and then Do_Overflow_Check (N)
       then
          --  Software overflow checking expands -expr into (0 - expr)
@@ -9252,7 +9334,17 @@ package body Exp_Ch4 is
          return;
       end if;
 
-      if Is_Integer_Type (Etype (N)) then
+      --  Try to narrow the operation
+
+      if Typ = Universal_Integer then
+         Narrow_Large_Operation (N);
+
+         if Nkind (N) /= N_Op_Mod then
+            return;
+         end if;
+      end if;
+
+      if Is_Integer_Type (Typ) then
          Apply_Divide_Checks (N);
 
          --  All done if we don't have a MOD any more, which can happen as a
@@ -9551,6 +9643,16 @@ package body Exp_Ch4 is
          end if;
       end if;
 
+      --  Try to narrow the operation
+
+      if Typ = Universal_Integer then
+         Narrow_Large_Operation (N);
+
+         if Nkind (N) /= N_Op_Multiply then
+            return;
+         end if;
+      end if;
+
       --  Convert x * 2 ** y to Shift_Left (x, y). Note that the fact that
       --  Is_Power_Of_2_For_Shift is set means that we know that our left
       --  operand is an integer, as required for this to work.
@@ -9734,6 +9836,12 @@ package body Exp_Ch4 is
 
          Rewrite_Comparison (N);
 
+         --  Try to narrow the operation
+
+         if Typ = Universal_Integer and then Nkind (N) = N_Op_Ne then
+            Narrow_Large_Operation (N);
+         end if;
+
       --  For all cases other than elementary types, we rewrite node as the
       --  negation of an equality operation, and reanalyze. The equality to be
       --  used is defined in the same scope and has the same signature. This
@@ -10016,6 +10124,8 @@ package body Exp_Ch4 is
    ----------------------
 
    procedure Expand_N_Op_Plus (N : Node_Id) is
+      Typ : constant Entity_Id := Etype (N);
+
    begin
       Unary_Op_Validity_Checks (N);
 
@@ -10025,6 +10135,12 @@ package body Exp_Ch4 is
          Apply_Arithmetic_Overflow_Check (N);
          return;
       end if;
+
+      --  Try to narrow the operation
+
+      if Typ = Universal_Integer then
+         Narrow_Large_Operation (N);
+      end if;
    end Expand_N_Op_Plus;
 
    ---------------------
@@ -10058,6 +10174,16 @@ package body Exp_Ch4 is
          return;
       end if;
 
+      --  Try to narrow the operation
+
+      if Typ = Universal_Integer then
+         Narrow_Large_Operation (N);
+
+         if Nkind (N) /= N_Op_Rem then
+            return;
+         end if;
+      end if;
+
       if Is_Integer_Type (Etype (N)) then
          Apply_Divide_Checks (N);
 
@@ -10422,6 +10548,16 @@ package body Exp_Ch4 is
          return;
       end if;
 
+      --  Try to narrow the operation
+
+      if Typ = Universal_Integer then
+         Narrow_Large_Operation (N);
+
+         if Nkind (N) /= N_Op_Subtract then
+            return;
+         end if;
+      end if;
+
       --  N - 0 = N for integer types
 
       if Is_Integer_Type (Typ)
@@ -11876,20 +12012,13 @@ package body Exp_Ch4 is
             L, R : Node_Id;
 
          begin
-            R :=
-              Make_Type_Conversion (Loc,
-                Subtype_Mark => New_Occurrence_Of (Standard_Integer, Loc),
-                Expression   => Relocate_Node (Right_Opnd (Operand)));
-
             Opnd := New_Op_Node (Nkind (Operand), Loc);
+
+            R := Convert_To (Standard_Integer, Right_Opnd (Operand));
             Set_Right_Opnd (Opnd, R);
 
             if Nkind (Operand) in N_Binary_Op then
-               L :=
-                 Make_Type_Conversion (Loc,
-                   Subtype_Mark => New_Occurrence_Of (Standard_Integer, Loc),
-                   Expression   => Relocate_Node (Left_Opnd (Operand)));
-
+               L := Convert_To (Standard_Integer, Left_Opnd (Operand));
                Set_Left_Opnd  (Opnd, L);
             end if;
 
@@ -13777,6 +13906,207 @@ package body Exp_Ch4 is
           and then Overflow_Check_Mode in Minimized_Or_Eliminated;
    end Minimized_Eliminated_Overflow_Check;
 
+   ----------------------------
+   -- Narrow_Large_Operation --
+   ----------------------------
+
+   procedure Narrow_Large_Operation (N : Node_Id) is
+      Kind   : constant Node_Kind := Nkind (N);
+      In_Rng : constant Boolean   := Kind = N_In;
+      Binary : constant Boolean   := Kind in N_Binary_Op or else In_Rng;
+      Compar : constant Boolean   := Kind in N_Op_Compare or else In_Rng;
+      R      : constant Node_Id   := Right_Opnd (N);
+      Typ    : constant Entity_Id := Etype (R);
+
+      function Get_Size_For_Range (Lo, Hi : Uint) return Nat;
+      --  Return the size of the smallest signed integer type covering Lo .. Hi
+
+      ------------------------
+      -- Get_Size_For_Range --
+      ------------------------
+
+      function Get_Size_For_Range (Lo, Hi : Uint) return Nat is
+         B : Uint;
+         S : Nat;
+
+      begin
+         S := 1;
+         B := Uint_1;
+
+         --  S = size, B = 2 ** (size - 1) (can accommodate -B .. +(B - 1))
+
+         while Lo < -B or else Hi < -B or else Lo >= B or else Hi >= B loop
+            B := Uint_2 ** S;
+            S := S + 1;
+         end loop;
+
+         return S;
+      end Get_Size_For_Range;
+
+      --  Local variables
+
+      L          : Node_Id;
+      Llo, Lhi   : Uint;
+      Rlo, Rhi   : Uint;
+      Lsiz, Rsiz : Nat;
+      Nlo, Nhi   : Uint;
+      Nsiz       : Nat;
+      Ntyp       : Entity_Id;
+      Nop        : Node_Id;
+      OK         : Boolean;
+
+   --  Start of processing for Narrow_Large_Operation
+
+   begin
+      --  First, determine the range of the left operand, if any
+
+      if Binary then
+         L := Left_Opnd (N);
+         Determine_Range (L, OK, Llo, Lhi, Assume_Valid => True);
+         if not OK then
+            return;
+         end if;
+
+      else
+         L   := Empty;
+         Llo := Uint_0;
+         Lhi := Uint_0;
+      end if;
+
+      --  Second, determine the range of the right operand, which can itself
+      --  be a range, in which case we take the lower bound of the low bound
+      --  and the upper bound of the high bound.
+
+      if In_Rng then
+         declare
+            Zlo, Zhi : Uint;
+
+         begin
+            Determine_Range
+              (Low_Bound (R), OK, Rlo, Zhi, Assume_Valid => True);
+            if not OK then
+               return;
+            end if;
+
+            Determine_Range
+              (High_Bound (R), OK, Zlo, Rhi, Assume_Valid => True);
+            if not OK then
+               return;
+            end if;
+         end;
+
+      else
+         Determine_Range (R, OK, Rlo, Rhi, Assume_Valid => True);
+         if not OK then
+            return;
+         end if;
+      end if;
+
+      --  Then compute a size suitable for each range
+
+      if Binary then
+         Lsiz := Get_Size_For_Range (Llo, Lhi);
+      else
+         Lsiz := 0;
+      end if;
+
+      Rsiz := Get_Size_For_Range (Rlo, Rhi);
+
+      --  Now compute the size of the narrower type
+
+      if Compar then
+         --  The type must be able to accomodate the operands
+
+         Nsiz := Nat'Max (Lsiz, Rsiz);
+
+      else
+         --  The type must be able to accomodate the operand(s) and the result.
+
+         --  Note that Determine_Range typically does not report the bounds of
+         --  the value as being larger than those of the base type, which means
+         --  that it does not report overflow (see also Enable_Overflow_Check).
+
+         Determine_Range (N, OK, Nlo, Nhi, Assume_Valid => True);
+         if not OK then
+            return;
+         end if;
+
+         --  Therefore, if Nsiz is not lower than the size of the original type
+         --  here, we cannot be sure that the operation does not overflow.
+
+         Nsiz := Get_Size_For_Range (Nlo, Nhi);
+         Nsiz := Nat'Max (Nsiz, Lsiz);
+         Nsiz := Nat'Max (Nsiz, Rsiz);
+      end if;
+
+      --  If the size is not lower than the size of the original type, then
+      --  there is no point in changing the type, except in the case where
+      --  we can remove a conversion to the original type from an operand.
+
+      if Nsiz >= RM_Size (Typ)
+        and then not (Binary
+                       and then Nkind (L) = N_Type_Conversion
+                       and then Entity (Subtype_Mark (L)) = Typ)
+        and then not (Nkind (R) = N_Type_Conversion
+                       and then Entity (Subtype_Mark (R)) = Typ)
+      then
+         return;
+      end if;
+
+      --  Now pick the narrower type according to the size
+
+      if Nsiz <= RM_Size (Standard_Integer) then
+         Ntyp := Standard_Integer;
+
+      elsif Nsiz <= RM_Size (Standard_Long_Long_Integer) then
+         Ntyp := Standard_Long_Long_Integer;
+
+      else
+         return;
+      end if;
+
+      --  Finally rewrite the operation in the narrower type
+
+      Nop := New_Op_Node (Kind, Sloc (N));
+
+      if Binary then
+         Set_Left_Opnd (Nop, Convert_To (Ntyp, L));
+      end if;
+
+      if In_Rng then
+         Set_Right_Opnd (Nop,
+           Make_Range (Sloc (N),
+             Convert_To (Ntyp, Low_Bound (R)),
+             Convert_To (Ntyp, High_Bound (R))));
+      else
+         Set_Right_Opnd (Nop, Convert_To (Ntyp, R));
+      end if;
+
+      Rewrite (N, Nop);
+
+      if Compar then
+         --  Analyze it with the comparison type and checks suppressed since
+         --  the conversions of the operands cannot overflow.
+
+         Analyze_And_Resolve
+           (N, Etype (Original_Node (N)), Suppress => Overflow_Check);
+
+      else
+         --  Analyze it with the narrower type and checks suppressed, but only
+         --  when we are sure that the operation does not overflow, see above.
+
+         if Nsiz < RM_Size (Typ) then
+            Analyze_And_Resolve (N, Ntyp, Suppress => Overflow_Check);
+         else
+            Analyze_And_Resolve (N, Ntyp);
+         end if;
+
+         --  Put back a conversion to the original type
+
+         Convert_To_And_Rewrite (Typ, N);
+      end if;
+   end Narrow_Large_Operation;
+
    --------------------------------
    -- Optimize_Length_Comparison --
    --------------------------------
diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb
index 0b06ce50a03..eaf743e5863 100644
--- a/gcc/ada/exp_ch9.adb
+++ b/gcc/ada/exp_ch9.adb
@@ -6185,7 +6185,7 @@ package body Exp_Ch9 is
                if No (Entity (N)) then
                   return Abandon;
 
-               elsif Is_Universal_Numeric_Type (Entity (N)) then
+               elsif Is_Numeric_Type (Entity (N)) then
                   return Skip;
                end if;
 
@@ -6283,11 +6283,13 @@ package body Exp_Ch9 is
 
             when N_Type_Conversion =>
 
-               --  Conversions to Universal_Integer will not raise constraint
-               --  errors.
+               --  Conversions to Universal_Integer do not raise constraint
+               --  errors. Likewise if the expression's type is statically
+               --  compatible with the target's type.
 
-               if Cannot_Raise_Constraint_Error (N)
-                 or else Etype (N) = Universal_Integer
+               if Etype (N) = Universal_Integer
+                 or else Subtypes_Statically_Compatible
+                           (Etype (Expression (N)), Etype (N))
                then
                   return OK;
                end if;


^ permalink raw reply	[flat|nested] only message in thread

only message in thread, other threads:[~2020-08-22 22:49 UTC | newest]

Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2020-08-22 22:49 [gcc/devel/autopar_devel] [Ada] Narrow large arithmetic and comparison operations Giuliano Belinassi

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).