aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorEric Botcazou <ebotcazou@adacore.com>2020-04-26 12:46:03 +0200
committerPierre-Marie de Rodat <derodat@adacore.com>2020-06-18 05:08:37 -0400
commit2ab42c70a62fe10f40a623adf48002ac8cdb9bf8 (patch)
tree678afe6359395f39320bc4b5a19193c1d7bd649a
parent424ce99fb53c994ba56f99e4b5513dc19e897463 (diff)
downloadgcc-2ab42c70a62fe10f40a623adf48002ac8cdb9bf8.zip
gcc-2ab42c70a62fe10f40a623adf48002ac8cdb9bf8.tar.gz
gcc-2ab42c70a62fe10f40a623adf48002ac8cdb9bf8.tar.bz2
[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.
-rw-r--r--gcc/ada/exp_ch4.adb44
-rw-r--r--gcc/ada/libgnat/s-rannum.adb90
2 files changed, 57 insertions, 77 deletions
diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index 1302009..2adebb6 100644
--- 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 8824a72..baf5cbe 100644
--- 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;