diff options
author | Eric Botcazou <ebotcazou@adacore.com> | 2023-02-01 14:15:19 +0100 |
---|---|---|
committer | Marc Poulhiès <poulhies@adacore.com> | 2023-05-22 10:44:08 +0200 |
commit | 05e628c249e56ae337f87fc2fd9be4fff16b6282 (patch) | |
tree | 8775047e2499ad5e554fce27795d1ed2d292d407 /gcc | |
parent | 159977048dcdf3d4f7f4c7bd0186be411464cd0f (diff) | |
download | gcc-05e628c249e56ae337f87fc2fd9be4fff16b6282.zip gcc-05e628c249e56ae337f87fc2fd9be4fff16b6282.tar.gz gcc-05e628c249e56ae337f87fc2fd9be4fff16b6282.tar.bz2 |
ada: Implement conversions from Big_Integer to large types
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.
Diffstat (limited to 'gcc')
-rw-r--r-- | gcc/ada/libgnat/a-nbnbin.adb | 6 | ||||
-rw-r--r-- | gcc/ada/libgnat/s-genbig.adb | 100 | ||||
-rw-r--r-- | 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 edfd04e..090f408 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 85dc40b..183ce32 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 9cf944c..167f24f 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; |