scanner: use grt-fcvt for radix conversion.

1 files changed, 36 insertions, 375 deletions

diff --git a/src/vhdl/scanner-scan_literal.adb b/src/vhdl/scanner-scan_literal.adb
index 74acf44d5..74af66fff 100644
--- a/src/vhdl/scanner-scan_literal.adb
+++ b/src/vhdl/scanner-scan_literal.adb
@@ -15,7 +15,9 @@
 --  along with GHDL; see the file COPYING.  If not, write to the Free
 --  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
 --  02111-1307, USA.
-with Ada.Unchecked_Conversion;
+
+with Interfaces; use Interfaces;
+with Grt.Fcvt; use Grt.Fcvt;
 
 separate (Scanner)
 
@@ -29,329 +31,9 @@ separate (Scanner)
 -- BASED_LITERAL ::= BASE # BASED_INTEGER [ . BASED_INTEGER ] # EXPONENT
 -- BASE ::= INTEGER
 procedure Scan_Literal is
-   --  The base of an E_NUM is 2**16.
-   --  Type Uint16 is the type of a digit.
-   type Uint16 is mod 2 ** 16;
-
-   type Uint32 is mod 2 ** 32;
-
-   --  Type of the exponent.
-   type Sint16 is range -2 ** 15 .. 2 ** 15 - 1;
-
-   --  Number of digits in a E_NUM.
-   --  We want at least 64bits of precision, so at least 5 digits of 16 bits
-   --  are required.
-   Nbr_Digits : constant Sint16 := 5;
-   subtype Digit_Range is Sint16 range 0 .. Nbr_Digits - 1;
-
-   type Uint16_Array is array (Sint16 range <>) of Uint16;
-
-   --  The value of an E_NUM is (S(N-1)|S(N-2) .. |S(0))* 2**(16*E)
-   --  where '|' is concatenation.
-   type E_Num is record
-      S : Uint16_Array (Digit_Range);
-      E : Sint16;
-   end record;
-
-   E_Zero : constant E_Num := (S => (others => 0), E => 0);
-   E_One  : constant E_Num := (S => (0 => 1, others => 0), E => 0);
-
-   --  Compute RES = E * B + V.
-   --  RES and E can be the same object.
-   procedure Bmul (Res : out E_Num; E : E_Num; V : Uint16; B : Uint16);
-
-   --  Convert to integer.
-   procedure Fix (Res : out Iir_Int64; Ok : out Boolean; E : E_Num);
-
-   --  RES := A * B
-   --  RES can be A or B.
-   procedure Mul (Res : out E_Num; A, B : E_Num);
-
-   --  RES := A / B.
-   --  RES can be A.
-   --  May raise constraint error.
-   procedure Div (Res : out E_Num; A, B: E_Num);
-
-   --  Convert V to an E_Num.
-   function To_E_Num (V : Uint16) return E_Num;
-
-   --  Convert E to RES.
-   procedure To_Float (Res : out Iir_Fp64; Ok : out Boolean; E : E_Num);
-
-   procedure Bmul (Res : out E_Num; E : E_Num; V : Uint16; B : Uint16)
-   is
-      --  The carry.
-      C : Uint32;
-   begin
-      --  Only consider V if E is not scaled (otherwise V is not significant).
-      if E.E = 0 then
-         C := Uint32 (V);
-      else
-         C := 0;
-      end if;
-
-      --  Multiply and propagate the carry.
-      for I in Digit_Range loop
-         C := Uint32 (E.S (I)) * Uint32 (B) + C;
-         Res.S (I) := Uint16 (C mod Uint16'Modulus);
-         C := C / Uint16'Modulus;
-      end loop;
-
-      --  There is a carry, shift.
-      if C /= 0 then
-         --  ERR: Possible overflow.
-         Res.E := E.E + 1;
-         for I in 0 .. Nbr_Digits - 2 loop
-            Res.S (I) := Res.S (I + 1);
-         end loop;
-         Res.S (Nbr_Digits - 1) := Uint16 (C);
-      else
-         Res.E := E.E;
-      end if;
-   end Bmul;
-
-   type Uint64 is mod 2 ** 64;
-   function Shift_Left (Value : Uint64; Amount: Natural) return Uint64;
-   function Shift_Left (Value : Uint16; Amount: Natural) return Uint16;
-   pragma Import (Intrinsic, Shift_Left);
-
-   function Shift_Right (Value : Uint16; Amount: Natural) return Uint16;
-   pragma Import (Intrinsic, Shift_Right);
-
-   function Unchecked_Conversion is new Ada.Unchecked_Conversion
-     (Source => Uint64, Target => Iir_Int64);
-
-   procedure Fix (Res : out Iir_Int64; Ok : out Boolean; E : E_Num)
-   is
-      R : Uint64;
-      M : Sint16;
-   begin
-      --  Find the most significant digit.
-      M := -1;
-      for I in reverse Digit_Range loop
-         if E.S (I) /= 0 then
-            M := I;
-            exit;
-         end if;
-      end loop;
-
-      --  Handle the easy 0 case.
-      --  The case M = -1 is handled below, in the normal flow.
-      if M + E.E < 0 then
-         Res := 0;
-         Ok := True;
-         return;
-      end if;
-
-      --  Handle overflow.
-      --  4 is the number of uint16 in a uint64.
-      if M + E.E >= 4 then
-         Ok := False;
-         return;
-      end if;
-
-      --  Convert
-      R := 0;
-      for I in 0 .. M loop
-         R := R or Shift_Left (Uint64 (E.S (I)), 16 * Natural (E.E + I));
-      end loop;
-      --  Check the sign bit is 0.
-      if (R and Shift_Left (1, 63)) /= 0 then
-         Ok := False;
-      else
-         Ok := True;
-         Res := Unchecked_Conversion (R);
-      end if;
-   end Fix;
-
-   --  Return the position of the most non-null digit, -1 if V is 0.
-   function First_Digit (V : E_Num) return Sint16 is
-   begin
-      for I in reverse Digit_Range loop
-         if V.S (I) /= 0 then
-            return I;
-         end if;
-      end loop;
-      return -1;
-   end First_Digit;
-
-   procedure Mul (Res : out E_Num; A, B : E_Num)
-   is
-      T : Uint16_Array (0 .. 2 * Nbr_Digits - 1);
-      V : Uint32;
-      Max : Sint16;
-   begin
-      V := 0;
-      for I in 0 .. Nbr_Digits - 1 loop
-         for J in 0 .. I loop
-            V := V + Uint32 (A.S (J)) * Uint32 (B.S (I - J));
-         end loop;
-         T (I) := Uint16 (V mod Uint16'Modulus);
-         V := V / Uint16'Modulus;
-      end loop;
-      for I in Nbr_Digits .. 2 * Nbr_Digits - 2 loop
-         for J in I - Nbr_Digits + 1 .. Nbr_Digits - 1 loop
-            V := V + Uint32 (A.S (J)) * Uint32 (B.S (I - J));
-         end loop;
-         T (I) := Uint16 (V mod Uint16'Modulus);
-         V := V / Uint16'Modulus;
-      end loop;
-      T (T'Last) := Uint16 (V);
-      --  Search the leading non-nul.
-      Max := -1;
-      for I in reverse T'Range loop
-         if T (I) /= 0 then
-            Max := I;
-            exit;
-         end if;
-      end loop;
-      if Max > Nbr_Digits - 1 then
-         --  Loss of precision.
-         --  Round.
-         if T (Max - Nbr_Digits) >= Uint16 (Uint16'Modulus / 2) then
-            V := 1;
-            for I in Max - (Nbr_Digits - 1) .. Max loop
-               V := V + Uint32 (T (I));
-               T (I) := Uint16 (V mod Uint16'Modulus);
-               V := V / Uint16'Modulus;
-               exit when V = 0;
-            end loop;
-            if V /= 0 then
-               Max := Max + 1;
-               T (Max) := Uint16 (V);
-            end if;
-         end if;
-         Res.S := T (Max - (Nbr_Digits - 1) .. Max);
-         --  This may overflow.
-         Res.E := A.E + B.E + Max - (Nbr_Digits - 1);
-      else
-         Res.S (0 .. Max) := T (0 .. Max);
-         Res.S (Max + 1 .. Nbr_Digits - 1) := (others => 0);
-         --  This may overflow.
-         Res.E := A.E + B.E;
-      end if;
-   end Mul;
-
-   procedure Div (Res : out E_Num; A, B: E_Num)
-   is
-      Dividend : Uint16_Array (0 .. Nbr_Digits);
-      A_F : constant Sint16 := First_Digit (A);
-      B_F : constant Sint16 := First_Digit (B);
-
-      --  Digit corresponding to the first digit of B.
-      Doff : constant Sint16 := Dividend'Last - B_F;
-      Q : Uint16;
-      C, N_C : Uint16;
-   begin
-      --  Check for division by 0.
-      if B_F < 0 then
-         raise Constraint_Error;
-      end if;
-
-      --  Copy and shift dividend.
-      --  Bit 15 of the most significant digit of A becomes bit 0 of the
-      --  most significant digit of DIVIDEND.  Therefore we are sure
-      --  DIVIDEND < B (after realignment).
-      C := 0;
-      for K in 0 .. A_F loop
-         N_C := Shift_Right (A.S (K), 15);
-         Dividend (Dividend'Last - A_F - 1 + K)
-           := Shift_Left (A.S (K), 1) or C;
-         C := N_C;
-      end loop;
-      Dividend (Nbr_Digits) := C;
-      Dividend (0 .. Dividend'last - 2 - A_F) := (others => 0);
-
-      --  Algorithm is the same as division by hand.
-      C := 0;
-      for I in reverse Digit_Range loop
-         Q := 0;
-         for J in 0 .. 15 loop
-            declare
-               Borrow : Uint32;
-               Tmp : Uint16_Array (0 .. B_F);
-               V : Uint32;
-               V16 : Uint16;
-            begin
-               --  Compute TMP := dividend - B;
-               Borrow := 0;
-               for K in 0 .. B_F loop
-                  V := Uint32 (B.S (K)) + Borrow;
-                  V16 := Uint16 (V mod Uint16'Modulus);
-                  if V16 > Dividend (Doff + K) then
-                     Borrow := 1;
-                  else
-                     Borrow := 0;
-                  end if;
-                  Tmp (K) := Dividend (Doff + K) - V16;
-               end loop;
-
-               --  If the last shift creates a carry, we are sure Dividend > B
-               if C /= 0 then
-                  Borrow := 0;
-               end if;
-
-               Q := Q * 2;
-               --  Begin of : Dividend = Dividend * 2
-               C := 0;
-               for K in 0 .. Doff - 1 loop
-                  N_C := Shift_Right (Dividend (K), 15);
-                  Dividend (K) := Shift_Left (Dividend (K), 1) or C;
-                  C := N_C;
-               end loop;
-
-               if Borrow = 0 then
-                  --  Dividend > B
-                  Q := Q + 1;
-                  --  Dividend = Tmp * 2
-                  --           = (Dividend - B) * 2
-                  for K in Doff .. Nbr_Digits loop
-                     N_C := Shift_Right (Tmp (K - Doff), 15);
-                     Dividend (K) := Shift_Left (Tmp (K - Doff), 1) or C;
-                     C := N_C;
-                  end loop;
-               else
-                  --  Dividend = Dividend * 2
-                  for K in Doff .. Nbr_Digits loop
-                     N_C := Shift_Right (Dividend (K), 15);
-                     Dividend (K) := Shift_Left (Dividend (K), 1) or C;
-                     C := N_C;
-                  end loop;
-               end if;
-            end;
-         end loop;
-         Res.S (I) := Q;
-      end loop;
-      Res.E := A.E - B.E + (A_F - B_F) - (Nbr_Digits - 1);
-   end Div;
-
-   procedure To_Float (Res : out Iir_Fp64; Ok : out Boolean; E : E_Num)
-   is
-      V : Iir_Fp64;
-      P : Iir_Fp64;
-   begin
-      Res := 0.0;
-      P := Iir_Fp64'Scaling (1.0, 16 * E.E);
-      for I in Digit_Range loop
-         V := Iir_Fp64 (E.S (I)) * P;
-         P := Iir_Fp64'Scaling (P, 16);
-         Res := Res + V;
-      end loop;
-      Ok := True;
-   end To_Float;
-
-   function To_E_Num (V : Uint16) return E_Num
-   is
-      Res : E_Num;
-   begin
-      Res.E := 0;
-      Res.S := (0 => V, others => 0);
-      return Res;
-   end To_E_Num;
-
    --  Numbers of digits.
    Scale : Integer;
-   Res : E_Num;
+   Res : Bignum;
 
    --  LRM 13.4.1
    --  INTEGER ::= DIGIT { [ UNDERLINE ] DIGIT }
@@ -365,7 +47,7 @@ procedure Scan_Literal is
       C := Source (Pos);
       loop
          --  C is a digit.
-         Bmul (Res, Res, Character'Pos (C) - Character'Pos ('0'), 10);
+         Bignum_Mul_Int (Res, 10, Character'Pos (C) - Character'Pos ('0'));
          Scale := Scale + 1;
 
          Pos := Pos + 1;
@@ -386,12 +68,12 @@ procedure Scan_Literal is
    end Scan_Integer;
 
    C : Character;
-   D : Uint16;
+   D : Natural;
    Ok : Boolean;
    Has_Dot : Boolean;
    Exp : Integer;
    Exp_Neg : Boolean;
-   Base : Uint16;
+   Base : Positive;
 begin
    --  Start with a simple and fast conversion.
    C := Source (Pos);
@@ -416,7 +98,7 @@ begin
          if C = '.' or else C = '#' or else (C = 'e' or C = 'E' or C = ':')
          then
             --  Continue scanning.
-            Res := To_E_Num (D);
+            Bignum_Int (Res, D);
             exit;
          end if;
 
@@ -426,10 +108,10 @@ begin
          --  No possible overflow.
          Current_Context.Int64 := Iir_Int64 (D);
          return;
-      elsif D >= 6552 then
-         --  Number may be greather than the uint16 limit.
+      elsif D >= (Natural'Last / 10) - 1 then
+         --  Number may be greather than the natural limit.
          Scale := 0;
-         Res := To_E_Num (D);
+         Bignum_Int (Res, D);
          Scan_Integer;
          exit;
       end if;
@@ -465,9 +147,9 @@ begin
       --  Based integer.
       declare
          Number_Sign : constant Character := C;
-         Res_Int : Iir_Int64;
+         Res_Int : Interfaces.Unsigned_64;
       begin
-         Fix (Res_Int, Ok, Res);
+         Bignum_To_Int (Res, Res_Int, Ok);
          if not Ok or else Res_Int > 16 then
             --  LRM 13.4.2
             --  The base must be [...] at most sixteen.
@@ -481,11 +163,11 @@ begin
             --  Fallback.
             Base := 2;
          else
-            Base := Uint16 (Res_Int);
+            Base := Natural (Res_Int);
          end if;
 
          Pos := Pos + 1;
-         Res := E_Zero;
+         Bignum_Int (Res, 0);
          C := Source (Pos);
          loop
             if C >= '0' and C <= '9' then
@@ -508,7 +190,7 @@ begin
                D := 1;
             end if;
             Pos := Pos + 1;
-            Bmul (Res, Res, D, Base);
+            Bignum_Mul_Int (Res, Base, D);
             Scale := Scale + 1;
 
             C := Source (Pos);
@@ -538,6 +220,8 @@ begin
          end loop;
       end;
    end if;
+
+   --  Exponent.
    C := Source (Pos);
    Exp := 0;
    if C = 'E' or else C = 'e' then
@@ -594,53 +278,30 @@ begin
    end if;
 
    if Has_Dot then
-      Scale := Scale - Exp;
-   else
-      Scale := -Exp;
-   end if;
-   if Scale /= 0 then
-      declare
-         Scale_Neg : Boolean;
-         Val_Exp : E_Num;
-         Val_Pow : E_Num;
-      begin
-         if Scale > 0 then
-            Scale_Neg := True;
-         else
-            Scale_Neg := False;
-            Scale := -Scale;
-         end if;
-
-         Val_Pow := To_E_Num (Base);
-         Val_Exp := E_One;
-         while Scale /= 0 loop
-            if Scale mod 2 = 1 then
-               Mul (Val_Exp, Val_Exp, Val_Pow);
-            end if;
-            Scale := Scale / 2;
-            Mul (Val_Pow, Val_Pow, Val_Pow);
-         end loop;
-         if Scale_Neg then
-            Div (Res, Res, Val_Exp);
-         else
-            Mul (Res, Res, Val_Exp);
-         end if;
-      end;
-   end if;
-
-   if Has_Dot then
       -- a universal real.
       Current_Token := Tok_Real;
-      -- Set to a valid literal, in case of constraint error.
-      To_Float (Current_Context.Fp64, Ok, Res);
-      if not Ok then
-         Error_Msg_Scan ("literal beyond real bounds");
-      end if;
+
+      Current_Context.Fp64 :=
+        Fp64 (To_Float_64 (False, Res, Base, Exp - Scale));
    else
       -- a universal integer.
       Current_Token := Tok_Integer;
+
       -- Set to a valid literal, in case of constraint error.
-      Fix (Current_Context.Int64, Ok, Res);
+      if Exp /= 0 then
+         Res := Bignum_Mul (Res, Bignum_Pow (Base, Exp));
+      end if;
+
+      declare
+         U : Unsigned_64;
+      begin
+         Bignum_To_Int (Res, U, Ok);
+         if U > Unsigned_64 (Iir_Int64'Last) then
+            Ok := False;
+         else
+            Current_Context.Int64 := Iir_Int64 (U);
+         end if;
+      end;
       if not Ok then
          Error_Msg_Scan ("literal beyond integer bounds");
       end if;