* [COMMITTED] ada: Implement conversions from Big_Integer to large types
@ 2023-05-22 8:49 Marc Poulhiès
0 siblings, 0 replies; only message in thread
From: Marc Poulhiès @ 2023-05-22 8:49 UTC (permalink / raw)
To: gcc-patches; +Cc: Eric Botcazou
From: Eric Botcazou <ebotcazou@adacore.com>
This implements the conversion from Big_Integer to Long_Long_Unsigned on
32-bit platforms and to Long_Long_Long_{Integer,Unsigned} on 64-bit ones.
gcc/ada/
* libgnat/s-genbig.ads (From_Bignum): New overloaded declarations.
* libgnat/s-genbig.adb (LLLI): New subtype.
(LLLI_Is_128): New boolean constant.
(From_Bignum): Change the return type of the signed implementation
to Long_Long_Long_Integer and add support for the case where its
size is 128 bits. Add a wrapper around it for Long_Long_Integer.
Add an unsigned implementation returning Unsigned_128 and a wrapper
around it for Unsigned_64.
(To_Bignum): Test LLLI_Is_128 instead of its size.
(To_String.Image): Add qualification to calls to From_Bignum.
* libgnat/a-nbnbin.adb (To_Big_Integer): Likewise.
(Signed_Conversions.From_Big_Integer): Likewise.
(Unsigned_Conversions): Likewise.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/libgnat/a-nbnbin.adb | 6 +--
gcc/ada/libgnat/s-genbig.adb | 100 +++++++++++++++++++++++++++++------
gcc/ada/libgnat/s-genbig.ads | 12 +++++
3 files changed, 98 insertions(+), 20 deletions(-)
diff --git a/gcc/ada/libgnat/a-nbnbin.adb b/gcc/ada/libgnat/a-nbnbin.adb
index edfd04e1ca3..090f408f2d7 100644
--- a/gcc/ada/libgnat/a-nbnbin.adb
+++ b/gcc/ada/libgnat/a-nbnbin.adb
@@ -160,7 +160,7 @@ package body Ada.Numerics.Big_Numbers.Big_Integers is
function To_Integer (Arg : Valid_Big_Integer) return Integer is
begin
- return Integer (From_Bignum (Get_Bignum (Arg)));
+ return Integer (Long_Long_Integer'(From_Bignum (Get_Bignum (Arg))));
end To_Integer;
------------------------
@@ -186,7 +186,7 @@ package body Ada.Numerics.Big_Numbers.Big_Integers is
function From_Big_Integer (Arg : Valid_Big_Integer) return Int is
begin
- return Int (From_Bignum (Get_Bignum (Arg)));
+ return Int (Long_Long_Long_Integer'(From_Bignum (Get_Bignum (Arg))));
end From_Big_Integer;
end Signed_Conversions;
@@ -214,7 +214,7 @@ package body Ada.Numerics.Big_Numbers.Big_Integers is
function From_Big_Integer (Arg : Valid_Big_Integer) return Int is
begin
- return Int (From_Bignum (Get_Bignum (Arg)));
+ return Int (Unsigned_128'(From_Bignum (Get_Bignum (Arg))));
end From_Big_Integer;
end Unsigned_Conversions;
diff --git a/gcc/ada/libgnat/s-genbig.adb b/gcc/ada/libgnat/s-genbig.adb
index 85dc40b87d3..183ce3262f0 100644
--- a/gcc/ada/libgnat/s-genbig.adb
+++ b/gcc/ada/libgnat/s-genbig.adb
@@ -49,6 +49,10 @@ package body System.Generic_Bignums is
-- Compose double digit value from two single digit values
subtype LLI is Long_Long_Integer;
+ subtype LLLI is Long_Long_Long_Integer;
+
+ LLLI_Is_128 : constant Boolean := Long_Long_Long_Integer'Size = 128;
+ -- True if Long_Long_Long_Integer is 128-bit large
One_Data : constant Digit_Vector (1 .. 1) := [1];
-- Constant one
@@ -1041,22 +1045,48 @@ package body System.Generic_Bignums is
-- From_Bignum --
-----------------
- function From_Bignum (X : Bignum) return Long_Long_Integer is
+ function From_Bignum (X : Bignum) return Long_Long_Long_Integer is
begin
if X.Len = 0 then
return 0;
elsif X.Len = 1 then
- return (if X.Neg then -LLI (X.D (1)) else LLI (X.D (1)));
+ return (if X.Neg then -LLLI (X.D (1)) else LLLI (X.D (1)));
elsif X.Len = 2 then
declare
Mag : constant DD := X.D (1) & X.D (2);
begin
- if X.Neg and then Mag <= 2 ** 63 then
- return -LLI (Mag);
- elsif Mag < 2 ** 63 then
- return LLI (Mag);
+ if X.Neg and then (Mag <= 2 ** 63 or else LLLI_Is_128) then
+ return -LLLI (Mag);
+ elsif Mag < 2 ** 63 or else LLLI_Is_128 then
+ return LLLI (Mag);
+ end if;
+ end;
+
+ elsif X.Len = 3 and then LLLI_Is_128 then
+ declare
+ Hi : constant SD := X.D (1);
+ Lo : constant DD := X.D (2) & X.D (3);
+ Mag : constant Unsigned_128 :=
+ Shift_Left (Unsigned_128 (Hi), 64) + Unsigned_128 (Lo);
+ begin
+ return (if X.Neg then -LLLI (Mag) else LLLI (Mag));
+ end;
+
+ elsif X.Len = 4 and then LLLI_Is_128 then
+ declare
+ Hi : constant DD := X.D (1) & X.D (2);
+ Lo : constant DD := X.D (3) & X.D (4);
+ Mag : constant Unsigned_128 :=
+ Shift_Left (Unsigned_128 (Hi), 64) + Unsigned_128 (Lo);
+ begin
+ if X.Neg
+ and then (Hi < 2 ** 63 or else (Hi = 2 ** 63 and then Lo = 0))
+ then
+ return -LLLI (Mag);
+ elsif Hi < 2 ** 63 then
+ return LLLI (Mag);
end if;
end;
end if;
@@ -1064,6 +1094,44 @@ package body System.Generic_Bignums is
raise Constraint_Error with "expression value out of range";
end From_Bignum;
+ function From_Bignum (X : Bignum) return Long_Long_Integer is
+ begin
+ return Long_Long_Integer (Long_Long_Long_Integer'(From_Bignum (X)));
+ end From_Bignum;
+
+ function From_Bignum (X : Bignum) return Unsigned_128 is
+ begin
+ if X.Neg then
+ null;
+
+ elsif X.Len = 0 then
+ return 0;
+
+ elsif X.Len = 1 then
+ return Unsigned_128 (X.D (1));
+
+ elsif X.Len = 2 then
+ return Unsigned_128 (DD'(X.D (1) & X.D (2)));
+
+ elsif X.Len = 3 and then LLLI_Is_128 then
+ return
+ Shift_Left (Unsigned_128 (X.D (1)), 64) +
+ Unsigned_128 (DD'(X.D (2) & X.D (3)));
+
+ elsif X.Len = 4 and then LLLI_Is_128 then
+ return
+ Shift_Left (Unsigned_128 (DD'(X.D (1) & X.D (2))), 64) +
+ Unsigned_128 (DD'(X.D (3) & X.D (4)));
+ end if;
+
+ raise Constraint_Error with "expression value out of range";
+ end From_Bignum;
+
+ function From_Bignum (X : Bignum) return Unsigned_64 is
+ begin
+ return Unsigned_64 (Unsigned_128'(From_Bignum (X)));
+ end From_Bignum;
+
-------------------------
-- Bignum_In_LLI_Range --
-------------------------
@@ -1161,29 +1229,27 @@ package body System.Generic_Bignums is
elsif X = -2 ** 63 then
return Allocate_Big_Integer ([2 ** 31, 0], True);
- elsif Long_Long_Long_Integer'Size = 128
- and then X = Long_Long_Long_Integer'First
- then
+ elsif LLLI_Is_128 and then X = Long_Long_Long_Integer'First then
return Allocate_Big_Integer ([2 ** 31, 0, 0, 0], True);
-- Other negative numbers
elsif X < 0 then
- if Long_Long_Long_Integer'Size = 64 then
+ if LLLI_Is_128 then
+ return Convert_128 (-X, True);
+ else
return Allocate_Big_Integer
((SD ((-X) / Base), SD ((-X) mod Base)), True);
- else
- return Convert_128 (-X, True);
end if;
-- Positive numbers
else
- if Long_Long_Long_Integer'Size = 64 then
+ if LLLI_Is_128 then
+ return Convert_128 (X, False);
+ else
return Allocate_Big_Integer
((SD (X / Base), SD (X mod Base)), False);
- else
- return Convert_128 (X, False);
end if;
end if;
end To_Bignum;
@@ -1285,7 +1351,7 @@ package body System.Generic_Bignums is
function Image (Arg : Bignum) return String is
begin
if Big_LT (Arg, Big_Base'Unchecked_Access) then
- return [Hex_Chars (Natural (From_Bignum (Arg)))];
+ return [Hex_Chars (Natural (LLI'(From_Bignum (Arg))))];
else
declare
Div : aliased Big_Integer;
@@ -1294,7 +1360,7 @@ package body System.Generic_Bignums is
begin
Div_Rem (Arg, Big_Base'Unchecked_Access, Div, Remain);
- R := Natural (From_Bignum (To_Bignum (Remain)));
+ R := Natural (LLI'(From_Bignum (To_Bignum (Remain))));
Free_Big_Integer (Remain);
return S : constant String :=
diff --git a/gcc/ada/libgnat/s-genbig.ads b/gcc/ada/libgnat/s-genbig.ads
index 9cf944cc1b1..167f24faafb 100644
--- a/gcc/ada/libgnat/s-genbig.ads
+++ b/gcc/ada/libgnat/s-genbig.ads
@@ -117,6 +117,18 @@ package System.Generic_Bignums is
-- Convert Bignum to Long_Long_Integer. Constraint_Error raised with
-- appropriate message if value is out of range of Long_Long_Integer.
+ function From_Bignum (X : Bignum) return Long_Long_Long_Integer;
+ -- Convert Bignum to Long_Long_Long_Integer. Constraint_Error raised with
+ -- appropriate message if value is out of range of Long_Long_Long_Integer.
+
+ function From_Bignum (X : Bignum) return Interfaces.Unsigned_64;
+ -- Convert Bignum to Unsigned_64. Constraint_Error raised with
+ -- appropriate message if value is out of range of Unsigned_64.
+
+ function From_Bignum (X : Bignum) return Interfaces.Unsigned_128;
+ -- Convert Bignum to Unsigned_128. Constraint_Error raised with
+ -- appropriate message if value is out of range of Unsigned_128.
+
function To_String
(X : Bignum; Width : Natural := 0; Base : Positive := 10)
return String;
--
2.40.0
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2023-05-22 8:49 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2023-05-22 8:49 [COMMITTED] ada: Implement conversions from Big_Integer to large types Marc Poulhiès
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).