diff options
Diffstat (limited to 'src/grt')
-rw-r--r-- | src/grt/grt-disp_signals.adb | 38 | ||||
-rw-r--r-- | src/grt/grt-signals.adb | 480 | ||||
-rw-r--r-- | src/grt/grt-signals.ads | 60 | ||||
-rw-r--r-- | src/grt/grt-vpi.adb | 19 |
4 files changed, 454 insertions, 143 deletions
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 => |