diff options
author | Tristan Gingold <tgingold@free.fr> | 2023-01-07 12:41:40 +0100 |
---|---|---|
committer | Tristan Gingold <tgingold@free.fr> | 2023-01-09 06:40:10 +0100 |
commit | 8f4b226dd33e46421ed307dbac0cef1e4f6c8489 (patch) | |
tree | 5ab39fa0fb6a1c5a02facfa25d97cf115042a51f /src/grt | |
parent | 8c8d9a8bf91d22d4cb7c350a016e0cdcfdae2ef9 (diff) | |
download | ghdl-8f4b226dd33e46421ed307dbac0cef1e4f6c8489.tar.gz ghdl-8f4b226dd33e46421ed307dbac0cef1e4f6c8489.tar.bz2 ghdl-8f4b226dd33e46421ed307dbac0cef1e4f6c8489.zip |
synth: rework value attribute
Diffstat (limited to 'src/grt')
-rw-r--r-- | src/grt/grt-to_strings.adb | 60 | ||||
-rw-r--r-- | src/grt/grt-to_strings.ads | 19 | ||||
-rw-r--r-- | src/grt/grt-values.adb | 53 | ||||
-rw-r--r-- | src/grt/grt-values.ads | 13 |
4 files changed, 80 insertions, 65 deletions
diff --git a/src/grt/grt-to_strings.adb b/src/grt/grt-to_strings.adb index 8b821ae0b..130388e3b 100644 --- a/src/grt/grt-to_strings.adb +++ b/src/grt/grt-to_strings.adb @@ -22,7 +22,9 @@ -- covered by the GNU Public License. with Interfaces; + with Grt.Fcvt; +with Grt.Strings; use Grt.Strings; package body Grt.To_Strings is generic @@ -509,4 +511,62 @@ package body Grt.To_Strings is return (Status => Value_Ok, Val => Val); end Value_F64; + + -- Increase POS to skip leading whitespace characters, decrease LEN to + -- skip trailing whitespaces in string S. + procedure Remove_Whitespaces (S : Std_String_Basep; + Len : in out Ghdl_Index_Type; + Pos : in out Ghdl_Index_Type) is + begin + -- GHDL: allow several leading whitespace. + while Pos < Len loop + exit when not Is_Whitespace (S (Pos)); + Pos := Pos + 1; + end loop; + + -- GHDL: allow several leading whitespace. + while Len > Pos loop + exit when not Is_Whitespace (S (Len - 1)); + Len := Len - 1; + end loop; + end Remove_Whitespaces; + + procedure Ghdl_Value_Physical_Split (Str : Std_String_Basep; + Len : Ghdl_Index_Type; + Is_Real : out Boolean; + Lit_Pos : out Ghdl_Index_Type; + Lit_End : out Ghdl_Index_Type; + Unit_Pos : out Ghdl_Index_Type) + is + L : Ghdl_Index_Type; + begin + -- LRM 14.1 + -- Leading and trailing whitespace is allowed and ignored. + Lit_Pos := 0; + L := Len; + Remove_Whitespaces (Str, L, Lit_Pos); + pragma Unreferenced (Len); + + -- Split between abstract literal (optionnal) and unit name. + Lit_End := Lit_Pos; + Is_Real := False; + while Lit_End < L loop + exit when Is_Whitespace (Str (Lit_End)); + if Str (Lit_End) = '.' then + Is_Real := True; + end if; + Lit_End := Lit_End + 1; + end loop; + if Lit_End = L then + -- No literal + Unit_Pos := Lit_Pos; + Lit_End := 0; + else + Unit_Pos := Lit_End + 1; + while Unit_Pos < L loop + exit when not Is_Whitespace (Str (Unit_Pos)); + Unit_Pos := Unit_Pos + 1; + end loop; + end if; + end Ghdl_Value_Physical_Split; end Grt.To_Strings; diff --git a/src/grt/grt-to_strings.ads b/src/grt/grt-to_strings.ads index 184bf8d78..a15a6aaee 100644 --- a/src/grt/grt-to_strings.ads +++ b/src/grt/grt-to_strings.ads @@ -106,4 +106,23 @@ package Grt.To_Strings is function Value_F64 (S : Std_String_Basep; Len : Ghdl_Index_Type; Init_Pos : Ghdl_Index_Type) return Value_F64_Result; + + -- Increase POS to skip leading whitespace characters, decrease LEN to + -- skip trailing whitespaces in string S. + procedure Remove_Whitespaces (S : Std_String_Basep; + Len : in out Ghdl_Index_Type; + Pos : in out Ghdl_Index_Type); + + -- Extract position of numeric literal and unit in string STR. + -- Set IS_REAL if the unit is a real number (presence of '.'). + -- Set UNIT_POS to the position of the first character of the unit name. + -- Set LIT_POS to the position of the first character of the numeric + -- literal (after whitespaces are skipped). + -- Set LIT_END to the position of the next character of the numeric lit. + procedure Ghdl_Value_Physical_Split (Str : Std_String_Basep; + Len : Ghdl_Index_Type; + Is_Real : out Boolean; + Lit_Pos : out Ghdl_Index_Type; + Lit_End : out Ghdl_Index_Type; + Unit_Pos : out Ghdl_Index_Type); end Grt.To_Strings; diff --git a/src/grt/grt-values.adb b/src/grt/grt-values.adb index b2e98f6a0..14f8f8075 100644 --- a/src/grt/grt-values.adb +++ b/src/grt/grt-values.adb @@ -26,23 +26,11 @@ with Grt.Strings; use Grt.Strings; with Grt.To_Strings; use Grt.To_Strings; package body Grt.Values is - -- Increase POS to skip leading whitespace characters, decrease LEN to - -- skip trailing whitespaces in string S. procedure Remove_Whitespaces (S : Std_String_Basep; Len : in out Ghdl_Index_Type; Pos : in out Ghdl_Index_Type) is begin - -- GHDL: allow several leading whitespace. - while Pos < Len loop - exit when not Is_Whitespace (S (Pos)); - Pos := Pos + 1; - end loop; - - -- GHDL: allow several leading whitespace. - while Len > Pos loop - exit when not Is_Whitespace (S (Len - 1)); - Len := Len - 1; - end loop; + Grt.To_Strings.Remove_Whitespaces (S, Len, Pos); if Pos = Len then Error_E ("'value: empty string"); end if; @@ -234,45 +222,6 @@ package body Grt.Values is return Value_F64 (S, Len, Pos); end Ghdl_Value_F64; - procedure Ghdl_Value_Physical_Split (Str : Std_String_Basep; - Len : Ghdl_Index_Type; - Is_Real : out Boolean; - Lit_Pos : out Ghdl_Index_Type; - Lit_End : out Ghdl_Index_Type; - Unit_Pos : out Ghdl_Index_Type) - is - L : Ghdl_Index_Type; - begin - -- LRM 14.1 - -- Leading and trailing whitespace is allowed and ignored. - Lit_Pos := 0; - L := Len; - Remove_Whitespaces (Str, L, Lit_Pos); - pragma Unreferenced (Len); - - -- Split between abstract literal (optionnal) and unit name. - Lit_End := Lit_Pos; - Is_Real := False; - while Lit_End < L loop - exit when Is_Whitespace (Str (Lit_End)); - if Str (Lit_End) = '.' then - Is_Real := True; - end if; - Lit_End := Lit_End + 1; - end loop; - if Lit_End = L then - -- No literal - Unit_Pos := Lit_Pos; - Lit_End := 0; - else - Unit_Pos := Lit_End + 1; - while Unit_Pos < L loop - exit when not Is_Whitespace (Str (Unit_Pos)); - Unit_Pos := Unit_Pos + 1; - end loop; - end if; - end Ghdl_Value_Physical_Split; - function Ghdl_Value_Physical_Type (Str : Std_String_Ptr; Rti : Ghdl_Rti_Access) return Ghdl_I64 diff --git a/src/grt/grt-values.ads b/src/grt/grt-values.ads index 8a81d1fbd..450295891 100644 --- a/src/grt/grt-values.ads +++ b/src/grt/grt-values.ads @@ -25,19 +25,6 @@ with Grt.Vhdl_Types; use Grt.Vhdl_Types; with Grt.Rtis; use Grt.Rtis; package Grt.Values is - -- Extract position of numeric literal and unit in string STR. - -- Set IS_REAL if the unit is a real number (presence of '.'). - -- Set UNIT_POS to the position of the first character of the unit name. - -- Set LIT_POS to the position of the first character of the numeric - -- literal (after whitespaces are skipped). - -- Set LIT_END to the position of the next character of the numeric lit. - procedure Ghdl_Value_Physical_Split (Str : Std_String_Basep; - Len : Ghdl_Index_Type; - Is_Real : out Boolean; - Lit_Pos : out Ghdl_Index_Type; - Lit_End : out Ghdl_Index_Type; - Unit_Pos : out Ghdl_Index_Type); - function Ghdl_Value_B1 (Str : Std_String_Ptr; Rti : Ghdl_Rti_Access) return Ghdl_B1; function Ghdl_Value_E8 (Str : Std_String_Ptr; Rti : Ghdl_Rti_Access) |