From: Arnaud Charlet <charlet@adacore.com>
Date: Tue, 11 Aug 2020 19:42:46 +0000 (-0400)
Subject: [Ada] Take advantage of Long_Long_Long_Integer in From_String
X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=44f30851a734c3ce962a44a8a0a2bf3f6d564204;p=gcc.git

[Ada] Take advantage of Long_Long_Long_Integer in From_String

gcc/ada/

	* libgnat/a-nbnbin.adb (From_String): Take advantage of
	Long_Long_Long_Integer.
	* libgnat/s-genbig.ads, libgnat/s-genbig.adb (To_Bignum): New
	function taking a Long_Long_Long_Integer.
---

diff --git a/gcc/ada/libgnat/a-nbnbin.adb b/gcc/ada/libgnat/a-nbnbin.adb
index b919d86490e..70df2c26f48 100644
--- a/gcc/ada/libgnat/a-nbnbin.adb
+++ b/gcc/ada/libgnat/a-nbnbin.adb
@@ -238,8 +238,8 @@ package body Ada.Numerics.Big_Numbers.Big_Integers is
    function From_String (Arg : String) return Big_Integer is
       Result : Big_Integer;
    begin
-      --  ??? only support Long_Long_Integer, good enough for now
-      Set_Bignum (Result, To_Bignum (Long_Long_Integer'Value (Arg)));
+      --  ??? only support Long_Long_Long_Integer, good enough for now
+      Set_Bignum (Result, To_Bignum (Long_Long_Long_Integer'Value (Arg)));
       return Result;
    end From_String;
 
diff --git a/gcc/ada/libgnat/s-genbig.adb b/gcc/ada/libgnat/s-genbig.adb
index 71aff9b6f6f..12167acd6f8 100644
--- a/gcc/ada/libgnat/s-genbig.adb
+++ b/gcc/ada/libgnat/s-genbig.adb
@@ -1120,7 +1120,33 @@ package body System.Generic_Bignums is
    -- To_Bignum --
    ---------------
 
-   function To_Bignum (X : Long_Long_Integer) return Big_Integer is
+   function To_Bignum (X : Long_Long_Long_Integer) return Big_Integer is
+
+      function Convert_128
+        (X : Long_Long_Long_Integer; Neg : Boolean) return Big_Integer;
+      --  Convert a 128 bits natural integer to a Big_Integer
+
+      -----------------
+      -- Convert_128 --
+      -----------------
+
+      function Convert_128
+        (X : Long_Long_Long_Integer; Neg : Boolean) return Big_Integer
+      is
+         Vector : Digit_Vector (1 .. 4);
+         High   : constant Unsigned_64 :=
+           Unsigned_64 (Shift_Right (Unsigned_128 (X), 64));
+         Low    : constant Unsigned_64 :=
+           Unsigned_64 (Unsigned_128 (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, Neg);
+      end Convert_128;
+
    begin
       if X = 0 then
          return Allocate_Big_Integer ((1 .. 0 => <>), False);
@@ -1130,23 +1156,43 @@ package body System.Generic_Bignums is
       elsif X in -(2 ** 32 - 1) .. +(2 ** 32 - 1) then
          return Allocate_Big_Integer ((1 => SD (abs X)), X < 0);
 
-      --  Largest negative number annoyance
+      --  Large negative number annoyance
 
-      elsif X = Long_Long_Integer'First then
+      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
+         return Allocate_Big_Integer ((2 ** 31, 0, 0, 0), True);
+
       --  Other negative numbers
 
       elsif X < 0 then
-         return Allocate_Big_Integer
-                  ((SD ((-X) / Base), SD ((-X) mod Base)), True);
+         if Long_Long_Long_Integer'Size = 64 then
+            return Allocate_Big_Integer
+                     ((SD ((-X) / Base), SD ((-X) mod Base)), True);
+         else
+            return Convert_128 (-X, True);
+         end if;
 
       --  Positive numbers
+
       else
-         return Allocate_Big_Integer ((SD (X / Base), SD (X mod Base)), False);
+         if Long_Long_Long_Integer'Size = 64 then
+            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;
 
+   function To_Bignum (X : Long_Long_Integer) return Big_Integer is
+   begin
+      return To_Bignum (Long_Long_Long_Integer (X));
+   end To_Bignum;
+
    function To_Bignum (X : Unsigned_64) return Big_Integer is
    begin
       if X = 0 then
diff --git a/gcc/ada/libgnat/s-genbig.ads b/gcc/ada/libgnat/s-genbig.ads
index 003a8fdb1e9..81e3843b550 100644
--- a/gcc/ada/libgnat/s-genbig.ads
+++ b/gcc/ada/libgnat/s-genbig.ads
@@ -101,6 +101,10 @@ package System.Generic_Bignums is
    --  Convert Long_Long_Integer to a big integer. No exception can be raised
    --  for any input argument.
 
+   function To_Bignum (X : Long_Long_Long_Integer) return Big_Integer;
+   --  Convert Long_Long_Long_Integer to a big integer. No exception can be
+   --  raised.
+
    function To_Bignum (X : Interfaces.Unsigned_64) return Big_Integer;
    --  Convert Unsigned_64 to a big integer. No exception can be raised for any
    --  input argument.