aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorEric Botcazou <ebotcazou@adacore.com>2020-01-07 23:04:13 +0100
committerPierre-Marie de Rodat <derodat@adacore.com>2020-06-03 06:01:34 -0400
commiteebcb5618002bcd30219203ce4c59b0ef809f236 (patch)
treef15378fd2ea1903a6a23c123a5a651f635fa91bd
parent8f8fc3840e9ac62a053fc8ebe0d25955a9ecf290 (diff)
downloadgcc-eebcb5618002bcd30219203ce4c59b0ef809f236.zip
gcc-eebcb5618002bcd30219203ce4c59b0ef809f236.tar.gz
gcc-eebcb5618002bcd30219203ce4c59b0ef809f236.tar.bz2
[Ada] More efficient System.Random_Numbers.Random_Discrete for 32-bit types
2020-06-03 Eric Botcazou <ebotcazou@adacore.com> gcc/ada/ * libgnat/s-rannum.adb (Random_Discrete): In the 32-bit case, use the same linear implementation as in the 64-bit case when the type has a contiguous representation.
-rw-r--r--gcc/ada/libgnat/s-rannum.adb89
1 files changed, 67 insertions, 22 deletions
diff --git a/gcc/ada/libgnat/s-rannum.adb b/gcc/ada/libgnat/s-rannum.adb
index 7f42d51..8824a72 100644
--- a/gcc/ada/libgnat/s-rannum.adb
+++ b/gcc/ada/libgnat/s-rannum.adb
@@ -404,10 +404,9 @@ is
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 root_integer type.
- -- Ignore different-size warnings here since GNAT's handling
- -- is correct.
+ -- 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");
function Conv_To_Unsigned is
@@ -423,7 +422,8 @@ is
begin
if N = 0 then
- return Conv_To_Result (Conv_To_Unsigned (Min) + Random (Gen));
+ X := Random (Gen);
+ return Conv_To_Result (Conv_To_Unsigned (Min) + X);
else
Slop := Unsigned_64'Last rem N + 1;
@@ -437,28 +437,73 @@ is
end if;
end;
- 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)));
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;
+ -- 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.
+
+ 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);
+
+ N, X, Slop : Unsigned_32;
begin
- loop
- X := Random (Gen);
- exit when Slop = N or else X <= Unsigned_32'Last - Slop;
- end loop;
+ 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;
- return
- Result_Subtype'Val
- (Result_Subtype'Pos (Min) + Unsigned_32'Pos (X rem N));
+ 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;
+
+ return
+ Result_Subtype'Val
+ (Result_Subtype'Pos (Min) + Unsigned_32'Pos (X rem N));
+ end if;
+ end if;
end;
end if;
end Random_Discrete;