From ab2fd3d52f149efcc9cc66f0a0a5e378a1d63918 Mon Sep 17 00:00:00 2001 From: Tristan Gingold Date: Sun, 2 Aug 2020 09:26:44 +0200 Subject: vhdl: handle force/release statements in translate and grt. For #1416 --- src/ghdldrv/ghdlrun.adb | 29 +++ src/grt/grt-disp_signals.adb | 38 ++- src/grt/grt-signals.adb | 480 ++++++++++++++++++++++++++++--------- src/grt/grt-signals.ads | 60 +++++ src/grt/grt-vpi.adb | 19 +- src/vhdl/translate/trans-chap8.adb | 129 +++++++++- src/vhdl/translate/trans_decls.ads | 15 ++ src/vhdl/translate/translation.adb | 79 ++++-- 8 files changed, 688 insertions(+), 161 deletions(-) (limited to 'src') diff --git a/src/ghdldrv/ghdlrun.adb b/src/ghdldrv/ghdlrun.adb index e0e1d5dbc..e8fd536a8 100644 --- a/src/ghdldrv/ghdlrun.adb +++ b/src/ghdldrv/ghdlrun.adb @@ -465,6 +465,11 @@ package body Ghdlrun is Def (Trans_Decls.Ghdl_Signal_Direct_Assign, Grt.Signals.Ghdl_Signal_Direct_Assign'Address); + Def (Trans_Decls.Ghdl_Signal_Release_Eff, + Grt.Signals.Ghdl_Signal_Release_Eff'Address); + Def (Trans_Decls.Ghdl_Signal_Release_Drv, + Grt.Signals.Ghdl_Signal_Release_Drv'Address); + Def (Trans_Decls.Ghdl_Create_Signal_B1, Grt.Signals.Ghdl_Create_Signal_B1'Address); Def (Trans_Decls.Ghdl_Signal_Init_B1, @@ -479,6 +484,10 @@ package body Ghdlrun is Grt.Signals.Ghdl_Signal_Associate_B1'Address); Def (Trans_Decls.Ghdl_Signal_Add_Port_Driver_B1, Grt.Signals.Ghdl_Signal_Add_Port_Driver_B1'Address); + Def (Trans_Decls.Ghdl_Signal_Force_Drv_B1, + Grt.Signals.Ghdl_Signal_Force_Driving_B1'Address); + Def (Trans_Decls.Ghdl_Signal_Force_Eff_B1, + Grt.Signals.Ghdl_Signal_Force_Effective_B1'Address); Def (Trans_Decls.Ghdl_Create_Signal_E8, Grt.Signals.Ghdl_Create_Signal_E8'Address); @@ -494,6 +503,10 @@ package body Ghdlrun is Grt.Signals.Ghdl_Signal_Associate_E8'Address); Def (Trans_Decls.Ghdl_Signal_Add_Port_Driver_E8, Grt.Signals.Ghdl_Signal_Add_Port_Driver_E8'Address); + Def (Trans_Decls.Ghdl_Signal_Force_Drv_E8, + Grt.Signals.Ghdl_Signal_Force_Driving_E8'Address); + Def (Trans_Decls.Ghdl_Signal_Force_Eff_E8, + Grt.Signals.Ghdl_Signal_Force_Effective_E8'Address); Def (Trans_Decls.Ghdl_Create_Signal_E32, Grt.Signals.Ghdl_Create_Signal_E32'Address); @@ -509,6 +522,10 @@ package body Ghdlrun is Grt.Signals.Ghdl_Signal_Associate_E32'Address); Def (Trans_Decls.Ghdl_Signal_Add_Port_Driver_E32, Grt.Signals.Ghdl_Signal_Add_Port_Driver_E32'Address); + Def (Trans_Decls.Ghdl_Signal_Force_Drv_E32, + Grt.Signals.Ghdl_Signal_Force_Driving_E32'Address); + Def (Trans_Decls.Ghdl_Signal_Force_Eff_E32, + Grt.Signals.Ghdl_Signal_Force_Effective_E32'Address); Def (Trans_Decls.Ghdl_Create_Signal_I32, Grt.Signals.Ghdl_Create_Signal_I32'Address); @@ -524,6 +541,10 @@ package body Ghdlrun is Grt.Signals.Ghdl_Signal_Associate_I32'Address); Def (Trans_Decls.Ghdl_Signal_Add_Port_Driver_I32, Grt.Signals.Ghdl_Signal_Add_Port_Driver_I32'Address); + Def (Trans_Decls.Ghdl_Signal_Force_Drv_I32, + Grt.Signals.Ghdl_Signal_Force_Driving_I32'Address); + Def (Trans_Decls.Ghdl_Signal_Force_Eff_I32, + Grt.Signals.Ghdl_Signal_Force_Effective_I32'Address); Def (Trans_Decls.Ghdl_Create_Signal_I64, Grt.Signals.Ghdl_Create_Signal_I64'Address); @@ -539,6 +560,10 @@ package body Ghdlrun is Grt.Signals.Ghdl_Signal_Associate_I64'Address); Def (Trans_Decls.Ghdl_Signal_Add_Port_Driver_I64, Grt.Signals.Ghdl_Signal_Add_Port_Driver_I64'Address); + Def (Trans_Decls.Ghdl_Signal_Force_Drv_I64, + Grt.Signals.Ghdl_Signal_Force_Driving_I64'Address); + Def (Trans_Decls.Ghdl_Signal_Force_Eff_I64, + Grt.Signals.Ghdl_Signal_Force_Effective_I64'Address); Def (Trans_Decls.Ghdl_Create_Signal_F64, Grt.Signals.Ghdl_Create_Signal_F64'Address); @@ -554,6 +579,10 @@ package body Ghdlrun is Grt.Signals.Ghdl_Signal_Associate_F64'Address); Def (Trans_Decls.Ghdl_Signal_Add_Port_Driver_F64, Grt.Signals.Ghdl_Signal_Add_Port_Driver_F64'Address); + Def (Trans_Decls.Ghdl_Signal_Force_Drv_F64, + Grt.Signals.Ghdl_Signal_Force_Driving_F64'Address); + Def (Trans_Decls.Ghdl_Signal_Force_Eff_F64, + Grt.Signals.Ghdl_Signal_Force_Effective_F64'Address); Def (Trans_Decls.Ghdl_Signal_Attribute_Register_Prefix, Grt.Signals.Ghdl_Signal_Attribute_Register_Prefix'Address); diff --git a/src/grt/grt-disp_signals.adb b/src/grt/grt-disp_signals.adb index 887898109..78b065432 100644 --- a/src/grt/grt-disp_signals.adb +++ b/src/grt/grt-disp_signals.adb @@ -167,30 +167,28 @@ package body Grt.Disp_Signals is end loop; end Disp_Transaction; + procedure Disp_Flag (Name : Character; Cond : Boolean) + is + C : Character; + begin + if Cond then + C := Name; + else + C := '-'; + end if; + Put (C); + end Disp_Flag; + procedure Disp_Single_Signal_Attributes (Sig : Ghdl_Signal_Ptr) is begin Disp_Mode (Sig.Mode); Put (' '); - if Sig.Active then - Put ('A'); - else - Put ('-'); - end if; - if Sig.Event then - Put ('E'); - else - Put ('-'); - end if; - if Sig.Has_Active then - Put ('a'); - else - Put ('-'); - end if; - if Sig.S.Effective /= null then - Put ('e'); - else - Put ('-'); - end if; + Disp_Flag ('A', Sig.Active); + Disp_Flag ('E', Sig.Event); + Disp_Flag ('a', Sig.Has_Active); + Disp_Flag ('e', Sig.S.Effective /= null); + Disp_Flag ('F', Sig.Flags.Is_Drv_Forced); + Disp_Flag ('f', Sig.Flags.Is_Eff_Forced); if Boolean'(True) then Put (" last_event="); Put_Time (stdout, Sig.Last_Event); diff --git a/src/grt/grt-signals.adb b/src/grt/grt-signals.adb index 0478146e2..5af58eda9 100644 --- a/src/grt/grt-signals.adb +++ b/src/grt/grt-signals.adb @@ -236,6 +236,10 @@ package body Grt.Signals is Sig_Kind => Sig_Kind, Is_Direct_Active => False, Is_Dumped => False, + Is_Drv_Forced => False, + Is_Eff_Forced => False, + Is_Drv_Force_Scheduled => False, + Is_Eff_Force_Scheduled => False, RO_Event => False, Implicit_Active_Next => False, Seen => False), @@ -602,6 +606,10 @@ package body Grt.Signals is Sig_Kind => Kind_Signal_No, Is_Direct_Active => False, Is_Dumped => False, + Is_Drv_Forced => False, + Is_Eff_Forced => False, + Is_Drv_Force_Scheduled => False, + Is_Eff_Force_Scheduled => False, RO_Event => False, Implicit_Active_Next => False, Seen => False), @@ -1826,16 +1834,22 @@ package body Grt.Signals is end if; end Ghdl_Signal_Driving_Value_F64; - type Force_Value_Kind is (Force_Driving, Force_Effective); - -- To add: Release_Driving, Release_Effective + type Force_Kind is (Force, Release); + type Force_Mode is (Force_Effective, Force_Driving); - type Force_Value (Kind : Force_Value_Kind); + type Force_Value (Kind : Force_Kind); type Force_Value_Acc is access Force_Value; - type Force_Value (Kind : Force_Value_Kind) is record + type Force_Value (Kind : Force_Kind) is record + Mode : Force_Mode; Next : Force_Value_Acc; - Sig : Ghdl_Signal_Ptr; - Val : aliased Value_Union; + Sig : Ghdl_Signal_Ptr; + case Kind is + when Force => + Val : aliased Value_Union; + when Release => + null; + end case; end record; procedure Free is new Ada.Unchecked_Deallocation @@ -1855,10 +1869,27 @@ package body Grt.Signals is Force_Value_Last := F; end Append_Force_Value; + procedure Ghdl_Signal_Release_Eff (Sig : Ghdl_Signal_Ptr) is + begin + Append_Force_Value (new Force_Value'(Kind => Release, + Mode => Force_Effective, + Next => null, + Sig => Sig)); + end Ghdl_Signal_Release_Eff; + + procedure Ghdl_Signal_Release_Drv (Sig : Ghdl_Signal_Ptr) is + begin + Append_Force_Value (new Force_Value'(Kind => Release, + Mode => Force_Driving, + Next => null, + Sig => Sig)); + end Ghdl_Signal_Release_Drv; + procedure Ghdl_Signal_Force_Driving_B1 (Sig : Ghdl_Signal_Ptr; Val : Ghdl_B1) is begin - Append_Force_Value (new Force_Value'(Kind => Force_Driving, + Append_Force_Value (new Force_Value'(Kind => Force, + Mode => Force_Driving, Next => null, Sig => Sig, Val => (Mode => Mode_B1, @@ -1868,7 +1899,8 @@ package body Grt.Signals is procedure Ghdl_Signal_Force_Effective_B1 (Sig : Ghdl_Signal_Ptr; Val : Ghdl_B1) is begin - Append_Force_Value (new Force_Value'(Kind => Force_Effective, + Append_Force_Value (new Force_Value'(Kind => Force, + Mode => Force_Effective, Next => null, Sig => Sig, Val => (Mode => Mode_B1, @@ -1878,7 +1910,8 @@ package body Grt.Signals is procedure Ghdl_Signal_Force_Driving_E8 (Sig : Ghdl_Signal_Ptr; Val : Ghdl_E8) is begin - Append_Force_Value (new Force_Value'(Kind => Force_Driving, + Append_Force_Value (new Force_Value'(Kind => Force, + Mode => Force_Driving, Next => null, Sig => Sig, Val => (Mode => Mode_E8, @@ -1888,13 +1921,102 @@ package body Grt.Signals is procedure Ghdl_Signal_Force_Effective_E8 (Sig : Ghdl_Signal_Ptr; Val : Ghdl_E8) is begin - Append_Force_Value (new Force_Value'(Kind => Force_Effective, + Append_Force_Value (new Force_Value'(Kind => Force, + Mode => Force_Effective, Next => null, Sig => Sig, Val => (Mode => Mode_E8, E8 => Val))); end Ghdl_Signal_Force_Effective_E8; + procedure Ghdl_Signal_Force_Driving_E32 (Sig : Ghdl_Signal_Ptr; + Val : Ghdl_E32) is + begin + Append_Force_Value (new Force_Value'(Kind => Force, + Mode => Force_Driving, + Next => null, + Sig => Sig, + Val => (Mode => Mode_E32, + E32 => Val))); + end Ghdl_Signal_Force_Driving_E32; + + procedure Ghdl_Signal_Force_Effective_E32 (Sig : Ghdl_Signal_Ptr; + Val : Ghdl_E32) is + begin + Append_Force_Value (new Force_Value'(Kind => Force, + Mode => Force_Effective, + Next => null, + Sig => Sig, + Val => (Mode => Mode_E32, + E32 => Val))); + end Ghdl_Signal_Force_Effective_E32; + + procedure Ghdl_Signal_Force_Driving_I32 (Sig : Ghdl_Signal_Ptr; + Val : Ghdl_I32) is + begin + Append_Force_Value (new Force_Value'(Kind => Force, + Mode => Force_Driving, + Next => null, + Sig => Sig, + Val => (Mode => Mode_I32, + I32 => Val))); + end Ghdl_Signal_Force_Driving_I32; + + procedure Ghdl_Signal_Force_Effective_I32 (Sig : Ghdl_Signal_Ptr; + Val : Ghdl_I32) is + begin + Append_Force_Value (new Force_Value'(Kind => Force, + Mode => Force_Effective, + Next => null, + Sig => Sig, + Val => (Mode => Mode_I32, + I32 => Val))); + end Ghdl_Signal_Force_Effective_I32; + + procedure Ghdl_Signal_Force_Driving_I64 (Sig : Ghdl_Signal_Ptr; + Val : Ghdl_I64) is + begin + Append_Force_Value (new Force_Value'(Kind => Force, + Mode => Force_Driving, + Next => null, + Sig => Sig, + Val => (Mode => Mode_I64, + I64 => Val))); + end Ghdl_Signal_Force_Driving_I64; + + procedure Ghdl_Signal_Force_Effective_I64 (Sig : Ghdl_Signal_Ptr; + Val : Ghdl_I64) is + begin + Append_Force_Value (new Force_Value'(Kind => Force, + Mode => Force_Effective, + Next => null, + Sig => Sig, + Val => (Mode => Mode_I64, + I64 => Val))); + end Ghdl_Signal_Force_Effective_I64; + + procedure Ghdl_Signal_Force_Driving_F64 (Sig : Ghdl_Signal_Ptr; + Val : Ghdl_F64) is + begin + Append_Force_Value (new Force_Value'(Kind => Force, + Mode => Force_Driving, + Next => null, + Sig => Sig, + Val => (Mode => Mode_F64, + F64 => Val))); + end Ghdl_Signal_Force_Driving_F64; + + procedure Ghdl_Signal_Force_Effective_F64 (Sig : Ghdl_Signal_Ptr; + Val : Ghdl_F64) is + begin + Append_Force_Value (new Force_Value'(Kind => Force, + Mode => Force_Effective, + Next => null, + Sig => Sig, + Val => (Mode => Mode_F64, + F64 => Val))); + end Ghdl_Signal_Force_Effective_F64; + -- Remove all (but Signal_End) signals in the next active chain. -- Called when a transaction/event will occur before the time for this -- chain. @@ -3050,21 +3172,25 @@ package body Grt.Signals is -- update_signals. Mark_Active (Sig); Assign (First_Trans.Val, Trans.Val_Ptr, Sig.Mode); - Sig.Driving_Value := First_Trans.Val; + if not Sig.Flags.Is_Drv_Forced then + Sig.Driving_Value := First_Trans.Val; + end if; elsif Trans.Time = Current_Time then Mark_Active (Sig); Free (First_Trans); Sig.S.Drivers (0).First_Trans := Trans; - case Trans.Kind is - when Trans_Value => - Sig.Driving_Value := Trans.Val; - when Trans_Direct => - Internal_Error ("run_propagation: trans_direct"); - when Trans_Null => - Error ("null transaction"); - when Trans_Error => - Error_Trans_Error (Trans); - end case; + if not Sig.Flags.Is_Drv_Forced then + case Trans.Kind is + when Trans_Value => + Sig.Driving_Value := Trans.Val; + when Trans_Direct => + Internal_Error ("run_propagation: trans_direct"); + when Trans_Null => + Error ("null transaction"); + when Trans_Error => + Error_Trans_Error (Trans); + end case; + end if; end if; end if; when Drv_One_Resolved @@ -3072,14 +3198,19 @@ package body Grt.Signals is Sig := Propagation.Table (I).Sig; if Get_Resolved_Activity (Sig) then Mark_Active (Sig); - Compute_Resolved_Signal (Propagation.Table (I).Sig.S.Resolv); + if not Sig.Flags.Is_Drv_Forced then + Compute_Resolved_Signal + (Propagation.Table (I).Sig.S.Resolv); + end if; end if; when Drv_One_Port | Eff_One_Port => Sig := Propagation.Table (I).Sig; if Sig.Ports (0).Active then Mark_Active (Sig); - Sig.Driving_Value := Sig.Ports (0).Driving_Value; + if not Sig.Flags.Is_Drv_Forced then + Sig.Driving_Value := Sig.Ports (0).Driving_Value; + end if; end if; when Eff_Actual => Sig := Propagation.Table (I).Sig; @@ -3105,7 +3236,9 @@ package body Grt.Signals is loop Mark_Active (Sig_Table.Table (I)); end loop; - Compute_Resolved_Signal (Resolv); + if not Sig.Flags.Is_Drv_Forced then + Compute_Resolved_Signal (Resolv); + end if; end if; end; when Imp_Guard @@ -3124,11 +3257,14 @@ package body Grt.Signals is Mark_Active (Sig); Free (Sig.S.Attr_Trans); Sig.S.Attr_Trans := Trans; - Sig.Driving_Value := Trans.Val; + if not Sig.Flags.Is_Drv_Forced then + Sig.Driving_Value := Trans.Val; + end if; end if; when In_Conversion => null; when Out_Conversion => + -- FIXME: do not overwrite the drv_forced signals. Set_Conversion_Activity (Propagation.Table (I).Conv); when Prop_End => return; @@ -3148,8 +3284,10 @@ package body Grt.Signals is | Eff_One_Resolved => Sig := Propagation.Table (I).Sig; if Sig.Active then - Set_Effective_Value - (Sig, Sig.Driving_Value'Unrestricted_Access); + if not Sig.Flags.Is_Eff_Forced then + Set_Effective_Value + (Sig, Sig.Driving_Value'Unrestricted_Access); + end if; end if; when Eff_Multiple => declare @@ -3161,15 +3299,19 @@ package body Grt.Signals is for I in Resolv.Sig_Range.First .. Resolv.Sig_Range.Last loop Sig := Sig_Table.Table (I); - Set_Effective_Value - (Sig, Sig.Driving_Value'Unrestricted_Access); + if not Sig.Flags.Is_Eff_Forced then + Set_Effective_Value + (Sig, Sig.Driving_Value'Unrestricted_Access); + end if; end loop; end if; end; when Eff_Actual => Sig := Propagation.Table (I).Sig; if Sig.Active then - Set_Effective_Value (Sig, Sig.S.Effective.Value_Ptr); + if not Sig.Flags.Is_Eff_Forced then + Set_Effective_Value (Sig, Sig.S.Effective.Value_Ptr); + end if; end if; when Imp_Forward | Imp_Forward_Build => @@ -3179,10 +3321,15 @@ package body Grt.Signals is Sig := Propagation.Table (I).Sig; Set_Stable_Quiet_Activity (Imp_Guard, Sig); if Sig.Active then - Sig.Driving_Value.B1 := - Sig.S.Guard_Func.all (Sig.S.Guard_Instance); - Set_Effective_Value - (Sig, Sig.Driving_Value'Unrestricted_Access); + if not Sig.Flags.Is_Drv_Forced then + Sig.Driving_Value.B1 := + Sig.S.Guard_Func.all (Sig.S.Guard_Instance); + end if; + + if not Sig.Flags.Is_Eff_Forced then + Set_Effective_Value + (Sig, Sig.Driving_Value'Unrestricted_Access); + end if; end if; when Imp_Stable | Imp_Quiet => @@ -3196,8 +3343,10 @@ package body Grt.Signals is -- If an event has occurred on signal S, then S'Stable(T) is -- updated by assigning the value FALSE to the variable -- representing the current value of S'Table(T), ... - Sig.Driving_Value := - Value_Union'(Mode => Mode_B1, B1 => False); + if not Sig.Flags.Is_Drv_Forced then + Sig.Driving_Value := + Value_Union'(Mode => Mode_B1, B1 => False); + end if; -- LRM02 12.6.3 -- ... and the driver of S'Stable(T) is a assigned the -- waveform TRUE after T. @@ -3212,8 +3361,10 @@ package body Grt.Signals is Free (Sig.S.Attr_Trans.Next); end if; Sig.S.Attr_Trans.Next := Trans; - Set_Effective_Value - (Sig, Sig.Driving_Value'Unrestricted_Access); + if not Sig.Flags.Is_Eff_Forced then + Set_Effective_Value + (Sig, Sig.Driving_Value'Unrestricted_Access); + end if; if Sig.S.Time = 0 then -- Signal is active in the next cycle. If Time > 0, it -- has been put in Future_List during creation. @@ -3230,9 +3381,13 @@ package body Grt.Signals is Mark_Active (Sig); Free (Sig.S.Attr_Trans); Sig.S.Attr_Trans := Trans; - Sig.Driving_Value := Trans.Val; - Set_Effective_Value - (Sig, Sig.Driving_Value'Unrestricted_Access); + if not Sig.Flags.Is_Drv_Forced then + Sig.Driving_Value := Trans.Val; + end if; + if not Sig.Flags.Is_Eff_Forced then + Set_Effective_Value + (Sig, Sig.Driving_Value'Unrestricted_Access); + end if; end if; end if; when Imp_Transaction => @@ -3252,7 +3407,9 @@ package body Grt.Signals is for I in 0 .. Sig.Nbr_Ports - 1 loop if Sig.Ports (I).Active then Mark_Active (Sig); - Set_Effective_Value (Sig, Val'Unrestricted_access); + if not Sig.Flags.Is_Eff_Forced then + Set_Effective_Value (Sig, Val'Unrestricted_Access); + end if; exit; end if; end loop; @@ -3260,11 +3417,14 @@ package body Grt.Signals is when Imp_Delayed => Sig := Propagation.Table (I).Sig; if Sig.Active then - Set_Effective_Value - (Sig, Sig.Driving_Value'Unrestricted_Access); + if not Sig.Flags.Is_Eff_Forced then + Set_Effective_Value + (Sig, Sig.Driving_Value'Unrestricted_Access); + end if; end if; Delayed_Implicit_Process (Sig); when In_Conversion => + -- TODO: handle eff_forced signals. Set_Conversion_Activity (Propagation.Table (I).Conv); when Out_Conversion => null; @@ -3307,11 +3467,125 @@ package body Grt.Signals is -- end loop; end Reset_Active_Flag; + procedure Update_A_Signal (Sig : Ghdl_Signal_Ptr) + is + Trans : Transaction_Acc; + begin + -- 14.7.3.2 Driving values + -- a) If a driving-value release is scheduled for S or for a signal + -- of which S is a subelement, S becomes driving-value released, + -- that is, no longer driving-value forced. Proceed to step b). + -- b) If a driving force is scheduled for S or for a signal of which + -- S is a subelement, S becomes driving-value forced and the + -- driving value of S is the driving force value of S or the + -- element of the driving force value for the signal of which S + -- is a subelement, as appropriate; no further steps are + -- required. Otherwise, proceed to step c). + -- c) If S is driving-value foced, the driving value of S is unchanged + -- from its previous value; no further steps are required. + -- Otherwise, proceed to step d). + -- d) If a driving-value deposit is scheduled for S or for a signal of + -- which S is a subelement, the driving value of S is the driving + -- deposite value for S or the element of the driving deposit for + -- the signal of which S is a subelement, as appropriate; no further + -- steps are requited. Otherwise, proceed to step e) or f), as + -- appropriate; + -- GHDL: not yet implemented. + null; + + case Sig.Net is + when Net_One_Driver => + -- This signal is active. + Mark_Active (Sig); + + -- Update driver + Trans := Sig.S.Drivers (0).First_Trans.Next; + if Trans /= null then + Free (Sig.S.Drivers (0).First_Trans); + Sig.S.Drivers (0).First_Trans := Trans; + end if; + + -- Update driving value (unless forced) + if not Sig.Flags.Is_Drv_Forced then + case Trans.Kind is + when Trans_Value => + Sig.Driving_Value := Trans.Val; + when Trans_Direct => + Internal_Error ("update_signals: trans_direct"); + when Trans_Null => + Error ("null transaction"); + when Trans_Error => + Error_Trans_Error (Trans); + end case; + end if; + + if not Sig.Flags.Is_Eff_Forced then + Set_Effective_Value + (Sig, Sig.Driving_Value'Unrestricted_Access); + end if; + + when Net_One_Direct => + Mark_Active (Sig); + Sig.Flags.Is_Direct_Active := False; + + Trans := Sig.S.Drivers (0).Last_Trans; + Assign (Sig.S.Drivers (0).First_Trans.Val, + Trans.Val_Ptr, Sig.Mode); + if not Sig.Flags.Is_Drv_Forced then + Sig.Driving_Value := Sig.S.Drivers (0).First_Trans.Val; + end if; + if not Sig.Flags.Is_Eff_Forced then + Set_Effective_Value + (Sig, Sig.Driving_Value'Unrestricted_Access); + end if; + + when Net_One_Resolved => + -- This signal is active. + Mark_Active (Sig); + Sig.Flags.Is_Direct_Active := False; + + for J in 1 .. Sig.S.Nbr_Drivers loop + Trans := Sig.S.Drivers (J - 1).First_Trans.Next; + if Trans /= null then + if Trans.Kind = Trans_Direct then + Assign (Sig.S.Drivers (J - 1).First_Trans.Val, + Trans.Val_Ptr, Sig.Mode); + elsif Trans.Time = Current_Time then + Free (Sig.S.Drivers (J - 1).First_Trans); + Sig.S.Drivers (J - 1).First_Trans := Trans; + end if; + end if; + end loop; + if not Sig.Flags.Is_Drv_Forced then + Compute_Resolved_Signal (Sig.S.Resolv); + end if; + if not Sig.Flags.Is_Eff_Forced then + Set_Effective_Value + (Sig, Sig.Driving_Value'Unrestricted_Access); + end if; + + when No_Signal_Net => + -- Can happen with force/release. + -- This signal is active. + Mark_Active (Sig); + + -- Driving value is not modified (there is not driver). + + if not Sig.Flags.Is_Eff_Forced then + Set_Effective_Value + (Sig, Sig.Driving_Value'Unrestricted_Access); + end if; + + when Signal_Net_Defined => + Sig.Flags.Is_Direct_Active := False; + Run_Propagation (Sig); + end case; + end Update_A_Signal; + procedure Update_Signals is Sig : Ghdl_Signal_Ptr; Next_Sig : Ghdl_Signal_Ptr; - Trans : Transaction_Acc; begin -- LRM93 12.6.2 -- 1) Reset active flag: all signals active in the previous cycle are @@ -3319,6 +3593,10 @@ package body Grt.Signals is Reset_Active_Flag; -- Forced signals. + -- LRM08 14.7.3 Propagation of signal values + -- A signal is said to be active during a given simulation cycle if + -- ... + -- - A force, a deposite, or a release is scheduled for the signal. if Force_Value_First /= null then declare Fv : Force_Value_Acc; @@ -3327,25 +3605,53 @@ package body Grt.Signals is Fv := Force_Value_First; while Fv /= null loop Sig := Fv.Sig; - -- FIXME: Implement the full semantic of force: really force, - -- only set driving/effective value, release... - Mark_Active (Sig); + case Fv.Kind is - when Force_Driving => - Sig.Driving_Value := Fv.Val; - when Force_Effective => - null; + when Force => + -- TODO: warn if forced many times in the same cycle ? + case Fv.Mode is + when Force_Driving => + Sig.Flags.Is_Drv_Forced := True; + Sig.Flags.Is_Drv_Force_Scheduled := True; + Sig.Driving_Value := Fv.Val; + when Force_Effective => + Sig.Flags.Is_Eff_Forced := True; + Sig.Flags.Is_Eff_Force_Scheduled := True; + Set_Effective_Value (Sig, Fv.Val'Access); + end case; + when Release => + case Fv.Mode is + when Force_Driving => + if not Sig.Flags.Is_Drv_Force_Scheduled then + Sig.Flags.Is_Drv_Forced := False; + end if; + when Force_Effective => + if not Sig.Flags.Is_Eff_Force_Scheduled then + Sig.Flags.Is_Eff_Forced := False; + end if; + end case; end case; - Set_Effective_Value (Sig, Fv.Val'Access); + -- If alredy in the active chain, it means that a driver is + -- also active. Do not do anything particular. if Sig.Net in Signal_Net_Defined then -- Mark SIG as active so that propagation will execute -- just below. - -- This is a little HACK as the code just below handles all - -- the cases, but we are only interesting in the case for - -- defined net (with propagation). - Insert_Active_Chain (Sig); + Mark_Active (Sig); end if; + Insert_Active_Chain (Sig); + + Fv := Fv.Next; + end loop; + + -- Free force/release. This is done after to clear the + -- schedule flags. + -- Not highly efficient, but there shouldn't be a lot of force / + -- release, and it allows to detect force+release 'conflicts'. + Fv := Force_Value_First; + while Fv /= null loop + Fv.Sig.Flags.Is_Drv_Force_Scheduled := False; + Fv.Sig.Flags.Is_Eff_Force_Scheduled := False; Next_Fv := Fv.Next; Free (Fv); @@ -3369,65 +3675,7 @@ package body Grt.Signals is Signal_Active_Chain := Next_Sig; Sig.Link := null; - case Sig.Net is - when Net_One_Driver => - -- This signal is active. - Mark_Active (Sig); - - Trans := Sig.S.Drivers (0).First_Trans.Next; - Free (Sig.S.Drivers (0).First_Trans); - Sig.S.Drivers (0).First_Trans := Trans; - case Trans.Kind is - when Trans_Value => - Sig.Driving_Value := Trans.Val; - when Trans_Direct => - Internal_Error ("update_signals: trans_direct"); - when Trans_Null => - Error ("null transaction"); - when Trans_Error => - Error_Trans_Error (Trans); - end case; - Set_Effective_Value - (Sig, Sig.Driving_Value'Unrestricted_Access); - - when Net_One_Direct => - Mark_Active (Sig); - Sig.Flags.Is_Direct_Active := False; - - Trans := Sig.S.Drivers (0).Last_Trans; - Assign (Sig.Driving_Value, Trans.Val_Ptr, Sig.Mode); - Sig.S.Drivers (0).First_Trans.Val := Sig.Driving_Value; - Set_Effective_Value - (Sig, Sig.Driving_Value'Unrestricted_Access); - - when Net_One_Resolved => - -- This signal is active. - Mark_Active (Sig); - Sig.Flags.Is_Direct_Active := False; - - for J in 1 .. Sig.S.Nbr_Drivers loop - Trans := Sig.S.Drivers (J - 1).First_Trans.Next; - if Trans /= null then - if Trans.Kind = Trans_Direct then - Assign (Sig.S.Drivers (J - 1).First_Trans.Val, - Trans.Val_Ptr, Sig.Mode); - elsif Trans.Time = Current_Time then - Free (Sig.S.Drivers (J - 1).First_Trans); - Sig.S.Drivers (J - 1).First_Trans := Trans; - end if; - end if; - end loop; - Compute_Resolved_Signal (Sig.S.Resolv); - Set_Effective_Value - (Sig, Sig.Driving_Value'Unrestricted_Access); - - when No_Signal_Net => - Internal_Error ("update_signals: no_signal_net"); - - when Signal_Net_Defined => - Sig.Flags.Is_Direct_Active := False; - Run_Propagation (Sig); - end case; + Update_A_Signal (Sig); Sig := Next_Sig; end loop; diff --git a/src/grt/grt-signals.ads b/src/grt/grt-signals.ads index b33c34b98..6f283ccaa 100644 --- a/src/grt/grt-signals.ads +++ b/src/grt/grt-signals.ads @@ -286,6 +286,18 @@ package Grt.Signals is -- Only reset by GHW file dumper. RO_Event : Boolean; + -- True if the signal is being forced. + -- Set by force, cleared by release unless Is_Force_Scheduled is set. + Is_Drv_Forced : Boolean; + Is_Eff_Forced : Boolean; + + -- True if a force is being scheduled for the current cycle. + -- This flag is set when a force is applied and cleared when all force + -- are applied. The purpose of it is to discard release for the same + -- cycle as force have the priority over release. + Is_Drv_Force_Scheduled : Boolean; + Is_Eff_Force_Scheduled : Boolean; + -- Set only on an implicit signal when the signal will stay active on -- the next cycle. For example, 'Quiet(0ns) or 'Stable(0ns) are -- generally active for 2 cycles, as they are first False and then True. @@ -569,6 +581,9 @@ package Grt.Signals is procedure Ghdl_Signal_Disconnect (Sign : Ghdl_Signal_Ptr); + procedure Ghdl_Signal_Release_Eff (Sig : Ghdl_Signal_Ptr); + procedure Ghdl_Signal_Release_Drv (Sig : Ghdl_Signal_Ptr); + procedure Ghdl_Signal_Start_Assign_Null (Sign : Ghdl_Signal_Ptr; Rej : Std_Time; After : Std_Time); @@ -642,6 +657,10 @@ package Grt.Signals is Val : Ghdl_E32); function Ghdl_Signal_Driving_Value_E32 (Sig : Ghdl_Signal_Ptr) return Ghdl_E32; + procedure Ghdl_Signal_Force_Driving_E32 (Sig : Ghdl_Signal_Ptr; + Val : Ghdl_E32); + procedure Ghdl_Signal_Force_Effective_E32 (Sig : Ghdl_Signal_Ptr; + Val : Ghdl_E32); function Ghdl_Create_Signal_I32 (Val_Ptr : Ghdl_Value_Ptr; Resolv_Func : Resolver_Acc; @@ -662,6 +681,10 @@ package Grt.Signals is Val : Ghdl_I32); function Ghdl_Signal_Driving_Value_I32 (Sig : Ghdl_Signal_Ptr) return Ghdl_I32; + procedure Ghdl_Signal_Force_Driving_I32 (Sig : Ghdl_Signal_Ptr; + Val : Ghdl_I32); + procedure Ghdl_Signal_Force_Effective_I32 (Sig : Ghdl_Signal_Ptr; + Val : Ghdl_I32); function Ghdl_Create_Signal_I64 (Val_Ptr : Ghdl_Value_Ptr; Resolv_Func : Resolver_Acc; @@ -682,6 +705,10 @@ package Grt.Signals is Val : Ghdl_I64); function Ghdl_Signal_Driving_Value_I64 (Sig : Ghdl_Signal_Ptr) return Ghdl_I64; + procedure Ghdl_Signal_Force_Driving_I64 (Sig : Ghdl_Signal_Ptr; + Val : Ghdl_I64); + procedure Ghdl_Signal_Force_Effective_I64 (Sig : Ghdl_Signal_Ptr; + Val : Ghdl_I64); function Ghdl_Create_Signal_F64 (Val_Ptr : Ghdl_Value_Ptr; Resolv_Func : Resolver_Acc; @@ -702,6 +729,10 @@ package Grt.Signals is Val : Ghdl_F64); function Ghdl_Signal_Driving_Value_F64 (Sig : Ghdl_Signal_Ptr) return Ghdl_F64; + procedure Ghdl_Signal_Force_Driving_F64 (Sig : Ghdl_Signal_Ptr; + Val : Ghdl_F64); + procedure Ghdl_Signal_Force_Effective_F64 (Sig : Ghdl_Signal_Ptr; + Val : Ghdl_F64); -- Add a driver to SIGN for the current process. procedure Ghdl_Process_Add_Driver (Sign : Ghdl_Signal_Ptr); @@ -832,6 +863,11 @@ private pragma Export (Ada, Ghdl_Signal_Driving, "__ghdl_signal_driving"); + pragma Export (C, Ghdl_Signal_Release_Eff, + "__ghdl_signal_release_eff"); + pragma Export (C, Ghdl_Signal_Release_Drv, + "__ghdl_signal_release_drv"); + pragma Export (Ada, Ghdl_Create_Signal_B1, "__ghdl_create_signal_b1"); pragma Export (Ada, Ghdl_Signal_Init_B1, @@ -848,6 +884,10 @@ private "__ghdl_signal_add_port_driver_b1"); pragma Export (Ada, Ghdl_Signal_Driving_Value_B1, "__ghdl_signal_driving_value_b1"); + pragma Export (Ada, Ghdl_Signal_Force_Driving_B1, + "__ghdl_signal_force_drv_b1"); + pragma Export (Ada, Ghdl_Signal_Force_Effective_B1, + "__ghdl_signal_force_eff_b1"); pragma Export (C, Ghdl_Create_Signal_E8, "__ghdl_create_signal_e8"); @@ -865,6 +905,10 @@ private "__ghdl_signal_add_port_driver_e8"); pragma Export (C, Ghdl_Signal_Driving_Value_E8, "__ghdl_signal_driving_value_e8"); + pragma Export (C, Ghdl_Signal_Force_Driving_E8, + "__ghdl_signal_force_drv_e8"); + pragma Export (C, Ghdl_Signal_Force_Effective_E8, + "__ghdl_signal_force_eff_e8"); pragma Export (C, Ghdl_Create_Signal_E32, "__ghdl_create_signal_e32"); @@ -882,6 +926,10 @@ private "__ghdl_signal_add_port_driver_e32"); pragma Export (C, Ghdl_Signal_Driving_Value_E32, "__ghdl_signal_driving_value_e32"); + pragma Export (C, Ghdl_Signal_Force_Driving_E32, + "__ghdl_signal_force_drv_e32"); + pragma Export (C, Ghdl_Signal_Force_Effective_E32, + "__ghdl_signal_force_eff_e32"); pragma Export (C, Ghdl_Create_Signal_I32, "__ghdl_create_signal_i32"); @@ -899,6 +947,10 @@ private "__ghdl_signal_add_port_driver_i32"); pragma Export (C, Ghdl_Signal_Driving_Value_I32, "__ghdl_signal_driving_value_i32"); + pragma Export (C, Ghdl_Signal_Force_Driving_I32, + "__ghdl_signal_force_drv_i32"); + pragma Export (C, Ghdl_Signal_Force_Effective_I32, + "__ghdl_signal_force_eff_i32"); pragma Export (C, Ghdl_Create_Signal_I64, "__ghdl_create_signal_i64"); @@ -916,6 +968,10 @@ private "__ghdl_signal_add_port_driver_i64"); pragma Export (C, Ghdl_Signal_Driving_Value_I64, "__ghdl_signal_driving_value_i64"); + pragma Export (C, Ghdl_Signal_Force_Driving_I64, + "__ghdl_signal_force_drv_i64"); + pragma Export (C, Ghdl_Signal_Force_Effective_I64, + "__ghdl_signal_force_eff_i64"); pragma Export (C, Ghdl_Create_Signal_F64, "__ghdl_create_signal_f64"); @@ -933,6 +989,10 @@ private "__ghdl_signal_add_port_driver_f64"); pragma Export (C, Ghdl_Signal_Driving_Value_F64, "__ghdl_signal_driving_value_f64"); + pragma Export (C, Ghdl_Signal_Force_Driving_F64, + "__ghdl_signal_force_drv_f64"); + pragma Export (C, Ghdl_Signal_Force_Effective_F64, + "__ghdl_signal_force_eff_f64"); pragma Export (C, Ghdl_Process_Add_Driver, "__ghdl_process_add_driver"); diff --git a/src/grt/grt-vpi.adb b/src/grt/grt-vpi.adb index 8c0d15e3a..df2788631 100644 --- a/src/grt/grt-vpi.adb +++ b/src/grt/grt-vpi.adb @@ -1014,7 +1014,10 @@ package body Grt.Vpi is Ghdl_B1 (Vec (J) = '1' or Vec (J) = 'H'); begin case Info.Val is - when Vcd_Effective | Vcd_Driving => + when Vcd_Effective => + Ghdl_Signal_Force_Effective_B1 + (To_Signal_Arr_Ptr (Info.Ptr)(J), V); + when Vcd_Driving => -- Force_Driving sets both the driving and the -- effective value. Ghdl_Signal_Force_Driving_B1 @@ -1031,9 +1034,10 @@ package body Grt.Vpi is V : constant Ghdl_E8 := Std_Ulogic'Pos (Vec (J)); begin case Info.Val is - when Vcd_Effective | Vcd_Driving => - -- Force_Driving sets both the driving and the - -- effective value. + when Vcd_Effective => + Ghdl_Signal_Force_Effective_E8 + (To_Signal_Arr_Ptr (Info.Ptr)(J), V); + when Vcd_Driving => Ghdl_Signal_Force_Driving_E8 (To_Signal_Arr_Ptr (Info.Ptr)(J), V); when Vcd_Variable => @@ -1053,9 +1057,10 @@ package body Grt.Vpi is end if; end loop; case Info.Val is - when Vcd_Effective | Vcd_Driving => - -- Force_Driving sets both the driving and the - -- effective value. + when Vcd_Effective => + Ghdl_Signal_Force_Effective_E8 + (To_Signal_Arr_Ptr (Info.Ptr)(0), V); + when Vcd_Driving => Ghdl_Signal_Force_Driving_E8 (To_Signal_Arr_Ptr (Info.Ptr)(0), V); when Vcd_Variable => diff --git a/src/vhdl/translate/trans-chap8.adb b/src/vhdl/translate/trans-chap8.adb index 1e7bb1956..465fa3af5 100644 --- a/src/vhdl/translate/trans-chap8.adb +++ b/src/vhdl/translate/trans-chap8.adb @@ -4843,8 +4843,131 @@ package body Trans.Chap8 is Close_Temp; end Translate_Selected_Waveform_Assignment_Statement; - procedure Translate_Statement (Stmt : Iir) + procedure Translate_Signal_Release_Assignment_Statement (Stmt : Iir) is + Target : constant Iir := Get_Target (Stmt); + Targ : Mnode; + Proc : O_Dnode; + begin + Targ := Chap6.Translate_Name (Target, Mode_Signal); + case Get_Force_Mode (Stmt) is + when Iir_Force_In => + Proc := Ghdl_Signal_Release_Eff; + when Iir_Force_Out => + Proc := Ghdl_Signal_Release_Drv; + end case; + Register_Signal (Targ, Get_Type (Target), Proc); + end Translate_Signal_Release_Assignment_Statement; + + Signal_Force_Stmt : Iir; + procedure Gen_Signal_Force_Non_Composite (Targ : Mnode; + Targ_Type : Iir; + Val : O_Enode) + is + Type_Info : constant Type_Info_Acc := Get_Info (Targ_Type); + Subprg : O_Dnode; + Conv : O_Tnode; + Assoc : O_Assoc_List; + Val2 : O_Enode; + begin + case Type_Mode_Scalar (Type_Info.Type_Mode) is + when Type_Mode_B1 => + case Get_Force_Mode (Signal_Force_Stmt) is + when Iir_Force_In => + Subprg := Ghdl_Signal_Force_Eff_B1; + when Iir_Force_Out => + Subprg := Ghdl_Signal_Force_Drv_B1; + end case; + Conv := Ghdl_Bool_Type; + when Type_Mode_E8 => + case Get_Force_Mode (Signal_Force_Stmt) is + when Iir_Force_In => + Subprg := Ghdl_Signal_Force_Eff_E8; + when Iir_Force_Out => + Subprg := Ghdl_Signal_Force_Drv_E8; + end case; + Conv := Ghdl_I32_Type; + when Type_Mode_E32 => + case Get_Force_Mode (Signal_Force_Stmt) is + when Iir_Force_In => + Subprg := Ghdl_Signal_Force_Eff_E32; + when Iir_Force_Out => + Subprg := Ghdl_Signal_Force_Drv_E32; + end case; + Conv := Ghdl_I32_Type; + when Type_Mode_I32 + | Type_Mode_P32 => + case Get_Force_Mode (Signal_Force_Stmt) is + when Iir_Force_In => + Subprg := Ghdl_Signal_Force_Eff_I32; + when Iir_Force_Out => + Subprg := Ghdl_Signal_Force_Drv_I32; + end case; + Conv := Ghdl_I32_Type; + when Type_Mode_P64 + | Type_Mode_I64 => + case Get_Force_Mode (Signal_Force_Stmt) is + when Iir_Force_In => + Subprg := Ghdl_Signal_Force_Eff_I64; + when Iir_Force_Out => + Subprg := Ghdl_Signal_Force_Drv_I64; + end case; + Conv := Ghdl_I64_Type; + when Type_Mode_F64 => + case Get_Force_Mode (Signal_Force_Stmt) is + when Iir_Force_In => + Subprg := Ghdl_Signal_Force_Eff_F64; + when Iir_Force_Out => + Subprg := Ghdl_Signal_Force_Drv_F64; + end case; + Conv := Ghdl_Real_Type; + end case; + Val2 := Chap3.Insert_Scalar_Check + (Val, Null_Iir, Targ_Type, Signal_Force_Stmt); + Start_Association (Assoc, Subprg); + New_Association (Assoc, New_Convert_Ov (New_Value (M2Lv (Targ)), + Ghdl_Signal_Ptr)); + New_Association (Assoc, New_Convert_Ov (Val2, Conv)); + New_Procedure_Call (Assoc); + end Gen_Signal_Force_Non_Composite; + + procedure Gen_Signal_Force is new Foreach_Non_Composite + (Data_Type => O_Enode, + Composite_Data_Type => Mnode, + Do_Non_Composite => Gen_Signal_Force_Non_Composite, + Prepare_Data_Array => Gen_Oenode_Prepare_Data_Composite, + Update_Data_Array => Gen_Oenode_Update_Data_Array, + Finish_Data_Array => Gen_Oenode_Finish_Data_Composite, + Prepare_Data_Record => Gen_Oenode_Prepare_Data_Composite, + Update_Data_Record => Gen_Oenode_Update_Data_Record, + Finish_Data_Record => Gen_Oenode_Finish_Data_Composite); + + procedure Translate_Signal_Force_Assignment_Statement (Stmt : Iir) + is + Target : constant Iir := Get_Target (Stmt); + Target_Type : constant Iir := Get_Type (Target); + Targ_Tinfo : constant Type_Info_Acc := Get_Info (Target_Type); + Expr : constant Iir := Get_Expression (Stmt); + Value : Mnode; + Targ : Mnode; + begin + Targ := Chap6.Translate_Name (Target, Mode_Signal); + Value := Chap7.Translate_Expression (Expr, Target_Type); + + if Is_Composite (Targ_Tinfo) + and then Get_Constraint_State (Target_Type) /= Fully_Constrained + then + Stabilize (Targ); + Stabilize (Value); + Chap3.Check_Composite_Match + (Target_Type, Targ, Get_Type (Expr), Value, Stmt); + end if; + + Signal_Force_Stmt := Stmt; + Gen_Signal_Force (Targ, Target_Type, M2E (Value)); + end Translate_Signal_Force_Assignment_Statement; + + procedure Translate_Statement (Stmt : Iir) is begin New_Debug_Line_Stmt (Get_Line_Number (Stmt)); Open_Temp; @@ -4895,6 +5018,10 @@ package body Trans.Chap8 is Trans.Update_Node_Infos; Translate_If_Statement (C_Stmt); end; + when Iir_Kind_Signal_Release_Assignment_Statement => + Translate_Signal_Release_Assignment_Statement (Stmt); + when Iir_Kind_Signal_Force_Assignment_Statement => + Translate_Signal_Force_Assignment_Statement (Stmt); when Iir_Kind_Null_Statement => -- A null statement is translated to a NOP, so that the diff --git a/src/vhdl/translate/trans_decls.ads b/src/vhdl/translate/trans_decls.ads index 2f52b6035..0f0f3dd72 100644 --- a/src/vhdl/translate/trans_decls.ads +++ b/src/vhdl/translate/trans_decls.ads @@ -80,6 +80,9 @@ package Trans_Decls is Ghdl_Signal_Start_Assign_Null : O_Dnode; Ghdl_Signal_Next_Assign_Null : O_Dnode; + Ghdl_Signal_Release_Eff : O_Dnode; + Ghdl_Signal_Release_Drv : O_Dnode; + Ghdl_Create_Signal_B1 : O_Dnode; Ghdl_Signal_Simple_Assign_B1 : O_Dnode; Ghdl_Signal_Start_Assign_B1 : O_Dnode; @@ -88,6 +91,8 @@ package Trans_Decls is Ghdl_Signal_Add_Port_Driver_B1 : O_Dnode; Ghdl_Signal_Init_B1 : O_Dnode; Ghdl_Signal_Driving_Value_B1 : O_Dnode; + Ghdl_Signal_Force_Eff_B1 : O_Dnode; + Ghdl_Signal_Force_Drv_B1 : O_Dnode; Ghdl_Create_Signal_E8 : O_Dnode; Ghdl_Signal_Simple_Assign_E8 : O_Dnode; @@ -97,6 +102,8 @@ package Trans_Decls is Ghdl_Signal_Add_Port_Driver_E8 : O_Dnode; Ghdl_Signal_Init_E8 : O_Dnode; Ghdl_Signal_Driving_Value_E8 : O_Dnode; + Ghdl_Signal_Force_Eff_E8 : O_Dnode; + Ghdl_Signal_Force_Drv_E8 : O_Dnode; Ghdl_Create_Signal_E32 : O_Dnode; Ghdl_Signal_Simple_Assign_E32 : O_Dnode; @@ -106,6 +113,8 @@ package Trans_Decls is Ghdl_Signal_Add_Port_Driver_E32 : O_Dnode; Ghdl_Signal_Init_E32 : O_Dnode; Ghdl_Signal_Driving_Value_E32 : O_Dnode; + Ghdl_Signal_Force_Eff_E32 : O_Dnode; + Ghdl_Signal_Force_Drv_E32 : O_Dnode; Ghdl_Create_Signal_I32 : O_Dnode; Ghdl_Signal_Simple_Assign_I32 : O_Dnode; @@ -115,6 +124,8 @@ package Trans_Decls is Ghdl_Signal_Add_Port_Driver_I32 : O_Dnode; Ghdl_Signal_Init_I32 : O_Dnode; Ghdl_Signal_Driving_Value_I32 : O_Dnode; + Ghdl_Signal_Force_Eff_I32 : O_Dnode; + Ghdl_Signal_Force_Drv_I32 : O_Dnode; Ghdl_Create_Signal_F64 : O_Dnode; Ghdl_Signal_Simple_Assign_F64 : O_Dnode; @@ -124,6 +135,8 @@ package Trans_Decls is Ghdl_Signal_Add_Port_Driver_F64 : O_Dnode; Ghdl_Signal_Init_F64 : O_Dnode; Ghdl_Signal_Driving_Value_F64 : O_Dnode; + Ghdl_Signal_Force_Eff_F64 : O_Dnode; + Ghdl_Signal_Force_Drv_F64 : O_Dnode; Ghdl_Create_Signal_I64 : O_Dnode; Ghdl_Signal_Simple_Assign_I64 : O_Dnode; @@ -133,6 +146,8 @@ package Trans_Decls is Ghdl_Signal_Add_Port_Driver_I64 : O_Dnode; Ghdl_Signal_Init_I64 : O_Dnode; Ghdl_Signal_Driving_Value_I64 : O_Dnode; + Ghdl_Signal_Force_Eff_I64 : O_Dnode; + Ghdl_Signal_Force_Drv_I64 : O_Dnode; Ghdl_Signal_In_Conversion : O_Dnode; Ghdl_Signal_Out_Conversion : O_Dnode; diff --git a/src/vhdl/translate/translation.adb b/src/vhdl/translate/translation.adb index b510a7ae5..165f57d43 100644 --- a/src/vhdl/translate/translation.adb +++ b/src/vhdl/translate/translation.adb @@ -809,17 +809,18 @@ package body Translation is Finish_Subprogram_Decl (Interfaces, Ghdl_Finalize_Register); end Initialize; - procedure Create_Signal_Subprograms - (Suffix : String; - Val_Type : O_Tnode; - Create_Signal : out O_Dnode; - Init_Signal : out O_Dnode; - Simple_Assign : out O_Dnode; - Start_Assign : out O_Dnode; - Next_Assign : out O_Dnode; - Associate_Value : out O_Dnode; - Add_Port_Driver : out O_Dnode; - Driving_Value : out O_Dnode) + procedure Create_Signal_Subprograms (Suffix : String; + Val_Type : O_Tnode; + Create_Signal : out O_Dnode; + Init_Signal : out O_Dnode; + Simple_Assign : out O_Dnode; + Start_Assign : out O_Dnode; + Next_Assign : out O_Dnode; + Associate_Value : out O_Dnode; + Add_Port_Driver : out O_Dnode; + Driving_Value : out O_Dnode; + Force_Drv : out O_Dnode; + Force_Eff : out O_Dnode) is Interfaces : O_Inter_List; Param : O_Dnode; @@ -910,6 +911,24 @@ package body Translation is O_Storage_External, Val_Type); New_Interface_Decl (Interfaces, Param, Wki_Sig, Ghdl_Signal_Ptr); Finish_Subprogram_Decl (Interfaces, Driving_Value); + + -- procedure __ghdl_signal_force_drv_XXX (sign : __ghdl_signal_ptr; + -- val : VAL_TYPE); + Start_Procedure_Decl + (Interfaces, Get_Identifier ("__ghdl_signal_force_drv_" & Suffix), + O_Storage_External); + New_Interface_Decl (Interfaces, Param, Wki_Sig, Ghdl_Signal_Ptr); + New_Interface_Decl (Interfaces, Param, Wki_Val, Val_Type); + Finish_Subprogram_Decl (Interfaces, Force_Drv); + + -- procedure __ghdl_signal_force_eff_XXX (sign : __ghdl_signal_ptr; + -- val : VAL_TYPE); + Start_Procedure_Decl + (Interfaces, Get_Identifier ("__ghdl_signal_force_eff_" & Suffix), + O_Storage_External); + New_Interface_Decl (Interfaces, Param, Wki_Sig, Ghdl_Signal_Ptr); + New_Interface_Decl (Interfaces, Param, Wki_Val, Val_Type); + Finish_Subprogram_Decl (Interfaces, Force_Eff); end Create_Signal_Subprograms; -- procedure __ghdl_image_NAME (res : std_string_ptr_node; @@ -1574,7 +1593,9 @@ package body Translation is Ghdl_Signal_Next_Assign_E8, Ghdl_Signal_Associate_E8, Ghdl_Signal_Add_Port_Driver_E8, - Ghdl_Signal_Driving_Value_E8); + Ghdl_Signal_Driving_Value_E8, + Ghdl_Signal_Force_Drv_E8, + Ghdl_Signal_Force_Eff_E8); -- function __ghdl_create_signal_e32 (init_val : ghdl_i32_type) -- return __ghdl_signal_ptr; @@ -1588,7 +1609,9 @@ package body Translation is Ghdl_Signal_Next_Assign_E32, Ghdl_Signal_Associate_E32, Ghdl_Signal_Add_Port_Driver_E32, - Ghdl_Signal_Driving_Value_E32); + Ghdl_Signal_Driving_Value_E32, + Ghdl_Signal_Force_Drv_E32, + Ghdl_Signal_Force_Eff_E32); -- function __ghdl_create_signal_b1 (init_val : ghdl_bool_type) -- return __ghdl_signal_ptr; @@ -1602,7 +1625,9 @@ package body Translation is Ghdl_Signal_Next_Assign_B1, Ghdl_Signal_Associate_B1, Ghdl_Signal_Add_Port_Driver_B1, - Ghdl_Signal_Driving_Value_B1); + Ghdl_Signal_Driving_Value_B1, + Ghdl_Signal_Force_Drv_B1, + Ghdl_Signal_Force_Eff_B1); Create_Signal_Subprograms ("i32", Ghdl_I32_Type, Ghdl_Create_Signal_I32, @@ -1612,7 +1637,9 @@ package body Translation is Ghdl_Signal_Next_Assign_I32, Ghdl_Signal_Associate_I32, Ghdl_Signal_Add_Port_Driver_I32, - Ghdl_Signal_Driving_Value_I32); + Ghdl_Signal_Driving_Value_I32, + Ghdl_Signal_Force_Drv_I32, + Ghdl_Signal_Force_Eff_I32); Create_Signal_Subprograms ("f64", Ghdl_Real_Type, Ghdl_Create_Signal_F64, @@ -1622,7 +1649,9 @@ package body Translation is Ghdl_Signal_Next_Assign_F64, Ghdl_Signal_Associate_F64, Ghdl_Signal_Add_Port_Driver_F64, - Ghdl_Signal_Driving_Value_F64); + Ghdl_Signal_Driving_Value_F64, + Ghdl_Signal_Force_Drv_F64, + Ghdl_Signal_Force_Eff_F64); Create_Signal_Subprograms ("i64", Ghdl_I64_Type, Ghdl_Create_Signal_I64, @@ -1632,7 +1661,23 @@ package body Translation is Ghdl_Signal_Next_Assign_I64, Ghdl_Signal_Associate_I64, Ghdl_Signal_Add_Port_Driver_I64, - Ghdl_Signal_Driving_Value_I64); + Ghdl_Signal_Driving_Value_I64, + Ghdl_Signal_Force_Drv_I64, + Ghdl_Signal_Force_Eff_I64); + + -- procedure __ghdl_signal_release_drv (sig : __ghdl_signal_ptr); + Start_Procedure_Decl + (Interfaces, Get_Identifier ("__ghdl_signal_release_drv"), + O_Storage_External); + New_Interface_Decl (Interfaces, Param, Wki_Sig, Ghdl_Signal_Ptr); + Finish_Subprogram_Decl (Interfaces, Ghdl_Signal_Release_Drv); + + -- procedure __ghdl_signal_release_eff (sig : __ghdl_signal_ptr); + Start_Procedure_Decl + (Interfaces, Get_Identifier ("__ghdl_signal_release_eff"), + O_Storage_External); + New_Interface_Decl (Interfaces, Param, Wki_Sig, Ghdl_Signal_Ptr); + Finish_Subprogram_Decl (Interfaces, Ghdl_Signal_Release_Eff); -- procedure __ghdl_process_add_sensitivity (sig : __ghdl_signal_ptr); Start_Procedure_Decl -- cgit v1.2.3