From 84197c2a93bc54df2d1f3fa0bdf20d121d8f73c5 Mon Sep 17 00:00:00 2001 From: Tristan Gingold Date: Thu, 15 Sep 2022 01:57:07 +0200 Subject: simul: handle more signals types --- src/simul/simul-vhdl_elab.ads | 3 + src/simul/simul-vhdl_simul.adb | 148 ++++++++++++++++++++++++++++++++++------- 2 files changed, 128 insertions(+), 23 deletions(-) (limited to 'src/simul') diff --git a/src/simul/simul-vhdl_elab.ads b/src/simul/simul-vhdl_elab.ads index 41185806f..8e6424b3c 100644 --- a/src/simul/simul-vhdl_elab.ads +++ b/src/simul/simul-vhdl_elab.ads @@ -46,6 +46,9 @@ package Simul.Vhdl_Elab is -- * need to track events procedure Elab_Drivers; + -- Change the meaning of W (width) in T for simulation. + procedure Convert_Type_Width (T : Type_Acc); + type Process_Index_Type is new Nat32; type Driver_Index_Type is new Nat32; subtype Sensitivity_Index_Type is Driver_Index_Type; diff --git a/src/simul/simul-vhdl_simul.adb b/src/simul/simul-vhdl_simul.adb index 744df677d..ffcf0f130 100644 --- a/src/simul/simul-vhdl_simul.adb +++ b/src/simul/simul-vhdl_simul.adb @@ -212,6 +212,8 @@ package body Simul.Vhdl_Simul is else raise Internal_Error; end if; + when Type_Float => + Write_Fp64 (Mt.Mem, Fp64 (Val.F64)); when others => raise Internal_Error; end case; @@ -1809,18 +1811,51 @@ package body Simul.Vhdl_Simul is procedure Resolver_Read_Value (Dst : Memtyp; Sig : Memory_Ptr; Mode : Resolver_Read_Mode; - Index : Ghdl_Index_Type) - is - S : constant Ghdl_Signal_Ptr := Read_Sig (Sig); - Val : Ghdl_Value_Ptr; - begin - case Mode is - when Read_Port => - Val := Ghdl_Signal_Read_Port (S, Index); - when Read_Driver => - Val := Ghdl_Signal_Read_Driver (S, Index); + Index : Ghdl_Index_Type) is + begin + case Dst.Typ.Kind is + when Type_Bit + | Type_Logic + | Type_Discrete + | Type_Float => + declare + S : constant Ghdl_Signal_Ptr := Read_Sig (Sig); + Val : Ghdl_Value_Ptr; + begin + case Mode is + when Read_Port => + Val := Ghdl_Signal_Read_Port (S, Index); + when Read_Driver => + Val := Ghdl_Signal_Read_Driver (S, Index); + end case; + Write_Ghdl_Value (Dst, Val.all); + end; + when Type_Vector + | Type_Array => + declare + Typ : constant Type_Acc := Dst.Typ; + Len : constant Uns32 := Typ.Abound.Len; + begin + for I in 1 .. Len loop + Resolver_Read_Value + ((Typ.Arr_El, Dst.Mem + Size_Type (I - 1) * Typ.Arr_El.Sz), + Sig_Index (Sig, (Len - I) * Typ.Arr_El.W), + Mode, Index); + end loop; + end; + when Type_Record => + for I in Dst.Typ.Rec.E'Range loop + declare + E : Rec_El_Type renames Dst.Typ.Rec.E (I); + begin + Resolver_Read_Value ((E.Typ, Dst.Mem + E.Offs.Mem_Off), + Sig_Index (Sig, E.Offs.Net_Off), + Mode, Index); + end; + end loop; + when others => + raise Internal_Error; end case; - Write_Ghdl_Value (Dst, Val.all); end Resolver_Read_Value; type Read_Signal_Enum is @@ -1843,7 +1878,9 @@ package body Simul.Vhdl_Simul is begin case Val.Typ.Kind is when Type_Bit - | Type_Logic => + | Type_Logic + | Type_Discrete + | Type_Float => S := Read_Sig (Sig); case Attr is when Read_Signal_Driving_Value => @@ -1864,6 +1901,16 @@ package body Simul.Vhdl_Simul is Attr); end loop; end; + when Type_Record => + for I in Val.Typ.Rec.E'Range loop + declare + E : Rec_El_Type renames Val.Typ.Rec.E (I); + begin + Exec_Read_Signal (Sig_Index (Sig, E.Offs.Net_Off), + (E.Typ, Val.Mem + E.Offs.Mem_Off), + Attr); + end; + end loop; when others => raise Internal_Error; end case; @@ -1882,7 +1929,8 @@ package body Simul.Vhdl_Simul is case Val.Typ.Kind is when Type_Bit | Type_Logic - | Type_Discrete => + | Type_Discrete + | Type_Float => S := Read_Sig (Sig); case Attr is when Write_Signal_Driving_Value => @@ -1903,6 +1951,16 @@ package body Simul.Vhdl_Simul is Attr); end loop; end; + when Type_Record => + for I in Val.Typ.Rec.E'Range loop + declare + E : Rec_El_Type renames Val.Typ.Rec.E (I); + begin + Exec_Write_Signal (Sig_Index (Sig, E.Offs.Net_Off), + (E.Typ, Val.Mem + E.Offs.Mem_Off), + Attr); + end; + end loop; when others => raise Internal_Error; end case; @@ -2285,7 +2343,8 @@ package body Simul.Vhdl_Simul is pragma Assert (Dst.Typ.Kind = Src.Typ.Kind); case Dst.Typ.Kind is - when Type_Vector => + when Type_Vector + | Type_Array => declare Len : constant Uns32 := Dst.Typ.Abound.Len; Etyp : constant Type_Acc := Dst.Typ.Arr_El; @@ -2350,6 +2409,7 @@ package body Simul.Vhdl_Simul is if Res = No_Valtyp then Grt.Errors.Fatal_Error; end if; + Convert_Type_Width (Res.Typ); return Synth.Vhdl_Expr.Get_Value_Memtyp (Res); end; when others => @@ -2366,7 +2426,8 @@ package body Simul.Vhdl_Simul is case Typ.Kind is when Type_Bit | Type_Logic - | Type_Discrete => + | Type_Discrete + | Type_Float => S := Create_Scalar_Signal (Typ, To_Ghdl_Value_Ptr (To_Address (Val))); Write_Sig (Sig, S); @@ -2382,6 +2443,16 @@ package body Simul.Vhdl_Simul is Typ.Arr_El); end loop; end; + when Type_Record => + for I in Typ.Rec.E'Range loop + declare + E : Rec_El_Type renames Typ.Rec.E (I); + begin + Create_Shadow_Signal (Sig_Index (Sig, E.Offs.Net_Off), + Val + E.Offs.Mem_Off, + E.Typ); + end; + end loop; when others => raise Internal_Error; end case; @@ -2426,6 +2497,7 @@ package body Simul.Vhdl_Simul is Dst := Execute_Assoc_Conversion (Conv.Inst, Conv.Func, Val, Conv.Dst_Typ); + pragma Assert (Dst.Typ.Wkind = Wkind_Sim); case Conv.Mode is when Convert_In => @@ -2447,13 +2519,21 @@ package body Simul.Vhdl_Simul is case Typ.Kind is when Type_Bit | Type_Logic - | Type_Discrete => + | Type_Discrete + | Type_Float => return Read_Sig (Sig); when Type_Vector | Type_Array => return Get_Leftest_Signal (Sig_Index (Sig, (Typ.Abound.Len - 1) * Typ.Arr_El.W), Typ.Arr_El); + when Type_Record => + declare + E : Rec_El_Type renames Typ.Rec.E (1); + begin + return Get_Leftest_Signal + (Sig_Index (Sig, E.Offs.Net_Off), E.Typ); + end; when others => raise Internal_Error; end case; @@ -2490,21 +2570,43 @@ package body Simul.Vhdl_Simul is begin if C.Drive_Actual then declare - Out_Conv : constant Iir := Get_Formal_Conversion (C.Assoc); + Out_Conv : constant Node := Get_Formal_Conversion (C.Assoc); + Csig : Memory_Ptr; + Cval : Memory_Ptr; + Ctyp : Type_Acc; + Form, Form2 : Memtyp; begin - pragma Assert (Out_Conv = Null_Iir); + Form := To_Memtyp (C.Formal); + + if Out_Conv /= Null_Node then + -- From formal to actual. + Ctyp := C.Actual.Typ; + Csig := Alloc_Signal_Memory (Ctyp); + Cval := Alloc_Memory (Ctyp, Global_Pool'Access); + Create_Shadow_Signal (Csig, Cval, Ctyp); + Form2 := (Ctyp, Csig); + Add_Conversion + (new Convert_Instance_Type'(Mode => Convert_Out, + Inst => C.Assoc_Inst, + Func => Out_Conv, + Src_Sig => Form.Mem, + Src_Typ => Form.Typ, + Dst_Sig => Form2.Mem, + Dst_Typ => Form2.Typ)); + else + Form2 := Form; + end if; + -- LRM93 12.6.2 -- A signal is said to be active [...] if one of its source -- is active. - Connect (To_Memtyp (C.Actual), - To_Memtyp (C.Formal), - Connect_Source); + Connect (To_Memtyp (C.Actual), Form2, Connect_Source); end; end if; if C.Drive_Formal then declare - In_Conv : constant Iir := Get_Actual_Conversion (C.Assoc); + In_Conv : constant Node := Get_Actual_Conversion (C.Assoc); Csig : Memory_Ptr; Cval : Memory_Ptr; Ctyp : Type_Acc; @@ -2512,7 +2614,7 @@ package body Simul.Vhdl_Simul is begin Act := To_Memtyp (C.Actual); - if In_Conv /= Null_Iir then + if In_Conv /= Null_Node then Ctyp := C.Formal.Typ; Csig := Alloc_Signal_Memory (Ctyp); Cval := Alloc_Memory (Ctyp, Global_Pool'Access); -- cgit v1.2.3