public inbox for gcc-patches@gcc.gnu.org
 help / color / mirror / Atom feed
* [Ada] Eliminate useless 128-bit overflow check for conversion
@ 2021-04-29  8:03 Pierre-Marie de Rodat
  0 siblings, 0 replies; only message in thread
From: Pierre-Marie de Rodat @ 2021-04-29  8:03 UTC (permalink / raw)
  To: gcc-patches; +Cc: Eric Botcazou

[-- Attachment #1: Type: text/plain, Size: 941 bytes --]

This gets rid of overflow checks done using a 128-bit integer type on
64-bit platforms and that can be done in a narrower type, by reusing
the machinery already implemented to narrow the type of operations.

This runs afoul of the processing for Max_Size_In_Storage_Elements
in Expand_N_Attribute_Reference, which attempts to second guess the
expansion of checks done in universal integer contexts, so this code
is simply removed, as it does not seem to serve any real purpose.

Tested on x86_64-pc-linux-gnu, committed on trunk

gcc/ada/

	* exp_attr.adb (Expand_N_Attribute_Reference)
	<Attribute_Max_Size_In_Storage_Elements>: Apply the checks for
	universal integer contexts only in the default case.
	* exp_ch4.adb (Get_Size_For_Range): Move to library level.
	(Expand_N_Type_Conversion): If the operand has Universal_Integer
	type and the conversion requires an overflow check, try to do an
	intermediate conversion to a narrower type.

[-- Attachment #2: patch.diff --]
[-- Type: text/x-diff, Size: 8714 bytes --]

diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb
--- a/gcc/ada/exp_attr.adb
+++ b/gcc/ada/exp_attr.adb
@@ -4598,13 +4598,7 @@ package body Exp_Attr is
       ----------------------------------
 
       when Attribute_Max_Size_In_Storage_Elements => declare
-         Typ  : constant Entity_Id := Etype (N);
-         Attr : Node_Id;
-         Atyp : Entity_Id;
-
-         Conversion_Added : Boolean := False;
-         --  A flag which tracks whether the original attribute has been
-         --  wrapped inside a type conversion.
+         Typ : constant Entity_Id := Etype (N);
 
       begin
          --  If the prefix is X'Class, we transform it into a direct reference
@@ -4618,40 +4612,22 @@ package body Exp_Attr is
             return;
          end if;
 
-         Apply_Universal_Integer_Attribute_Checks (N);
-
-         --  The universal integer check may sometimes add a type conversion,
-         --  retrieve the original attribute reference from the expression.
-
-         Attr := N;
-
-         if Nkind (Attr) = N_Type_Conversion then
-            Attr := Expression (Attr);
-            Conversion_Added := True;
-         end if;
-
-         pragma Assert (Nkind (Attr) = N_Attribute_Reference);
-
          --  Heap-allocated controlled objects contain two extra pointers which
          --  are not part of the actual type. Transform the attribute reference
          --  into a runtime expression to add the size of the hidden header.
 
-         if Needs_Finalization (Ptyp)
-           and then not Header_Size_Added (Attr)
-         then
-            Set_Header_Size_Added (Attr);
-
-            Atyp := Etype (Attr);
+         if Needs_Finalization (Ptyp) and then not Header_Size_Added (N) then
+            Set_Header_Size_Added (N);
 
             --  Generate:
             --    P'Max_Size_In_Storage_Elements +
-            --      Atyp (Header_Size_With_Padding (Ptyp'Alignment))
+            --      Typ (Header_Size_With_Padding (Ptyp'Alignment))
 
-            Rewrite (Attr,
+            Rewrite (N,
               Make_Op_Add (Loc,
-                Left_Opnd  => Relocate_Node (Attr),
+                Left_Opnd  => Relocate_Node (N),
                 Right_Opnd =>
-                  Convert_To (Atyp,
+                  Convert_To (Typ,
                     Make_Function_Call (Loc,
                       Name                   =>
                         New_Occurrence_Of
@@ -4663,16 +4639,13 @@ package body Exp_Attr is
                             New_Occurrence_Of (Ptyp, Loc),
                           Attribute_Name => Name_Alignment))))));
 
-            Analyze_And_Resolve (Attr, Atyp);
-
-            --  Add a conversion to the target type
-
-            if not Conversion_Added then
-               Convert_To_And_Rewrite (Typ, Attr);
-            end if;
-
+            Analyze_And_Resolve (N, Typ);
             return;
          end if;
+
+         --  In the other cases apply the required checks
+
+         Apply_Universal_Integer_Attribute_Checks (N);
       end;
 
       --------------------


diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -172,6 +172,10 @@ package body Exp_Ch4 is
    --  routine is to find the real type by looking up the tree. We also
    --  determine if the operation must be rounded.
 
+   function Get_Size_For_Range (Lo, Hi : Uint) return Uint;
+   --  Return the size of a small signed integer type covering Lo .. Hi, the
+   --  main goal being to return a size lower than that of standard types.
+
    function Has_Inferable_Discriminants (N : Node_Id) return Boolean;
    --  Ada 2005 (AI-216): A view of an Unchecked_Union object has inferable
    --  discriminants if it has a constrained nominal type, unless the object
@@ -12270,6 +12274,41 @@ package body Exp_Ch4 is
          end;
       end if;
 
+      --  If the conversion is from Universal_Integer and requires an overflow
+      --  check, try to do an intermediate conversion to a narrower type first
+      --  without overflow check, in order to avoid doing the overflow check
+      --  in Universal_Integer, which can be a very large type.
+
+      if Operand_Type = Universal_Integer and then Do_Overflow_Check (N) then
+         declare
+            Lo, Hi, Siz : Uint;
+            OK          : Boolean;
+            Typ         : Entity_Id;
+
+         begin
+            Determine_Range (Operand, OK, Lo, Hi, Assume_Valid => True);
+
+            if OK then
+               Siz := Get_Size_For_Range (Lo, Hi);
+
+               --  We use the base type instead of the first subtype because
+               --  overflow checks are done in the base type, so this avoids
+               --  the need for useless conversions.
+
+               if Siz < System_Max_Integer_Size then
+                  Typ := Etype (Integer_Type_For (Siz, Uns => False));
+
+                  Convert_To_And_Rewrite (Typ, Operand);
+                  Analyze_And_Resolve
+                    (Operand, Typ, Suppress => Overflow_Check);
+
+                  Analyze_And_Resolve (N, Target_Type);
+                  goto Done;
+               end if;
+            end if;
+         end;
+      end if;
+
       --  Do validity check if validity checking operands
 
       if Validity_Checks_On and Validity_Check_Operands then
@@ -13328,6 +13367,54 @@ package body Exp_Ch4 is
       end if;
    end Fixup_Universal_Fixed_Operation;
 
+   ------------------------
+   -- Get_Size_For_Range --
+   ------------------------
+
+   function Get_Size_For_Range (Lo, Hi : Uint) return Uint is
+
+      function Is_OK_For_Range (Siz : Uint) return Boolean;
+      --  Return True if a signed integer with given size can cover Lo .. Hi
+
+      --------------------------
+      -- Is_OK_For_Range --
+      --------------------------
+
+      function Is_OK_For_Range (Siz : Uint) return Boolean is
+         B : constant Uint := Uint_2 ** (Siz - 1);
+
+      begin
+         --  Test B = 2 ** (size - 1) (can accommodate -B .. +(B - 1))
+
+         return Lo >= -B and then Hi >= -B and then Lo < B and then Hi < B;
+      end Is_OK_For_Range;
+
+   begin
+      --  This is (almost always) the size of Integer
+
+      if Is_OK_For_Range (Uint_32) then
+         return Uint_32;
+
+      --  Check 63
+
+      elsif Is_OK_For_Range (Uint_63) then
+         return Uint_63;
+
+      --  This is (almost always) the size of Long_Long_Integer
+
+      elsif Is_OK_For_Range (Uint_64) then
+         return Uint_64;
+
+      --  Check 127
+
+      elsif Is_OK_For_Range (Uint_127) then
+         return Uint_127;
+
+      else
+         return Uint_128;
+      end if;
+   end Get_Size_For_Range;
+
    ---------------------------------
    -- Has_Inferable_Discriminants --
    ---------------------------------
@@ -14135,58 +14222,6 @@ package body Exp_Ch4 is
       Typ    : constant Entity_Id := Etype (R);
       Tsiz   : constant Uint      := RM_Size (Typ);
 
-      function Get_Size_For_Range (Lo, Hi : Uint) return Uint;
-      --  Return the size of a small signed integer type covering Lo .. Hi.
-      --  The important thing is to return a size lower than that of Typ.
-
-      ------------------------
-      -- Get_Size_For_Range --
-      ------------------------
-
-      function Get_Size_For_Range (Lo, Hi : Uint) return Uint is
-
-         function Is_OK_For_Range (Siz : Uint) return Boolean;
-         --  Return True if a signed integer with given size can cover Lo .. Hi
-
-         --------------------------
-         -- Is_OK_For_Range --
-         --------------------------
-
-         function Is_OK_For_Range (Siz : Uint) return Boolean is
-            B : constant Uint := Uint_2 ** (Siz - 1);
-
-         begin
-            --  Test B = 2 ** (size - 1) (can accommodate -B .. +(B - 1))
-
-            return Lo >= -B and then Hi >= -B and then Lo < B and then Hi < B;
-         end Is_OK_For_Range;
-
-      begin
-         --  This is (almost always) the size of Integer
-
-         if Is_OK_For_Range (Uint_32) then
-            return Uint_32;
-
-         --  If the size of Typ is 64 then check 63
-
-         elsif Tsiz = Uint_64 and then Is_OK_For_Range (Uint_63) then
-            return Uint_63;
-
-         --  This is (almost always) the size of Long_Long_Integer
-
-         elsif Is_OK_For_Range (Uint_64) then
-            return Uint_64;
-
-         --  If the size of Typ is 128 then check 127
-
-         elsif Tsiz = Uint_128 and then Is_OK_For_Range (Uint_127) then
-            return Uint_127;
-
-         else
-            return Uint_128;
-         end if;
-      end Get_Size_For_Range;
-
       --  Local variables
 
       L          : Node_Id;



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

only message in thread, other threads:[~2021-04-29  8:03 UTC | newest]

Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2021-04-29  8:03 [Ada] Eliminate useless 128-bit overflow check for conversion Pierre-Marie de Rodat

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).