From 2f48848575261265b1c37efe10ded83ccff11aa2 Mon Sep 17 00:00:00 2001
From: Tristan Gingold <tgingold@free.fr>
Date: Tue, 3 Jan 2023 21:18:38 +0100
Subject: simul: handle force/release signal assignments

---
 src/grt/grt-signals.adb | 46 +++++++++++++++++++++++++++++++++-------------
 src/grt/grt-signals.ads |  5 +++++
 2 files changed, 38 insertions(+), 13 deletions(-)

(limited to 'src/grt')

diff --git a/src/grt/grt-signals.adb b/src/grt/grt-signals.adb
index b81a86fd3..7ddb24891 100644
--- a/src/grt/grt-signals.adb
+++ b/src/grt/grt-signals.adb
@@ -2070,6 +2070,26 @@ package body Grt.Signals is
                                                    F64 => Val)));
    end Ghdl_Signal_Force_Effective_F64;
 
+   procedure Ghdl_Signal_Force_Driving_Any (Sig : Ghdl_Signal_Ptr;
+                                            Val : Value_Union) is
+   begin
+      Append_Force_Value (new Force_Value'(Kind => Force,
+                                           Mode => Force_Driving,
+                                           Next => null,
+                                           Sig => Sig,
+                                           Val => Val));
+   end Ghdl_Signal_Force_Driving_Any;
+
+   procedure Ghdl_Signal_Force_Effective_Any (Sig : Ghdl_Signal_Ptr;
+                                              Val : Value_Union) is
+   begin
+      Append_Force_Value (new Force_Value'(Kind => Force,
+                                           Mode => Force_Effective,
+                                           Next => null,
+                                           Sig => Sig,
+                                           Val => Val));
+   end Ghdl_Signal_Force_Effective_Any;
+
    --  Remove all (but Signal_End) signals in the next active chain.
    --  Called when a transaction/event will occur before the time for this
    --  chain.
@@ -3565,20 +3585,20 @@ package body Grt.Signals is
             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;
+               --  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;
             end if;
 
             if not Sig.Flags.Is_Eff_Forced then
diff --git a/src/grt/grt-signals.ads b/src/grt/grt-signals.ads
index 76977d37a..6014180be 100644
--- a/src/grt/grt-signals.ads
+++ b/src/grt/grt-signals.ads
@@ -614,6 +614,11 @@ package Grt.Signals is
    procedure Ghdl_Process_Add_Port_Driver
      (Sign : Ghdl_Signal_Ptr; Val : Value_Union);
 
+   procedure Ghdl_Signal_Force_Driving_Any (Sig : Ghdl_Signal_Ptr;
+                                            Val : Value_Union);
+   procedure Ghdl_Signal_Force_Effective_Any (Sig : Ghdl_Signal_Ptr;
+                                              Val : Value_Union);
+
    --  For B1
    function Ghdl_Create_Signal_B1 (Val_Ptr : Ghdl_Value_Ptr;
                                    Resolv_Func : Resolver_Acc;
-- 
cgit v1.2.3