diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/simul/simul-vhdl_elab.adb | 109 | ||||
| -rw-r--r-- | src/simul/simul-vhdl_elab.ads | 17 | ||||
| -rw-r--r-- | src/simul/simul-vhdl_simul.adb | 98 | ||||
| -rw-r--r-- | src/synth/elab-vhdl_stmts.adb | 6 |
4 files changed, 194 insertions, 36 deletions
diff --git a/src/simul/simul-vhdl_elab.adb b/src/simul/simul-vhdl_elab.adb index 1185b3cb7..0fd99b551 100644 --- a/src/simul/simul-vhdl_elab.adb +++ b/src/simul/simul-vhdl_elab.adb @@ -24,6 +24,7 @@ with Vhdl.Canon; with Synth.Vhdl_Stmts; with Synth.Vhdl_Decls; +with Synth.Vhdl_Expr; with Trans_Analyzes; with Simul.Vhdl_Debug; @@ -107,7 +108,7 @@ package body Simul.Vhdl_Elab is end; when Type_Record => declare - List : constant Iir_Flist := Get_Elements_Declaration_List + List : constant Node_Flist := Get_Elements_Declaration_List (Sig_Type); El : Iir_Element_Declaration; begin @@ -153,7 +154,7 @@ package body Simul.Vhdl_Elab is end if; E.Sig := null; - if E.Typ.W > 0 then + if E.Kind in Mode_Signal_User and then E.Typ.W > 0 then E.Nbr_Sources := new Nbr_Sources_Array'(0 .. E.Typ.W - 1 => (Nbr_Drivers => 0, @@ -170,6 +171,41 @@ package body Simul.Vhdl_Elab is Signals_Table.Table (Val.Val.S) := E; end Gather_Signal; + procedure Gather_Disconnection (Inst : Synth_Instance_Acc; Decl : Node) + is + List : constant Node_Flist := Get_Signal_List (Decl); + Marker : Mark_Type; + Name : Node; + Base_Vt : Valtyp; + Typ : Type_Acc; + Off : Value_Offsets; + Sig : Signal_Index_Type; + Tval : Valtyp; + T : Std_Time; + begin + Mark_Expr_Pool (Marker); + + Tval := Synth.Vhdl_Expr.Synth_Expression (Inst, Get_Expression (Decl)); + T := Std_Time (Read_Discrete (Tval)); + + for I in Flist_First .. Flist_Last (List) loop + Name := Get_Nth_Element (List, I); + Synth.Vhdl_Stmts.Synth_Assignment_Prefix + (Inst, Name, Base_Vt, Typ, Off); + Sig := Base_Vt.Val.S; + Typ := Unshare (Typ, Global_Pool'Access); + Disconnect_Table.Append + ((Sig => Sig, + Off => Off, + Typ => Typ, + Val => T, + Prev => Signals_Table.Table (Sig).Disconnect)); + Signals_Table.Table (Sig).Disconnect := Disconnect_Table.Last; + end loop; + + Release_Expr_Pool (Marker); + end Gather_Disconnection; + procedure Gather_Quantity (Inst : Synth_Instance_Acc; Decl : Node) is Val : constant Valtyp := Get_Value (Inst, Decl); @@ -206,28 +242,34 @@ package body Simul.Vhdl_Elab is when Iir_Linkage_Mode => Gather_Signal ((Mode_Linkage, Decl, Inst, null, null, null, No_Sensitivity_Index, No_Signal_Index, - No_Driver_Index, No_Connect_Index, null)); + No_Driver_Index, No_Connect_Index, + No_Disconnect_Index, null)); when Iir_Buffer_Mode => Gather_Signal ((Mode_Buffer, Decl, Inst, null, null, null, No_Sensitivity_Index, No_Signal_Index, - No_Driver_Index, No_Connect_Index, null)); + No_Driver_Index, No_Connect_Index, + No_Disconnect_Index, null)); when Iir_Out_Mode => Gather_Signal ((Mode_Out, Decl, Inst, null, null, null, No_Sensitivity_Index, No_Signal_Index, - No_Driver_Index, No_Connect_Index, null)); + No_Driver_Index, No_Connect_Index, + No_Disconnect_Index, null)); when Iir_Inout_Mode => Gather_Signal ((Mode_Inout, Decl, Inst, null, null, null, No_Sensitivity_Index, No_Signal_Index, - No_Driver_Index, No_Connect_Index, null)); + No_Driver_Index, No_Connect_Index, + No_Disconnect_Index, null)); when Iir_In_Mode => Gather_Signal ((Mode_In, Decl, Inst, null, null, null, No_Sensitivity_Index, No_Signal_Index, - No_Driver_Index, No_Connect_Index, null)); + No_Driver_Index, No_Connect_Index, + No_Disconnect_Index, null)); end case; when Iir_Kind_Signal_Declaration => Gather_Signal ((Mode_Signal, Decl, Inst, null, null, null, No_Sensitivity_Index, No_Signal_Index, - No_Driver_Index, No_Connect_Index, null)); + No_Driver_Index, No_Connect_Index, + No_Disconnect_Index, null)); when Iir_Kind_Configuration_Specification => null; when Iir_Kind_Free_Quantity_Declaration @@ -268,6 +310,8 @@ package body Simul.Vhdl_Elab is V := Get_Value (Inst, Decl); Convert_Type_Width (V.Typ); end; + when Iir_Kind_Disconnection_Specification => + Gather_Disconnection (Inst, Decl); when Iir_Kind_Variable_Declaration => pragma Assert (Get_Shared_Flag (Decl)); if Get_Default_Value (Decl) = Null_Node then @@ -846,7 +890,12 @@ package body Simul.Vhdl_Elab is when Iir_Kind_Block_Statement => declare Hdr : constant Node := Get_Block_Header (N); + Guard : constant Node := Get_Guard_Decl (N); begin + if Guard /= Null_Node then + Gather_Signal ((Mode_Guard, Guard, Inst, null, null, null, + No_Sensitivity_Index, No_Signal_Index)); + end if; if Hdr /= Null_Node then Gather_Processes_Decls (Inst, Get_Port_Chain (Hdr)); end if; @@ -916,27 +965,29 @@ package body Simul.Vhdl_Elab is Get_Kind (E.Decl) = Iir_Kind_Interface_Signal_Declaration and then Get_Mode (E.Decl) in Iir_Out_Modes; begin - for J in 1 .. E.Typ.W loop - declare - Ns : Nbr_Sources_Type renames E.Nbr_Sources (J - 1); - begin - Ns.Total := Ns.Nbr_Drivers + Ns.Nbr_Conns; - if Ns.Total = 0 and then Is_Out then - Ns.Total := 1; - end if; - if E.Collapsed_By /= No_Signal_Index then - -- Add to the parent. - declare - C_Ns : Nbr_Sources_Type renames - Signals_Table.Table (E.Collapsed_By) - .Nbr_Sources (J - 1); - begin - -- Remove 1 for the connection. - C_Ns.Total := C_Ns.Total + Ns.Total - 1; - end; - end if; - end; - end loop; + if E.Kind in Mode_Signal_User then + for J in 1 .. E.Typ.W loop + declare + Ns : Nbr_Sources_Type renames E.Nbr_Sources (J - 1); + begin + Ns.Total := Ns.Nbr_Drivers + Ns.Nbr_Conns; + if Ns.Total = 0 and then Is_Out then + Ns.Total := 1; + end if; + if E.Collapsed_By /= No_Signal_Index then + -- Add to the parent. + declare + C_Ns : Nbr_Sources_Type renames + Signals_Table.Table (E.Collapsed_By) + .Nbr_Sources (J - 1); + begin + -- Remove 1 for the connection. + C_Ns.Total := C_Ns.Total + Ns.Total - 1; + end; + end if; + end; + end loop; + end if; end; end loop; end Gather_Processes; diff --git a/src/simul/simul-vhdl_elab.ads b/src/simul/simul-vhdl_elab.ads index 8e6424b3c..233bad313 100644 --- a/src/simul/simul-vhdl_elab.ads +++ b/src/simul/simul-vhdl_elab.ads @@ -52,10 +52,12 @@ package Simul.Vhdl_Elab is type Process_Index_Type is new Nat32; type Driver_Index_Type is new Nat32; subtype Sensitivity_Index_Type is Driver_Index_Type; + type Disconnect_Index_Type is new Nat32; No_Process_Index : constant Process_Index_Type := 0; No_Driver_Index : constant Driver_Index_Type := 0; No_Sensitivity_Index : constant Sensitivity_Index_Type := 0; + No_Disconnect_Index : constant Disconnect_Index_Type := 0; type Proc_Record_Type is record Proc : Node; @@ -161,6 +163,7 @@ package Simul.Vhdl_Elab is when Mode_Signal_User => Drivers : Driver_Index_Type; Connect : Connect_Index_Type; + Disconnect : Disconnect_Index_Type; Nbr_Sources : Nbr_Sources_Arr_Acc; when Mode_Quiet | Mode_Stable | Mode_Delayed | Mode_Transaction => @@ -210,6 +213,20 @@ package Simul.Vhdl_Elab is Table_Low_Bound => No_Sensitivity_Index + 1, Table_Initial => 128); + type Disconnect_Entry is record + Sig : Signal_Index_Type; + Off : Value_Offsets; + Typ : Type_Acc; + Prev : Disconnect_Index_Type; + Val : Std_Time; + end record; + + package Disconnect_Table is new Tables + (Table_Component_Type => Disconnect_Entry, + Table_Index_Type => Disconnect_Index_Type, + Table_Low_Bound => No_Disconnect_Index + 1, + Table_Initial => 8); + type Scalar_Quantity_Index is new Uns32; No_Scalar_Quantity : constant Scalar_Quantity_Index := 0; diff --git a/src/simul/simul-vhdl_simul.adb b/src/simul/simul-vhdl_simul.adb index 5eeebe7b6..cae02fad7 100644 --- a/src/simul/simul-vhdl_simul.adb +++ b/src/simul/simul-vhdl_simul.adb @@ -2222,6 +2222,97 @@ package body Simul.Vhdl_Simul is Create_Signal (E.Val, 0, Sig_Type, E.Typ, E.Nbr_Sources.all, False); end Create_User_Signal; + type Guard_Instance_Type is record + Instance : Synth_Instance_Acc; + Guard : Iir; + end record; + + type Guard_Instance_Acc is access Guard_Instance_Type; + + function Guard_Func (Data : System.Address) return Ghdl_B1; + pragma Convention (C, Guard_Func); + + function Guard_Func (Data : System.Address) return Ghdl_B1 + is + use Areapools; + + Guard : Guard_Instance_Type; + pragma Import (Ada, Guard); + for Guard'Address use Data; + + Val : Boolean; + + Prev_Instance_Pool : constant Areapool_Acc := Instance_Pool; + begin + Instance_Pool := Process_Pool'Access; + + Val := Execute_Condition + (Guard.Instance, Get_Guard_Expression (Guard.Guard)); + + Instance_Pool := Prev_Instance_Pool; + + return Ghdl_B1'Val (Boolean'Pos (Val)); + end Guard_Func; + + procedure Add_Guard_Sensitivity (Typ : Type_Acc; Sig : Memory_Ptr) is + begin + case Typ.Kind is + when Type_Scalars => + Grt.Signals.Ghdl_Signal_Guard_Dependence (Read_Sig (Sig)); + when Type_Vector + | Type_Array => + declare + Len : constant Uns32 := Typ.Abound.Len; + begin + for I in 1 .. Len loop + Add_Guard_Sensitivity + (Typ.Arr_El, Sig_Index (Sig, (Len - I) * Typ.Arr_El.W)); + end loop; + end; + when Type_Record => + for I in Typ.Rec.E'Range loop + Add_Guard_Sensitivity + (Typ.Rec.E (I).Typ, + Sig_Index (Sig, Typ.Rec.E (I).Offs.Net_Off)); + end loop; + when others => + raise Internal_Error; + end case; + end Add_Guard_Sensitivity; + + procedure Create_Guard_Signal (Idx : Signal_Index_Type) + is + E : Signal_Entry renames Signals_Table.Table (Idx); + + Dep_List : Iir_List; + Dep_It : List_Iterator; + S : Ghdl_Signal_Ptr; + Data : Guard_Instance_Acc; + begin + Data := new Guard_Instance_Type'(Instance => E.Inst, Guard => E.Decl); + + S := Grt.Signals.Ghdl_Signal_Create_Guard + (To_Ghdl_Value_Ptr (To_Address (E.Val)), + Data.all'Address, Guard_Func'Access); + Write_Sig (E.Sig, S); + + Dep_List := Get_Guard_Sensitivity_List (E.Decl); + Dep_It := List_Iterate (Dep_List); + while Is_Valid (Dep_It) loop + declare + El : constant Node := Get_Element (Dep_It); + Sig_Mem : Memory_Ptr; + Info : Target_Info; + begin + Info := Synth_Target (E.Inst, El); + Sig_Mem := Signals_Table.Table (Info.Obj.Val.S).Sig; + Add_Guard_Sensitivity + (Info.Targ_Type, Sig_Index (Sig_Mem, Info.Off.Net_Off)); + end; + Next (Dep_It); + end loop; + end Create_Guard_Signal; + function Alloc_Signal_Memory (Vtype : Type_Acc) return Memory_Ptr is function To_Memory_Ptr is new Ada.Unchecked_Conversion @@ -2240,8 +2331,7 @@ package body Simul.Vhdl_Simul is E.Sig := Alloc_Signal_Memory (E.Typ); case E.Kind is when Mode_Guard => - -- Create_Guard_Signal (E.Instance, E.Sig, E.Val, E.Decl); - raise Internal_Error; + Create_Guard_Signal (Idx); when Mode_Stable | Mode_Quiet | Mode_Transaction => -- Create_Implicit_Signal -- (E.Sig, E.Val, E.Time, E.Prefix, E.Kind); @@ -2487,11 +2577,11 @@ package body Simul.Vhdl_Simul is Dst_Val := Create_Value_Memory (Val, Current_Pool); Dst_Val := Synth_Association_Conversion (Conv.Inst, Conv.Func, Dst_Val, Conv.Dst_Typ); - pragma Assert (Dst_Val.Typ.Wkind = Wkind_Sim); - if Dst_Val = No_Valtyp then Grt.Errors.Fatal_Error; end if; + + pragma Assert (Dst_Val.Typ.Wkind = Wkind_Sim); Convert_Type_Width (Dst_Val.Typ); Dst := Synth.Vhdl_Expr.Get_Value_Memtyp (Dst_Val); diff --git a/src/synth/elab-vhdl_stmts.adb b/src/synth/elab-vhdl_stmts.adb index 720db8ad3..def7e9218 100644 --- a/src/synth/elab-vhdl_stmts.adb +++ b/src/synth/elab-vhdl_stmts.adb @@ -197,6 +197,7 @@ package body Elab.Vhdl_Stmts is procedure Elab_Block_Statement (Syn_Inst : Synth_Instance_Acc; Blk : Node) is Hdr : constant Node := Get_Block_Header (Blk); + Guard : constant Node := Get_Guard_Decl (Blk); Blk_Inst : Synth_Instance_Acc; Assoc : Node; Inter : Node; @@ -207,9 +208,8 @@ package body Elab.Vhdl_Stmts is Blk_Inst := Make_Elab_Instance (Syn_Inst, Blk, Null_Iir); Create_Sub_Instance (Syn_Inst, Blk, Blk_Inst); - -- No support for guard. - if Get_Guard_Decl (Blk) /= Null_Node then - raise Internal_Error; + if Guard /= Null_Node then + Create_Signal (Blk_Inst, Guard, Boolean_Type, null); end if; if Hdr /= Null_Node then |