diff options
Diffstat (limited to 'translate')
| -rw-r--r-- | translate/grt/grt-vcd.adb | 98 | ||||
| -rw-r--r-- | translate/grt/grt-vcd.ads | 1 | ||||
| -rw-r--r-- | translate/grt/grt-vpi.adb | 9 |
3 files changed, 103 insertions, 5 deletions
diff --git a/translate/grt/grt-vcd.adb b/translate/grt/grt-vcd.adb index bf1842d..b2e3dfa 100644 --- a/translate/grt/grt-vcd.adb +++ b/translate/grt/grt-vcd.adb @@ -257,6 +257,9 @@ package body Grt.Vcd is if Rti1.Kind = Ghdl_Rtik_Type_I32 then return Vcd_Integer32; end if; + if Rti1.Kind = Ghdl_Rtik_Type_F64 then + return Vcd_Float64; + end if; return Vcd_Bad; end Rti_To_Vcd_Kind; @@ -395,6 +398,8 @@ package body Grt.Vcd is case Vcd_El.Kind is when Vcd_Integer32 => Vcd_Put ("integer 32"); + when Vcd_Float64 => + Vcd_Put ("real 64"); when Vcd_Bool | Vcd_Bit | Vcd_Stdlogic => @@ -548,6 +553,85 @@ package body Grt.Vcd is end loop; end Vcd_Put_Integer32; + -- Using the floor attribute of Ghdl_F64 will result on a link error while + -- trying to simulate a design. So it was needed to create a floor function + function Digit_Floor (V : Ghdl_F64) return Ghdl_I32 + is + Var : Ghdl_I32; + begin + -- V is alway positiv in our case and we are only interested when it is a digit + if V > 10.0 then + return -1; + else + Var := Ghdl_I32(V-0.5); --Ghdl_I32 rounds to the nearest integer + -- The rounding made by Ghdl_I32 is asymetric : + -- 0.5 will be rounded to 1, but -0.5 to -1 instead of 0 + if Var > 0 then + return Var; + else + return 0; + end if; + end if; + end Digit_Floor; + + procedure Vcd_Put_Float64 (V : Ghdl_F64) + is + Val_tmp, Fact : Ghdl_F64; + Digit, Exp, Delta_Exp, N_Exp : Ghdl_I32; + -- + begin + Exp := 0; + if V /= V then + Vcd_Put("NaN"); + return; + end if; + if V < 0.0 then + Vcd_Putc ('-'); + Val_tmp := -V; + elsif V = 0.0 then + Vcd_Put("0.0"); + return; + else + Val_tmp := V; + end if; + if Val_tmp > Ghdl_F64'Last then + Vcd_Put("Inf"); + return; + elsif Val_tmp < 1.0 then + Fact := 10.0; + Delta_Exp := -1; + else + Fact := 0.1; + Delta_Exp := 1; + end if; + while 1 = 1 loop -- Seek the first digit + Digit := Digit_Floor(Val_tmp); + if Digit > 0 then + exit; + end if; + Exp := Exp + Delta_Exp; + Val_tmp := Val_tmp * Fact; + end loop; + Vcd_Putc(Character'Val(Digit + 48)); + Vcd_Putc('.'); + for i in 0..4 loop -- 5 digits displayed after the point + Val_tmp := abs(Val_tmp - Ghdl_F64(Digit))*10.0; + Digit := Digit_Floor(Val_tmp); + Vcd_Putc(Character'Val(Digit + 48)); + end loop; + Vcd_Putc('E'); + if Exp < 0 then + Vcd_Putc('-'); + Exp := -Exp; + end if; + N_Exp := 100; + while N_Exp > 0 loop + Vcd_Putc(Character'Val(Exp/N_Exp + 48)); + Exp := Exp Mod N_Exp; + N_Exp := N_Exp/10; + end loop; + end Vcd_Put_Float64; + procedure Vcd_Put_Var (I : Vcd_Index_Type) is Addr : Address; @@ -572,6 +656,10 @@ package body Grt.Vcd is Vcd_Putc ('b'); Vcd_Put_Integer32 (To_Signal_Arr_Ptr (Addr)(0).Value.E32); Vcd_Putc (' '); + when Vcd_Float64 => + Vcd_Putc ('r'); + Vcd_Put_Float64 (To_Signal_Arr_Ptr (Addr)(0).Value.F64); + Vcd_Putc (' '); when Vcd_Bitvector => Vcd_Putc ('b'); for J in 0 .. Len - 1 loop @@ -601,6 +689,10 @@ package body Grt.Vcd is Vcd_Put_Integer32 (To_Signal_Arr_Ptr (Addr)(0).Driving_Value.E32); Vcd_Putc (' '); + when Vcd_Float64 => + Vcd_Putc ('r'); + Vcd_Put_Float64 (To_Signal_Arr_Ptr (Addr)(0).Driving_Value.F64); + Vcd_Putc (' '); when Vcd_Bitvector => Vcd_Putc ('b'); for J in 0 .. Len - 1 loop @@ -643,7 +735,8 @@ package body Grt.Vcd is | Vcd_Stdlogic | Vcd_Bitvector | Vcd_Stdlogic_Vector - | Vcd_Integer32 => + | Vcd_Integer32 + | Vcd_Float64 => for J in 0 .. Len - 1 loop if To_Signal_Arr_Ptr (Info.Addr)(J).Last_Event = Last then return True; @@ -659,7 +752,8 @@ package body Grt.Vcd is | Vcd_Stdlogic | Vcd_Bitvector | Vcd_Stdlogic_Vector - | Vcd_Integer32 => + | Vcd_Integer32 + | Vcd_Float64 => for J in 0 .. Len - 1 loop if To_Signal_Arr_Ptr (Info.Addr)(J).Last_Active = Last then diff --git a/translate/grt/grt-vcd.ads b/translate/grt/grt-vcd.ads index 1079e90..fe19886 100644 --- a/translate/grt/grt-vcd.ads +++ b/translate/grt/grt-vcd.ads @@ -32,6 +32,7 @@ package Grt.Vcd is type Vcd_Var_Kind is (Vcd_Bad, Vcd_Bool, Vcd_Integer32, + Vcd_Float64, Vcd_Bit, Vcd_Stdlogic, Vcd_Bitvector, Vcd_Stdlogic_Vector); diff --git a/translate/grt/grt-vpi.adb b/translate/grt/grt-vpi.adb index ff311be..3000337 100644 --- a/translate/grt/grt-vpi.adb +++ b/translate/grt/grt-vpi.adb @@ -417,7 +417,8 @@ package body Grt.Vpi is when Vcd_Effective => case Info.Kind is when Vcd_Bad - | Vcd_Integer32 => + | Vcd_Integer32 + | Vcd_Float64 => return null; when Vcd_Bit | Vcd_Bool @@ -436,7 +437,8 @@ package body Grt.Vpi is when Vcd_Driving => case Info.Kind is when Vcd_Bad - | Vcd_Integer32 => + | Vcd_Integer32 + | Vcd_Float64 => return null; when Vcd_Bit | Vcd_Bool @@ -633,7 +635,8 @@ package body Grt.Vpi is ii_vpi_put_value_bin_str_E8( To_Signal_Arr_Ptr(Info.Addr)(J), ValueStr(Integer(J+1))); end loop; - when Vcd_Integer32 => + when Vcd_Integer32 + | Vcd_Float64 => null; end case; |