From: Arnaud Charlet <charlet@adacore.com>
Date: Fri, 30 Oct 2020 15:29:00 +0000 (-0400)
Subject: [Ada] To_Big_Integer and 128bits integers
X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=946a5b8d6464df2b3ed4ece8cc55872a72f7e36d;p=gcc.git

[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 --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.