diff options
| -rw-r--r-- | evaluation.adb | 20 | ||||
| -rw-r--r-- | translate/grt/grt-values.adb | 33 | ||||
| -rw-r--r-- | translate/translation.adb | 3 |
3 files changed, 40 insertions, 16 deletions
diff --git a/evaluation.adb b/evaluation.adb index 3bd18ce..f5b8870 100644 --- a/evaluation.adb +++ b/evaluation.adb @@ -1376,7 +1376,7 @@ package body Evaluation is return Null_Iir; end Build_Enumeration_Value; - function Eval_Physical_Image (Phys, Expr : Iir) return Iir + function Eval_Physical_Image (Phys, Expr: Iir) return Iir -- reduces to the base unit (e.g. femtoseconds) is Value : constant String := Iir_Int64'image( @@ -1415,6 +1415,7 @@ package body Evaluation is UnitName : String(Val'range); Sep : Natural; Found_Unit : Boolean := false; + Found_Real : Boolean := false; Unit : Iir := Get_Primary_Unit (Phys_Type); begin -- Separate string into numeric value and make lowercase unit. @@ -1428,7 +1429,11 @@ package body Evaluation is end if; end loop; -- Unit name is UnitName(Sep+1..Unit'Last) - + for i in Val'first .. Sep loop + if Val(i) = '.' then + Found_Real := true; + end if; + end loop; -- Chain down the units looking for matching one Unit := Get_Primary_Unit (Phys_Type); while Unit /= Null_Iir loop @@ -1440,8 +1445,15 @@ package body Evaluation is & """ not in physical type", Expr); return Null_Iir; end if; - -- FIXME: Should we support real values too? - return Build_Physical(Iir_Int64'value(Val(Val'first .. Sep)), Expr); + if Found_Real then + return Build_Physical(Iir_Int64( + Iir_Fp64'value(Val(Val'first .. Sep)) * + Iir_Fp64(Get_Value (Get_Physical_Unit_Value + (Unit)))), Expr); + else + return Build_Physical(Iir_Int64'value(Val(Val'first .. Sep)) * + Get_Value (Get_Physical_Unit_Value(Unit)), Expr); + end if; end Build_Physical_Value; diff --git a/translate/grt/grt-values.adb b/translate/grt/grt-values.adb index 173c8ce..ca82e0c 100644 --- a/translate/grt/grt-values.adb +++ b/translate/grt/grt-values.adb @@ -336,21 +336,20 @@ package body Grt.Values is function To_Std_String_Boundp is new Ada.Unchecked_Conversion (Source => System.Address, Target => Std_String_Boundp); - S : aliased Std_String := Str.all; + S : aliased Std_String := Str.all; Bound : aliased Std_String_Bound := Str.Bounds.all; - - Base_Val : Ghdl_I64; - Multiple : Ghdl_Rti_Unit_Val; + Start, Finish : Ghdl_Index_Type; + Found_Real : Boolean := false; Phys_Rti : Ghdl_Rtin_Type_Physical_Acc; Unit : Ghdl_Rtin_Unit_Acc; - Start, Finish : Ghdl_Index_Type; - + Multiple : Ghdl_Rti_Unit_Val; + Mult : Ghdl_I64; begin Phys_Rti := To_Ghdl_Rtin_Type_Physical_Acc (Rti); S.Bounds := To_Std_String_Boundp(Bound'Address); - -- find characters at the end... + -- find characters at the end... Finish := Ghdl_Index_Type(Bound.Dim_1.Length)-1; while White(S.Base.all(Finish)) loop Finish := Finish - 1; @@ -363,9 +362,12 @@ package body Grt.Values is Bound.Dim_1.Right := Bound.Dim_1.Right - Std_Integer(Bound.Dim_1.Length - Start); Bound.Dim_1.Length := Start; - -- and capture integer value - -- FIXME: Should we support real values too? - Base_Val := Ghdl_Value_I64(To_Std_String_Ptr(S'Address)); + -- does the string represent a Real? + for i in 0 .. Start loop + if S.Base.all(i) = '.' then + Found_Real := true; + end if; + end loop; declare Unit_Str : String(1 .. Natural(1 + Finish - Start)); @@ -387,9 +389,16 @@ package body Grt.Values is end; if Rti.Kind = Ghdl_Rtik_Type_P64 then - return Base_Val * Ghdl_I64(Multiple.Unit_64); + Mult := Ghdl_I64(Multiple.Unit_64); + else + Mult := Ghdl_I64(Multiple.Unit_32); + end if; + + if Found_Real then + return Ghdl_I64 (Ghdl_Value_F64 (To_Std_String_Ptr(S'Address)) + * Ghdl_F64 (Mult)); else - return Base_Val * Ghdl_I64(Multiple.Unit_32); + return Ghdl_Value_I64 (To_Std_String_Ptr(S'Address)) * Mult; end if; end Ghdl_Value_Physical_Type; diff --git a/translate/translation.adb b/translate/translation.adb index a71e238..71c0597 100644 --- a/translate/translation.adb +++ b/translate/translation.adb @@ -24834,6 +24834,8 @@ package body Translation is Subprg := Ghdl_Value_E32; when Type_Mode_I32 => Subprg := Ghdl_Value_I32; + when Type_Mode_P32 => + Subprg := Ghdl_Value_P32; when Type_Mode_P64 => Subprg := Ghdl_Value_P64; when Type_Mode_F64 => @@ -24849,6 +24851,7 @@ package body Translation is case Pinfo.Type_Mode is when Type_Mode_B2 | Type_Mode_E8 + | Type_Mode_P32 | Type_Mode_P64 => New_Association (Assoc, New_Lit (Rtis.New_Rti_Address (Pinfo.Type_Rti))); |