diff options
| -rw-r--r-- | translate/grt/grt-values.adb | 66 | ||||
| -rw-r--r-- | translate/grt/grt-values.ads | 20 |
2 files changed, 60 insertions, 26 deletions
diff --git a/translate/grt/grt-values.adb b/translate/grt/grt-values.adb index 89d418f..7225dce 100644 --- a/translate/grt/grt-values.adb +++ b/translate/grt/grt-values.adb @@ -31,8 +31,7 @@ package body Grt.Values is HT : constant Character := Character'Val (9); -- Return True IFF C is a whitespace character (as defined in LRM93 14.3) - function Is_Whitespace (C : in Character) return Boolean - is + function Is_Whitespace (C : in Character) return Boolean is begin return C = ' ' or C = NBSP or C = HT; end Is_Whitespace; @@ -60,7 +59,7 @@ package body Grt.Values is end Remove_Whitespaces; -- Convert C to lowercase. - function LC (C : in Character) return Character is + function To_LC (C : in Character) return Character is begin if C >= 'A' and then C <= 'Z' then return Character'Val @@ -68,7 +67,7 @@ package body Grt.Values is else return C; end if; - end LC; + end To_LC; -- Return TRUE iff user string S (POS .. LEN) is equal to REF. Comparaison -- is case insensitive, but REF must be lowercase (REF is supposed to @@ -88,7 +87,7 @@ package body Grt.Values is -- End of string. return C = ASCII.NUL; end if; - if LC (S (Pos + P)) /= C or else C = ASCII.NUL then + if To_LC (S (Pos + P)) /= C or else C = ASCII.NUL then return False; end if; P := P + 1; @@ -523,41 +522,33 @@ package body Grt.Values is return Ghdl_Value_F64 (S, Len, Pos); end Ghdl_Value_F64; - function Ghdl_Value_Physical_Type (Str : Std_String_Ptr; - Rti : Ghdl_Rti_Access) - return Ghdl_I64 + procedure Ghdl_Value_Physical_Split (Str : Std_String_Ptr; + Is_Real : out Boolean; + Lit_Pos : out Ghdl_Index_Type; + Lit_End : out Ghdl_Index_Type; + Unit_Pos : out Ghdl_Index_Type) is S : constant Std_String_Basep := Str.Base; Len : Ghdl_Index_Type := Str.Bounds.Dim_1.Length; - Pos : Ghdl_Index_Type := 0; - Unit_Pos : Ghdl_Index_Type; - Lit_End : Ghdl_Index_Type; - - Found_Real : Boolean; - - Phys_Rti : constant Ghdl_Rtin_Type_Physical_Acc := - To_Ghdl_Rtin_Type_Physical_Acc (Rti); - Unit_Name : Ghdl_C_String; - Multiple : Ghdl_Rti_Access; - Mult : Ghdl_I64; begin -- LRM 14.1 -- Leading and trailing whitespace is allowed and ignored. - Remove_Whitespaces (S, Len, Pos); + Lit_Pos := 0; + Remove_Whitespaces (S, Len, Lit_Pos); -- Split between abstract literal (optionnal) and unit name. - Lit_End := Pos; - Found_Real := False; + Lit_End := Lit_Pos; + Is_Real := False; while Lit_End < Len loop exit when Is_Whitespace (S (Lit_End)); if S (Lit_End) = '.' then - Found_Real := True; + Is_Real := True; end if; Lit_End := Lit_End + 1; end loop; if Lit_End = Len then -- No literal - Unit_Pos := Pos; + Unit_Pos := Lit_Pos; Lit_End := 0; else Unit_Pos := Lit_End + 1; @@ -566,7 +557,30 @@ package body Grt.Values is 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 + is + S : constant Std_String_Basep := Str.Base; + Len : constant Ghdl_Index_Type := Str.Bounds.Dim_1.Length; + Unit_Pos : Ghdl_Index_Type; + Lit_Pos : Ghdl_Index_Type; + Lit_End : Ghdl_Index_Type; + + Found_Real : Boolean; + + Phys_Rti : constant Ghdl_Rtin_Type_Physical_Acc := + To_Ghdl_Rtin_Type_Physical_Acc (Rti); + Unit_Name : Ghdl_C_String; + Multiple : Ghdl_Rti_Access; + Mult : Ghdl_I64; + begin + -- Extract literal and unit + Ghdl_Value_Physical_Split (Str, Found_Real, Lit_Pos, Lit_End, Unit_Pos); + -- Find unit value Multiple := null; for i in 0 .. Phys_Rti.Nbr - 1 loop Unit_Name := @@ -606,9 +620,9 @@ package body Grt.Values is else if Found_Real then return Ghdl_I64 - (Ghdl_Value_F64 (S, Lit_End, Pos) * Ghdl_F64 (Mult)); + (Ghdl_Value_F64 (S, Lit_End, Lit_Pos) * Ghdl_F64 (Mult)); else - return Ghdl_Value_I64 (S, Lit_End, Pos) * Mult; + return Ghdl_Value_I64 (S, Lit_End, Lit_Pos) * Mult; end if; end if; end Ghdl_Value_Physical_Type; diff --git a/translate/grt/grt-values.ads b/translate/grt/grt-values.ads index dda24d8..70a6581 100644 --- a/translate/grt/grt-values.ads +++ b/translate/grt/grt-values.ads @@ -26,6 +26,24 @@ with Grt.Types; use Grt.Types; with Grt.Rtis; use Grt.Rtis; package Grt.Values is + -- Return True IFF C is a whitespace character (as defined in LRM93 14.3) + function Is_Whitespace (C : in Character) return Boolean; + + -- Convert C to lowercase. + function To_LC (C : in Character) return Character; + + -- 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_Ptr; + 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_B2 (Str : Std_String_Ptr; Rti : Ghdl_Rti_Access) return Ghdl_B2; function Ghdl_Value_E8 (Str : Std_String_Ptr; Rti : Ghdl_Rti_Access) @@ -33,6 +51,7 @@ package Grt.Values is function Ghdl_Value_E32 (Str : Std_String_Ptr; Rti : Ghdl_Rti_Access) return Ghdl_E32; function Ghdl_Value_I32 (Str : Std_String_Ptr) return Ghdl_I32; + function Ghdl_Value_I64 (Str : Std_String_Ptr) return Ghdl_I64; function Ghdl_Value_F64 (Str : Std_String_Ptr) return Ghdl_F64; function Ghdl_Value_P64 (Str : Std_String_Ptr; Rti : Ghdl_Rti_Access) return Ghdl_I64; @@ -43,6 +62,7 @@ private pragma Export (C, Ghdl_Value_E8, "__ghdl_value_e8"); pragma Export (C, Ghdl_Value_E32, "__ghdl_value_e32"); pragma Export (C, Ghdl_Value_I32, "__ghdl_value_i32"); + pragma Export (C, Ghdl_Value_I64, "__ghdl_value_i64"); pragma Export (C, Ghdl_Value_F64, "__ghdl_value_f64"); pragma Export (C, Ghdl_Value_P64, "__ghdl_value_p64"); pragma Export (C, Ghdl_Value_P32, "__ghdl_value_p32"); |