[gcc r11-5462] [Ada] To_Big_Integer and 128bits integers

Pierre-Marie de Rodat pmderodat@gcc.gnu.org
Fri Nov 27 09:18:11 GMT 2020


https://gcc.gnu.org/g:946a5b8d6464df2b3ed4ece8cc55872a72f7e36d

commit r11-5462-g946a5b8d6464df2b3ed4ece8cc55872a72f7e36d
Author: Arnaud Charlet <charlet@adacore.com>
Date:   Fri Oct 30 11:29:00 2020 -0400

    [Ada] To_Big_Integer and 128bits integers
    
    gcc/ada/
    
            * libgnat/s-genbig.ads, libgnat/s-genbig.adb (To_Bignum): New
            variant taking an Unsigned_128.
            * libgnat/a-nbnbin.adb (To_Big_Integer): Add support for 128
            bits signed and unsigned types.

Diff:
---
 gcc/ada/libgnat/a-nbnbin.adb |  4 ++--
 gcc/ada/libgnat/s-genbig.adb | 26 ++++++++++++++++++++++++--
 gcc/ada/libgnat/s-genbig.ads |  4 ++++
 3 files changed, 30 insertions(+), 4 deletions(-)

diff --git a/gcc/ada/libgnat/a-nbnbin.adb b/gcc/ada/libgnat/a-nbnbin.adb
index 01f41d87226..9e051d3d18d 100644
--- a/gcc/ada/libgnat/a-nbnbin.adb
+++ b/gcc/ada/libgnat/a-nbnbin.adb
@@ -177,7 +177,7 @@ package body Ada.Numerics.Big_Numbers.Big_Integers is
       function To_Big_Integer (Arg : Int) return Valid_Big_Integer is
          Result : Big_Integer;
       begin
-         Set_Bignum (Result, To_Bignum (Long_Long_Integer (Arg)));
+         Set_Bignum (Result, To_Bignum (Long_Long_Long_Integer (Arg)));
          return Result;
       end To_Big_Integer;
 
@@ -205,7 +205,7 @@ package body Ada.Numerics.Big_Numbers.Big_Integers is
       function To_Big_Integer (Arg : Int) return Valid_Big_Integer is
          Result : Big_Integer;
       begin
-         Set_Bignum (Result, To_Bignum (Unsigned_64 (Arg)));
+         Set_Bignum (Result, To_Bignum (Unsigned_128 (Arg)));
          return Result;
       end To_Big_Integer;
 
diff --git a/gcc/ada/libgnat/s-genbig.adb b/gcc/ada/libgnat/s-genbig.adb
index 12167acd6f8..bf222acadc4 100644
--- a/gcc/ada/libgnat/s-genbig.adb
+++ b/gcc/ada/libgnat/s-genbig.adb
@@ -1193,7 +1193,7 @@ package body System.Generic_Bignums is
       return To_Bignum (Long_Long_Long_Integer (X));
    end To_Bignum;
 
-   function To_Bignum (X : Unsigned_64) return Big_Integer is
+   function To_Bignum (X : Unsigned_128) return Big_Integer is
    begin
       if X = 0 then
          return Allocate_Big_Integer ((1 .. 0 => <>), False);
@@ -1205,11 +1205,33 @@ package body System.Generic_Bignums is
 
       --  Two word result
 
-      else
+      elsif Shift_Right (X, 32) < 2 ** 32 then
          return Allocate_Big_Integer ((SD (X / Base), SD (X mod Base)), False);
+
+      --  Three or four word result
+
+      else
+         declare
+            Vector : Digit_Vector (1 .. 4);
+            High   : constant Unsigned_64 := Unsigned_64 (Shift_Right (X, 64));
+            Low    : constant Unsigned_64 :=
+              Unsigned_64 (X and 16#FFFF_FFFF_FFFF_FFFF#);
+
+         begin
+            Vector (1) := SD (High / Base);
+            Vector (2) := SD (High mod Base);
+            Vector (3) := SD (Low / Base);
+            Vector (4) := SD (Low mod Base);
+            return Normalize (Vector, False);
+         end;
       end if;
    end To_Bignum;
 
+   function To_Bignum (X : Unsigned_64) return Big_Integer is
+   begin
+      return To_Bignum (Unsigned_128 (X));
+   end To_Bignum;
+
    ---------------
    -- To_String --
    ---------------
diff --git a/gcc/ada/libgnat/s-genbig.ads b/gcc/ada/libgnat/s-genbig.ads
index 81e3843b550..be8340ed894 100644
--- a/gcc/ada/libgnat/s-genbig.ads
+++ b/gcc/ada/libgnat/s-genbig.ads
@@ -109,6 +109,10 @@ package System.Generic_Bignums is
    --  Convert Unsigned_64 to a big integer. No exception can be raised for any
    --  input argument.
 
+   function To_Bignum (X : Interfaces.Unsigned_128) return Big_Integer;
+   --  Convert Unsigned_128 to a big integer. No exception can be raised for
+   --  any input argument.
+
    function From_Bignum (X : Bignum) return Long_Long_Integer;
    --  Convert Bignum to Long_Long_Integer. Constraint_Error raised with
    --  appropriate message if value is out of range of Long_Long_Integer.


More information about the Gcc-cvs mailing list