summaryrefslogtreecommitdiff
path: root/src/vhdl/scanner-scan_literal.adb
diff options
context:
space:
mode:
Diffstat (limited to 'src/vhdl/scanner-scan_literal.adb')
-rw-r--r--src/vhdl/scanner-scan_literal.adb651
1 files changed, 651 insertions, 0 deletions
diff --git a/src/vhdl/scanner-scan_literal.adb b/src/vhdl/scanner-scan_literal.adb
new file mode 100644
index 0000000..74acf44
--- /dev/null
+++ b/src/vhdl/scanner-scan_literal.adb
@@ -0,0 +1,651 @@
+-- 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;