simul: handle after clauses in signal assignment

3 files changed, 111 insertions, 70 deletions

diff --git a/src/grt/grt-signals.adb b/src/grt/grt-signals.adb
index 02bfd4753..b88aaf026 100644
--- a/src/grt/grt-signals.adb
+++ b/src/grt/grt-signals.adb
@@ -1076,6 +1076,18 @@ package body Grt.Signals is
       Ghdl_Signal_Start_Assign (Sign, 0, Trans, 0);
    end Ghdl_Signal_Simple_Assign_B1;
 
+   procedure Ghdl_Signal_Start_Assign_Any (Sign : Ghdl_Signal_Ptr;
+                                           Rej : Std_Time;
+                                           Val : Value_Union;
+                                           After : Std_Time)
+   is
+      Trans : Transaction_Acc;
+   begin
+      Trans := new Transaction'
+        (Kind => Trans_Value, Line => 0, Time => 0, Next => null, Val => Val);
+      Ghdl_Signal_Start_Assign (Sign, Rej, Trans, After);
+   end Ghdl_Signal_Start_Assign_Any;
+
    procedure Ghdl_Signal_Start_Assign_B1 (Sign : Ghdl_Signal_Ptr;
                                           Rej : Std_Time;
                                           Val : Ghdl_B1;
diff --git a/src/grt/grt-signals.ads b/src/grt/grt-signals.ads
index 3c605786b..125cbff7f 100644
--- a/src/grt/grt-signals.ads
+++ b/src/grt/grt-signals.ads
@@ -599,6 +599,12 @@ package Grt.Signals is
 
    function Ghdl_Signal_Driving (Sig : Ghdl_Signal_Ptr) return Ghdl_B1;
 
+   --  Generic version.
+   procedure Ghdl_Signal_Start_Assign_Any (Sign : Ghdl_Signal_Ptr;
+                                           Rej : Std_Time;
+                                           Val : Value_Union;
+                                           After : Std_Time);
+
    function Ghdl_Create_Signal_B1 (Val_Ptr : Ghdl_Value_Ptr;
                                    Resolv_Func : Resolver_Acc;
                                    Resolv_Inst : System.Address)
diff --git a/src/simul/simul-vhdl_simul.adb b/src/simul/simul-vhdl_simul.adb
index 1d1a28aba..37f6eab32 100644
--- a/src/simul/simul-vhdl_simul.adb
+++ b/src/simul/simul-vhdl_simul.adb
@@ -167,6 +167,31 @@ package body Simul.Vhdl_Simul is
       Grt.Errors.Fatal_Error;
    end Error_Msg_Exec;
 
+   function To_Ghdl_Value (Mt : Memtyp) return Value_Union
+   is
+      Val : Value_Union;
+   begin
+      case Mt.Typ.Kind is
+         when Type_Bit =>
+            Val.B1 := Ghdl_B1'Val (Read_U8 (Mt.Mem));
+         when Type_Logic =>
+            Val.E8 := Read_U8 (Mt.Mem);
+         when Type_Discrete =>
+            if Mt.Typ.Sz = 1 then
+               Val.E8 := Read_U8 (Mt.Mem);
+            elsif Mt.Typ.Sz = 4 then
+               Val.I32 := Read_I32 (Mt.Mem);
+            elsif Mt.Typ.Sz = 8 then
+               Val.I64 := Read_I64 (Mt.Mem);
+            else
+               raise Internal_Error;
+            end if;
+         when others =>
+            raise Internal_Error;
+      end case;
+      return Val;
+   end To_Ghdl_Value;
+
    procedure Start_Assign_Value_To_Signal (Target: Memtyp;
                                            Rej : Std_Time;
                                            After : Std_Time;
@@ -174,22 +199,11 @@ package body Simul.Vhdl_Simul is
    begin
       case Target.Typ.Kind is
          when Type_Logic
-           | Type_Bit =>
-            Ghdl_Signal_Start_Assign_E8
-              (Read_Sig (Target.Mem), Rej, Read_U8 (Val), After);
-         when Type_Discrete =>
-            if Target.Typ.Sz = 1 then
-               Ghdl_Signal_Start_Assign_E8
-                 (Read_Sig (Target.Mem), Rej, Read_U8 (Val), After);
-            elsif Target.Typ.Sz = 4 then
-               Ghdl_Signal_Start_Assign_I32
-                 (Read_Sig (Target.Mem), Rej, Read_I32 (Val.Mem), After);
-            elsif Target.Typ.Sz = 8 then
-               Ghdl_Signal_Start_Assign_I64
-                 (Read_Sig (Target.Mem), Rej, Read_I64 (Val.Mem), After);
-            else
-               raise Internal_Error;
-            end if;
+           | Type_Bit
+           | Type_Discrete
+           | Type_Float =>
+            Ghdl_Signal_Start_Assign_Any
+              (Read_Sig (Target.Mem), Rej, To_Ghdl_Value (Val), After);
          when Type_Vector
            | Type_Array =>
             declare
@@ -720,55 +734,75 @@ package body Simul.Vhdl_Simul is
       Areapools.Release (Area_Mark, Instance_Pool.all);
    end Execute_Procedure_Call_Statement;
 
-   procedure Execute_Signal_Assignment (Inst : Synth_Instance_Acc;
-                                       Target : Target_Info;
-                                       Val : Valtyp;
-                                       Loc : Node);
-
-   procedure Execute_Aggregate_Signal_Assignment is
-      new Assign_Aggregate (Execute_Signal_Assignment);
-
-   procedure Execute_Signal_Assignment (Inst : Synth_Instance_Acc;
-                                        Target : Target_Info;
-                                        Val : Valtyp;
-                                        Loc : Node)
+   procedure Execute_Waveform_Assignment (Inst : Synth_Instance_Acc;
+                                          Target : Target_Info;
+                                          Stmt : Node;
+                                          Waveform : Node)
    is
       use Synth.Vhdl_Expr;
-      V : Valtyp;
-      Sig : Memtyp;
-   begin
-      V := Synth_Subtype_Conversion (Inst, Val, Target.Targ_Type, False, Loc);
-      pragma Unreferenced (Val);
+      V_Aft : Std_Time;
 
-      case Target.Kind is
-         when Target_Aggregate =>
-            Execute_Aggregate_Signal_Assignment
-              (Inst, Target.Aggr, Target.Targ_Type, V, Loc);
+      procedure Execute_Signal_Assignment (Inst : Synth_Instance_Acc;
+                                           Target : Target_Info;
+                                           Val : Valtyp;
+                                           Loc : Node);
 
-         when Target_Simple =>
-            declare
-               E : Signal_Entry renames Signals_Table.Table (Target.Obj.Val.S);
-            begin
-               Sig := (Target.Targ_Type,
-                       Sig_Index (E.Sig, Target.Off.Net_Off));
-            end;
+      procedure Execute_Aggregate_Signal_Assignment is
+         new Assign_Aggregate (Execute_Signal_Assignment);
+
+      procedure Execute_Signal_Assignment (Inst : Synth_Instance_Acc;
+                                           Target : Target_Info;
+                                           Val : Valtyp;
+                                           Loc : Node)
+      is
+         V : Valtyp;
+         Sig : Memtyp;
+      begin
+         V := Synth_Subtype_Conversion
+           (Inst, Val, Target.Targ_Type, False, Loc);
+         pragma Unreferenced (Val);
 
-            Start_Assign_Value_To_Signal (Sig, 0, 0, Get_Value_Memtyp (V));
+         case Target.Kind is
+            when Target_Aggregate =>
+               Execute_Aggregate_Signal_Assignment
+                 (Inst, Target.Aggr, Target.Targ_Type, V, Loc);
 
-         when Target_Memory =>
-            raise Internal_Error;
-      end case;
-   end Execute_Signal_Assignment;
+            when Target_Simple =>
+               declare
+                  E : Signal_Entry renames
+                    Signals_Table.Table (Target.Obj.Val.S);
+               begin
+                  Sig := (Target.Targ_Type,
+                          Sig_Index (E.Sig, Target.Off.Net_Off));
+               end;
+
+               Start_Assign_Value_To_Signal
+                 (Sig, V_Aft, V_Aft, Get_Value_Memtyp (V));
+
+            when Target_Memory =>
+               raise Internal_Error;
+         end case;
+      end Execute_Signal_Assignment;
 
-   procedure Execute_Waveform_Assignment (Inst : Synth_Instance_Acc;
-                                          Target : Target_Info;
-                                          Waveform : Node)
-   is
-      use Synth.Vhdl_Expr;
       Wf : Node;
       Val : Valtyp;
+      Aft : Node;
+      Rej : Node;
    begin
+      Rej := Get_Reject_Time_Expression (Stmt);
+      if Rej /= Null_Node then
+         raise Internal_Error;
+      end if;
+
       Wf := Waveform;
+      Aft := Get_Time (Wf);
+      if Aft /= Null_Node then
+         Val := Synth_Expression (Inst, Aft);
+         V_Aft := Std_Time (Read_I64 (Val.Val.Mem));
+      else
+         V_Aft := 0;
+      end if;
+
       Val := Synth_Expression_With_Type
         (Inst, Get_We_Value (Wf), Target.Targ_Type);
       Execute_Signal_Assignment (Inst, Target, Val, Wf);
@@ -788,7 +822,8 @@ package body Simul.Vhdl_Simul is
    begin
       Info := Synth_Target (Inst, Target);
 
-      Execute_Waveform_Assignment (Inst, Info, Get_Waveform_Chain (Stmt));
+      Execute_Waveform_Assignment
+        (Inst, Info, Stmt, Get_Waveform_Chain (Stmt));
    end Execute_Simple_Signal_Assignment;
 
    procedure Execute_Conditional_Signal_Assignment (Inst : Synth_Instance_Acc;
@@ -809,7 +844,7 @@ package body Simul.Vhdl_Simul is
            or else Execute_Condition (Inst, Cond)
          then
             Execute_Waveform_Assignment
-              (Inst, Info, Get_Waveform_Chain (Cw));
+              (Inst, Info, Stmt, Get_Waveform_Chain (Cw));
             exit;
          end if;
          Cw := Get_Chain (Cw);
@@ -1646,18 +1681,6 @@ package body Simul.Vhdl_Simul is
       end case;
    end Resolver_Read_Value;
 
-   procedure Write_Ghdl_Value (Mt : Memtyp; Val : out Value_Union) is
-   begin
-      case Mt.Typ.Kind is
-         when Type_Bit =>
-            Val.B1 := Ghdl_B1'Val (Read_U8 (Mt.Mem));
-         when Type_Logic =>
-            Val.E8 := Read_U8 (Mt.Mem);
-         when others =>
-            raise Internal_Error;
-      end case;
-   end Write_Ghdl_Value;
-
    type Write_Signal_Enum is
      (Write_Signal_Driving_Value,
       Write_Signal_Effective_Value);
@@ -1674,9 +1697,9 @@ package body Simul.Vhdl_Simul is
             S := Read_Sig (Sig);
             case Attr is
                when Write_Signal_Driving_Value =>
-                  Write_Ghdl_Value (Val, S.Driving_Value);
+                  S.Driving_Value := To_Ghdl_Value (Val);
                when Write_Signal_Effective_Value =>
-                  Write_Ghdl_Value (Val, S.Value_Ptr.all);
+                  S.Value_Ptr.all := To_Ghdl_Value (Val);
             end case;
          when others =>
             raise Internal_Error;