---
translate/grt/grt-values.adb | 146 ++++++++++++++++++++++++++++++++++++++----
1 files changed, 133 insertions(+), 13 deletions(-)
diff --git a/translate/grt/grt-values.adb b/translate/grt/grt-values.adb
index 404a2a4..744ae9c 100644
--- a/translate/grt/grt-values.adb
+++ b/translate/grt/grt-values.adb
@@ -21,7 +21,8 @@ package body Grt.Values is
NBSP : constant Character := Character'Val (160);
HT : constant Character := Character'Val (9);
-
+ NUL: constant Character := Character'Val (0);
+ SOH : constant Character := Character'Val (1);
function Ghdl_Value_I32 (Str : Std_String_Ptr) return Ghdl_I32
is
S : constant Std_String_Basep := Str.Base;
@@ -31,6 +32,11 @@ package body Grt.Values is
Sep : Character;
Val, D, Base : Ghdl_I32;
Exp : Integer;
+ S1 : constant Std_string_Basep := str.Base;
+ Len1 : constant Ghdl_Index_Type := str.Bounds.Dim_1.Length;
+ Pos1 : Ghdl_Index_Type := 0;
+ b : character;
+ Sep1 :character;
begin
-- LRM 14.1
-- Leading [and trailing] whitespace is allowed and ignored.
@@ -46,28 +52,44 @@ package body Grt.Values is
exit;
end case;
end loop;
-
+while Pos1 < Len1 loop
+ case S1 (Pos1) is
+ when ' '
+ | NUL
+ | SOH =>
+ Pos1 := Pos1 + 1;
+ when others =>
+ exit;
+ end case;
+ end loop;
if Pos = Len then
Error_E ("'value: empty string");
end if;
C := S (Pos);
-
- -- Be user friendly.
+ if Pos1 = Len1 then
+ Error_E ("'value: empty bit");
+ end if;
+ C := S(Pos);
+ -- Be user friendly.
if C = '-' or C = '+' then
Error_E ("'value: leading sign +/- not allowed");
end if;
-
+
+if b = '-' or b = '+' then
+ Error_E ("'value: leading sign +/- not allowed");
+ end if;
Val := 0;
loop
if C in '0' .. '9' then
Val := Val * 10 + Character'Pos (C) - Character'Pos ('0');
Pos := Pos + 1;
- exit when Pos >= Len;
+ exit when Pos >= Len;
C := S (Pos);
else
Error_E ("'value: decimal digit expected");
end if;
- case C is
+
+ case C is
when '_' =>
Pos := Pos + 1;
if Pos >= Len then
@@ -88,12 +110,11 @@ package body Grt.Values is
null;
end case;
end loop;
-
- if Pos >= Len then
+ if Pos >= Len then
return Val;
end if;
- if C = '#' or C = ':' then
+ if C = '#' or C = ':' then
Base := Val;
Val := 0;
Sep := C;
@@ -115,7 +136,8 @@ package body Grt.Values is
D := Character'Pos (C) - Character'Pos ('A') + 10;
when others =>
Error_E ("'value: digit expected");
- end case;
+ end case;
+
if D > Base then
Error_E ("'value: digit greather than base");
end if;
@@ -141,9 +163,95 @@ package body Grt.Values is
end loop;
else
Base := 10;
+ end if;
+
+ Val := 0;
+ loop
+ if b in '0' .. '1' then
+ Val := Val*2 + Character'Pos (b) - Character'Pos ('1');
+
+
+ Pos1 := Pos1 + 1;
+ exit when Pos1 >= Len1;
+ b := S1 (Pos);
+ else
+ Error_E ("'value: bit is expected");
+ end if;
+
+ case b is
+ when '_' =>
+ Pos1 := Pos + 1;
+ if Pos >= Len1 then
+ Error_E ("'value: trailing underscore");
+ end if;
+ b := S1 (Pos);
+ when '#'
+ | ':'
+ | 'E'
+ | 'e' =>
+ exit;
+ when ' '
+ | NUL
+ | SOH =>
+ Pos1 := Pos1 + 1;
+ exit;
+ when others =>
+ null;
+ end case;
+ end loop;
+ if Pos1 >= Len1 then
+ return Val;
end if;
- -- Handle exponent.
+ if b = '#' or b = ':' then
+ Base := Val;
+ Val := 0;
+ Sep1 := b;
+ Pos1 := Pos1 + 1;
+ if Base < 2 or Base > 16 then
+ Error_E ("'value: bad base");
+ end if;
+ if Pos1 >= Len1 then
+ Error_E ("'value: missing based bit");
+ end if;
+ b := S1 (Pos1);
+ loop
+ case b is
+ when '0' .. '1' =>
+ D := Character'Pos (b) - Character'Pos ('1');
+
+ when others =>
+ Error_E ("'value: bit expected");
+ end case;
+
+ if D > Base then
+ Error_E ("'value: bit greather than base");
+ end if;
+ Val := Val * Base + D;
+ Pos1 := Pos1 + 1;
+ if Pos1 >= Len1 then
+ Error_E ("'value: missing end bit number");
+ end if;
+ b := S1 (Pos1);
+ if b = '#' or b = ':' then
+ if b /= Sep1 then
+ Error_E ("'value: sign number mismatch");
+ end if;
+ Pos1 := Pos1 + 1;
+ exit;
+ elsif b = '_' then
+ Pos1 := Pos1 + 1;
+ if Pos >= Len then
+ Error_E ("'value: no character after underscore");
+ end if;
+ b := S1 (Pos1);
+ end if;
+ end loop;
+ else
+ Base := 2;
+ end if;
+
+ -- Handle exponent.
if C = 'e' or C = 'E' then
Pos := Pos + 1;
if Pos >= Len then
@@ -161,7 +269,7 @@ package body Grt.Values is
end if;
Exp := 0;
loop
- if C in '0' .. '9' then
+ if C in '0' .. '9' then
Exp := Exp * 10 + Character'Pos (C) - Character'Pos ('0');
Pos := Pos + 1;
exit when Pos >= Len;
@@ -208,6 +316,18 @@ package body Grt.Values is
Error_E ("'value: trailing characters after blank");
end case;
end loop;
+ while Pos1 < Len1 loop
+ case S1 (Pos1) is
+ when ' '
+ | NUL
+ | SOH =>
+ Pos1 := Pos1+ 1;
+ when others =>
+ Error_E ("'value: trailing characters after blank");
+ end case;
+ end loop;
+
+
return Val;
end Ghdl_Value_I32;
--
1.7.7.6
_______________________________________________
Ghdl-discuss mailing list
[email protected]
https://mail.gna.org/listinfo/ghdl-discuss
