vhdl: handle force/release statements in translate and grt. For #1416

8 files changed, 688 insertions, 161 deletions

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