[Ada] Eliminate useless 128-bit overflow check for conversion

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.

diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb
index b3ac7b7a9fc2834bca089d613dd2cff16d756b9a..25bf0f76f2602fce96bc71498c2c44bb832958cf 100644 (file)
--- 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
index 0ca03b1c889bc950b3d1757b08dcc17b2ec3fed1..143cce137399f47edfbc59a17dc557592803b689 100644 (file)
--- 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;