[Ada] Fix small inefficiency in previous change to expander

2020-06-18  Eric Botcazou  <ebotcazou@adacore.com>

gcc/ada/

	* exp_ch4.adb (Get_Size_For_Range): Only make sure to return a
	size lower than that of the original type if possible.
	* libgnat/s-rannum.adb (Random_Discrete): Back out optimization
	added for 32-bit types.

diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index 1302009fcdd1fc92aba718a1877360054887334e..2adebb6f54caaf65eb593642da6167b0f8b36734 100644 (file)
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -13919,28 +13919,50 @@ package body Exp_Ch4 is
       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
+      --  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 Nat is
-         B : Uint;
-         S : Nat;
+
+         function Is_OK_For_Range (Siz : Nat) 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 : Nat) 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
-         S := 1;
-         B := Uint_1;
+         --  This is (almost always) the size of Integer
 
-         --  S = size, B = 2 ** (size - 1) (can accommodate -B .. +(B - 1))
+         if Is_OK_For_Range (32) then
+            return 32;
 
-         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;
+         --  If the size of Typ is 64 then check 63
+
+         elsif RM_Size (Typ) = 64 and then Is_OK_For_Range (63) then
+            return 63;
+
+         --  This is (almost always) the size of Long_Long_Integer
 
-         return S;
+         elsif Is_OK_For_Range (64) then
+            return 64;
+
+         else
+            return 128;
+         end if;
       end Get_Size_For_Range;
 
       --  Local variables

diff --git a/gcc/ada/libgnat/s-rannum.adb b/gcc/ada/libgnat/s-rannum.adb
index 8824a724f781d89c249a3141bcfa311945ca64a1..baf5cbe97cbf72dc50ea2a256af04534f9fbb4d5 100644 (file)
--- a/gcc/ada/libgnat/s-rannum.adb
+++ b/gcc/ada/libgnat/s-rannum.adb
@@ -402,10 +402,11 @@ is
       elsif Max < Min then
          raise Constraint_Error;
 
+      --  In the 64-bit case, we have to be careful since not all 64-bit
+      --  unsigned values are representable in GNAT's universal integer.
+
       elsif Result_Subtype'Base'Size > 32 then
          declare
-            --  In the 64-bit case, we have to be careful since not all 64-bit
-            --  unsigned values are representable in GNAT's universal integer.
             --  Ignore unequal-size warnings since GNAT's handling is correct.
 
             pragma Warnings ("Z");
@@ -422,8 +423,7 @@ is
 
          begin
             if N = 0 then
-               X := Random (Gen);
-               return Conv_To_Result (Conv_To_Unsigned (Min) + X);
+               return Conv_To_Result (Conv_To_Unsigned (Min) + Random (Gen));
 
             else
                Slop := Unsigned_64'Last rem N + 1;
@@ -437,73 +437,31 @@ is
             end if;
          end;
 
-      else
-         declare
-            --  In the 32-bit case, unlike the above case, we need to handle
-            --  both integer and enumeration types. If the values of the result
-            --  subtype are contiguous, then we can still use the above trick.
-            --  Otherwise we need to rely on 'Pos and 'Val in the computation,
-            --  which is more costly since it will thus be done in universal
-            --  integer. And ignore unequal-size warnings in this case too.
+      --  In the 32-bit case, we need to handle both integer and enumeration
+      --  types and, therefore, rely on 'Pos and 'Val in the computation.
 
-            pragma Warnings ("Z");
-            function Conv_To_Unsigned is
-               new Unchecked_Conversion (Result_Subtype'Base, Unsigned_32);
-            function Conv_To_Result is
-               new Unchecked_Conversion (Unsigned_32, Result_Subtype'Base);
-            pragma Warnings ("z");
-
-            Contiguous : constant Boolean :=
-                              Result_Subtype'Pos (Result_Subtype'Last) -
-                                Result_Subtype'Pos (Result_Subtype'First)
-                                =
-                              Result_Subtype'Enum_Rep (Result_Subtype'Last) -
-                                Result_Subtype'Enum_Rep (Result_Subtype'First);
+      elsif Result_Subtype'Pos (Max) - Result_Subtype'Pos (Min) = 2 ** 32 - 1
+      then
+         return Result_Subtype'Val
+           (Result_Subtype'Pos (Min) + Unsigned_32'Pos (Random (Gen)));
 
-            N, X, Slop : Unsigned_32;
+      else
+         declare
+            N    : constant Unsigned_32 :=
+                     Unsigned_32 (Result_Subtype'Pos (Max) -
+                                    Result_Subtype'Pos (Min) + 1);
+            Slop : constant Unsigned_32 := Unsigned_32'Last rem N + 1;
+            X    : Unsigned_32;
 
          begin
-            if Contiguous then
-               N := Conv_To_Unsigned (Max) - Conv_To_Unsigned (Min) + 1;
-
-               if N = 0 then
-                  X := Random (Gen);
-                  return Conv_To_Result (Conv_To_Unsigned (Min) + X);
-
-               else
-                  Slop := Unsigned_32'Last rem N + 1;
-
-                  loop
-                     X := Random (Gen);
-                     exit when Slop = N or else X <= Unsigned_32'Last - Slop;
-                  end loop;
-
-                  return Conv_To_Result (Conv_To_Unsigned (Min) + X rem N);
-               end if;
-
-            else
-               N := Unsigned_32 (Result_Subtype'Pos (Max) -
-                                   Result_Subtype'Pos (Min) + 1);
-
-               if N = 0 then
-                  X := Random (Gen);
-                  return
-                    Result_Subtype'Val
-                      (Result_Subtype'Pos (Min) + Unsigned_32'Pos (X));
-
-               else
-                  Slop := Unsigned_32'Last rem N + 1;
-
-                  loop
-                     X := Random (Gen);
-                     exit when Slop = N or else X <= Unsigned_32'Last - Slop;
-                  end loop;
+            loop
+               X := Random (Gen);
+               exit when Slop = N or else X <= Unsigned_32'Last - Slop;
+            end loop;
 
-                  return
-                    Result_Subtype'Val
-                      (Result_Subtype'Pos (Min) + Unsigned_32'Pos (X rem N));
-               end if;
-            end if;
+            return
+              Result_Subtype'Val
+                (Result_Subtype'Pos (Min) + Unsigned_32'Pos (X rem N));
          end;
       end if;
    end Random_Discrete;