vhdl: move scanner under vhdl hierarchy.

1 files changed, 317 insertions, 0 deletions

diff --git a/src/vhdl/vhdl-scanner-scan_literal.adb b/src/vhdl/vhdl-scanner-scan_literal.adb
new file mode 100644
index 000000000..9006587fc
--- /dev/null
+++ b/src/vhdl/vhdl-scanner-scan_literal.adb
@@ -0,0 +1,317 @@
+--  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 Interfaces; use Interfaces;
+with Grt.Fcvt; use Grt.Fcvt;
+
+separate (Vhdl.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
+   --  Numbers of digits.
+   Scale : Integer;
+   Res : Bignum;
+
+   --  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.
+         Bignum_Mul_Int (Res, 10, Character'Pos (C) - Character'Pos ('0'));
+         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 : Natural;
+   Ok : Boolean;
+   Has_Dot : Boolean;
+   Exp : Integer;
+   Exp_Neg : Boolean;
+   Base : Positive;
+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.
+            Bignum_Int (Res, D);
+            exit;
+         end if;
+
+         --  Finished.
+         --  a universal integer.
+         Current_Token := Tok_Integer;
+         --  No possible overflow.
+         Current_Context.Int64 := Iir_Int64 (D);
+         return;
+      elsif D >= (Natural'Last / 10) - 1 then
+         --  Number may be greather than the natural limit.
+         Scale := 0;
+         Bignum_Int (Res, D);
+         Scan_Integer;
+         exit;
+      end if;
+   end loop;
+
+   Has_Dot := False;
+   Base := 10;
+   Scale := 0;
+
+   C := Source (Pos);
+   if C = '.' then
+      --  Decimal integer.
+      Has_Dot := True;
+      Pos := Pos + 1;
+      C := Source (Pos);
+      if C not in '0' .. '9' then
+         Error_Msg_Scan ("a dot must be followed by a digit");
+         Current_Token := Tok_Real;
+         Current_Context.Fp64 := Fp64 (To_Float_64 (False, Res, Base, 0));
+         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 : Interfaces.Unsigned_64;
+      begin
+         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.
+            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 := Natural (Res_Int);
+         end if;
+
+         Pos := Pos + 1;
+         Bignum_Int (Res, 0);
+         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;
+            Bignum_Mul_Int (Res, Base, D);
+            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;
+
+   --  Exponent.
+   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
+      -- a universal real.
+      Current_Token := Tok_Real;
+
+      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.
+      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;
+   end if;
+exception
+   when Constraint_Error =>
+      Error_Msg_Scan ("literal overflow");
+
+      Current_Token := Tok_Integer;
+      Current_Context.Int64 := 0;
+end Scan_Literal;