Create src/vhdl subdirectory.

1 files changed, 0 insertions, 651 deletions

diff --git a/src/scanner-scan_literal.adb b/src/scanner-scan_literal.adb
deleted file mode 100644
index 74acf44..0000000
--- a/src/scanner-scan_literal.adb
+++ /dev/null
@@ -1,651 +0,0 @@
---  Lexical analysis for numbers.
---  Copyright (C) 2002 - 2014 Tristan Gingold
---
---  GHDL is free software; you can redistribute it and/or modify it under
---  the terms of the GNU General Public License as published by the Free
---  Software Foundation; either version 2, or (at your option) any later
---  version.
---
---  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
---  WARRANTY; without even the implied warranty of MERCHANTABILITY or
---  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
---  for more details.
---
---  You should have received a copy of the GNU General Public License
---  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;
-
-separate (Scanner)
-
--- scan a decimal literal or a based literal.
---
--- LRM93 13.4.1
--- DECIMAL_LITERAL ::= INTEGER [ . INTEGER ] [ EXPONENT ]
--- EXPONENT ::= E [ + ] INTEGER | E - INTEGER
---
--- LRM93 13.4.2
--- 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;
-
-   --  LRM 13.4.1
-   --  INTEGER ::= DIGIT { [ UNDERLINE ] DIGIT }
-   --
-   --  Update SCALE, RES.
-   --  The first character must be a digit.
-   procedure Scan_Integer
-   is
-      C : Character;
-   begin
-      C := Source (Pos);
-      loop
-         --  C is a digit.
-         Bmul (Res, Res, Character'Pos (C) - Character'Pos ('0'), 10);
-         Scale := Scale + 1;
-
-         Pos := Pos + 1;
-         C := Source (Pos);
-         if C = '_' then
-            loop
-               Pos := Pos + 1;
-               C := Source (Pos);
-               exit when C /= '_';
-               Error_Msg_Scan ("double underscore in number");
-            end loop;
-            if C not in '0' .. '9' then
-               Error_Msg_Scan ("underscore must be followed by a digit");
-            end if;
-         end if;
-         exit when C not in '0' .. '9';
-      end loop;
-   end Scan_Integer;
-
-   C : Character;
-   D : Uint16;
-   Ok : Boolean;
-   Has_Dot : Boolean;
-   Exp : Integer;
-   Exp_Neg : Boolean;
-   Base : Uint16;
-begin
-   --  Start with a simple and fast conversion.
-   C := Source (Pos);
-   D := 0;
-   loop
-      D := D * 10 + Character'Pos (C) - Character'Pos ('0');
-
-      Pos := Pos + 1;
-      C := Source (Pos);
-      if C = '_' then
-         loop
-            Pos := Pos + 1;
-            C := Source (Pos);
-            exit when C /= '_';
-            Error_Msg_Scan ("double underscore in number");
-         end loop;
-         if C not in '0' .. '9' then
-            Error_Msg_Scan ("underscore must be followed by a digit");
-         end if;
-      end if;
-      if C not in '0' .. '9' then
-         if C = '.' or else C = '#' or else (C = 'e' or C = 'E' or C = ':')
-         then
-            --  Continue scanning.
-            Res := To_E_Num (D);
-            exit;
-         end if;
-
-         --  Finished.
-         --  a universal integer.
-         Current_Token := Tok_Integer;
-         --  No possible overflow.
-         Current_Context.Int64 := Iir_Int64 (D);
-         return;
-      elsif D >= 6552 then
-         --  Number may be greather than the uint16 limit.
-         Scale := 0;
-         Res := To_E_Num (D);
-         Scan_Integer;
-         exit;
-      end if;
-   end loop;
-
-   Has_Dot := False;
-   Base := 10;
-
-   C := Source (Pos);
-   if C = '.' then
-      --  Decimal integer.
-      Has_Dot := True;
-      Scale := 0;
-      Pos := Pos + 1;
-      C := Source (Pos);
-      if C not in '0' .. '9' then
-         Error_Msg_Scan ("a dot must be followed by a digit");
-         return;
-      end if;
-      Scan_Integer;
-   elsif C = '#'
-     or else (C = ':' and then (Source (Pos + 1) in '0' .. '9'
-                                or else Source (Pos + 1) in 'a' .. 'f'
-                                or else Source (Pos + 1) in 'A' .. 'F'))
-   then
-      --  LRM 13.10
-      --  The number sign (#) of a based literal can be replaced by colon (:),
-      --  provided that the replacement is done for both occurrences.
-      -- GHDL: correctly handle 'variable v : integer range 0 to 7:= 3'.
-      --   Is there any other places where a digit can be followed
-      --   by a colon ? (See IR 1093).
-
-      --  Based integer.
-      declare
-         Number_Sign : constant Character := C;
-         Res_Int : Iir_Int64;
-      begin
-         Fix (Res_Int, Ok, Res);
-         if not Ok or else Res_Int > 16 then
-            --  LRM 13.4.2
-            --  The base must be [...] at most sixteen.
-            Error_Msg_Scan ("base must be at most 16");
-            --  Fallback.
-            Base := 16;
-         elsif Res_Int < 2 then
-            --  LRM 13.4.2
-            --  The base must be at least two [...].
-            Error_Msg_Scan ("base must be at least 2");
-            --  Fallback.
-            Base := 2;
-         else
-            Base := Uint16 (Res_Int);
-         end if;
-
-         Pos := Pos + 1;
-         Res := E_Zero;
-         C := Source (Pos);
-         loop
-            if C >= '0' and C <= '9' then
-               D := Character'Pos (C) - Character'Pos ('0');
-            elsif C >= 'A' and C <= 'F' then
-               D := Character'Pos (C) - Character'Pos ('A') + 10;
-            elsif C >= 'a' and C <= 'f' then
-               D := Character'Pos (C) - Character'Pos ('a') + 10;
-            else
-               Error_Msg_Scan ("bad extended digit");
-               exit;
-            end if;
-
-            if D >= Base then
-               --  LRM 13.4.2
-               --  The conventional meaning of base notation is
-               --  assumed; in particular the value of each extended
-               --  digit of a based literal must be less then the base.
-               Error_Msg_Scan ("digit beyond base");
-               D := 1;
-            end if;
-            Pos := Pos + 1;
-            Bmul (Res, Res, D, Base);
-            Scale := Scale + 1;
-
-            C := Source (Pos);
-            if C = '_' then
-               loop
-                  Pos := Pos + 1;
-                  C := Source (Pos);
-                  exit when C /= '_';
-                  Error_Msg_Scan ("double underscore in based integer");
-               end loop;
-            elsif C = '.' then
-               if Has_Dot then
-                  Error_Msg_Scan ("double dot ignored");
-               else
-                  Has_Dot := True;
-                  Scale := 0;
-               end if;
-               Pos := Pos + 1;
-               C := Source (Pos);
-            elsif C = Number_Sign then
-               Pos := Pos + 1;
-               exit;
-            elsif C = '#' or C = ':' then
-               Error_Msg_Scan ("bad number sign replacement character");
-               exit;
-            end if;
-         end loop;
-      end;
-   end if;
-   C := Source (Pos);
-   Exp := 0;
-   if C = 'E' or else C = 'e' then
-      Pos := Pos + 1;
-      C := Source (Pos);
-      Exp_Neg := False;
-      if C = '+' then
-         Pos := Pos + 1;
-         C := Source (Pos);
-      elsif C = '-' then
-         if Has_Dot then
-            Exp_Neg := True;
-         else
-            --  LRM 13.4.1
-            --  An exponent for an integer literal must not have a minus sign.
-            --
-            --  LRM 13.4.2
-            --  An exponent for a based integer literal must not have a minus
-            --  sign.
-            Error_Msg_Scan
-              ("negative exponent not allowed for integer literal");
-         end if;
-         Pos := Pos + 1;
-         C := Source (Pos);
-      end if;
-      if C not in '0' .. '9' then
-         Error_Msg_Scan ("digit expected after exponent");
-      else
-         loop
-            --  C is a digit.
-            Exp := Exp * 10 + (Character'Pos (C) - Character'Pos ('0'));
-
-            Pos := Pos + 1;
-            C := Source (Pos);
-            if C = '_' then
-               loop
-                  Pos := Pos + 1;
-                  C := Source (Pos);
-                  exit when C /= '_';
-                  Error_Msg_Scan ("double underscore not allowed in integer");
-               end loop;
-               if C not in '0' .. '9' then
-                  Error_Msg_Scan ("digit expected after underscore");
-                  exit;
-               end if;
-            elsif C not in '0' .. '9' then
-               exit;
-            end if;
-         end loop;
-      end if;
-      if Exp_Neg then
-         Exp := -Exp;
-      end if;
-   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;
-   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 not Ok then
-         Error_Msg_Scan ("literal beyond integer bounds");
-      end if;
-   end if;
-exception
-   when Constraint_Error =>
-      Error_Msg_Scan ("literal overflow");
-end Scan_Literal;