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.

diff --git a/gcc/ada/libgnat/a-nbnbin.adb b/gcc/ada/libgnat/a-nbnbin.adb
index edfd04e1ca37f031315ee9ef836ec544d25c24a7..090f408f2d711471aecc9a3c85399f524bbb084e 100644 (file)
--- 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 85dc40b87d3676bb25e250baeb46b3511298793f..183ce3262f020ca31e915761502a13418c479a29 100644 (file)
--- 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 9cf944cc1b1c94de14012febe33d0996c403e2ae..167f24faafb6bf765fa80788f3c3d12b048b04a9 100644 (file)
--- 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;