simul: handle driving and driving_value attributes

5 files changed, 66 insertions, 8 deletions

diff --git a/src/grt/grt-signals.adb b/src/grt/grt-signals.adb
index 5c542a38e..b81a86fd3 100644
--- a/src/grt/grt-signals.adb
+++ b/src/grt/grt-signals.adb
@@ -1803,7 +1803,8 @@ package body Grt.Signals is
       end if;
    end Ghdl_Signal_Driving;
 
-   function Ghdl_Signal_Driving_Value_B1 (Sig : Ghdl_Signal_Ptr) return Ghdl_B1
+   function Ghdl_Signal_Driving_Value (Sig : Ghdl_Signal_Ptr)
+                                      return Value_Union
    is
       Drv : Driver_Acc;
    begin
@@ -1811,8 +1812,14 @@ package body Grt.Signals is
       if Drv = null or else Drv.First_Trans.Kind /= Trans_Value then
          Error ("'driving_value: no active driver in process for signal");
       else
-         return Drv.First_Trans.Val.B1;
+         return Drv.First_Trans.Val;
       end if;
+   end Ghdl_Signal_Driving_Value;
+
+   function Ghdl_Signal_Driving_Value_B1 (Sig : Ghdl_Signal_Ptr)
+                                         return Ghdl_B1 is
+   begin
+      return Ghdl_Signal_Driving_Value (Sig).B1;
    end Ghdl_Signal_Driving_Value_B1;
 
    function Ghdl_Signal_Driving_Value_E8 (Sig : Ghdl_Signal_Ptr)
diff --git a/src/grt/grt-signals.ads b/src/grt/grt-signals.ads
index 618ec8805..76977d37a 100644
--- a/src/grt/grt-signals.ads
+++ b/src/grt/grt-signals.ads
@@ -599,6 +599,9 @@ package Grt.Signals is
 
    function Ghdl_Signal_Driving (Sig : Ghdl_Signal_Ptr) return Ghdl_B1;
 
+   function Ghdl_Signal_Driving_Value (Sig : Ghdl_Signal_Ptr)
+                                      return Value_Union;
+
    --  Generic version.
    procedure Ghdl_Signal_Start_Assign_Any (Sign : Ghdl_Signal_Ptr;
                                            Rej : Std_Time;
diff --git a/src/simul/simul-vhdl_simul.adb b/src/simul/simul-vhdl_simul.adb
index 8ee08d1a0..354ca062f 100644
--- a/src/simul/simul-vhdl_simul.adb
+++ b/src/simul/simul-vhdl_simul.adb
@@ -446,6 +446,9 @@ package body Simul.Vhdl_Simul is
                        and then Pfx.Obj.Val.Kind = Value_Signal);
       E := Read_Signal_Flag
         ((Pfx.Targ_Type, Get_Sig_Mem (Pfx.Obj.Val, Pfx.Off.Net_Off)), Kind);
+      if Kind = Read_Signal_Not_Driving then
+         E := not E;
+      end if;
       Res := Create_Value_Memory (Boolean_Type, Expr_Pool'Access);
       Write_U8 (Res.Val.Mem, Boolean'Pos (E));
       return Res;
@@ -463,6 +466,12 @@ package body Simul.Vhdl_Simul is
       return Exec_Signal_Flag_Attribute (Inst, Expr, Read_Signal_Active);
    end Exec_Active_Attribute;
 
+   function Exec_Driving_Attribute (Inst : Synth_Instance_Acc;
+                                   Expr : Node) return Valtyp is
+   begin
+      return Exec_Signal_Flag_Attribute (Inst, Expr, Read_Signal_Not_Driving);
+   end Exec_Driving_Attribute;
+
    function Exec_Dot_Attribute (Inst : Synth_Instance_Acc;
                                 Expr : Node) return Valtyp
    is
@@ -2123,10 +2132,10 @@ package body Simul.Vhdl_Simul is
 
       --  For conversion functions.
       Read_Signal_Driving_Value,
-      Read_Signal_Effective_Value --,
+      Read_Signal_Effective_Value,
 
       --  'Driving_Value
---      Read_Signal_Driver_Value
+      Read_Signal_Driver_Value
      );
 
    procedure Exec_Read_Signal (Sig: Memory_Ptr;
@@ -2145,6 +2154,8 @@ package body Simul.Vhdl_Simul is
                   Write_Ghdl_Value (Val, S.Value_Ptr.all);
                when Read_Signal_Last_Value =>
                   Write_Ghdl_Value (Val, S.Last_Value);
+               when Read_Signal_Driver_Value =>
+                  Write_Ghdl_Value (Val, Ghdl_Signal_Driving_Value (S));
             end case;
          when Type_Vector
            | Type_Array =>
@@ -2174,24 +2185,38 @@ package body Simul.Vhdl_Simul is
       end case;
    end Exec_Read_Signal;
 
-   function Exec_Last_Value_Attribute (Inst : Synth_Instance_Acc;
-                                       Expr : Node) return Valtyp
+   function Exec_Signal_Value_Attribute (Inst : Synth_Instance_Acc;
+                                         Attr : Node;
+                                         Kind : Read_Signal_Enum) return Valtyp
    is
       Pfx : Target_Info;
       Res : Valtyp;
       S : Memory_Ptr;
    begin
-      Pfx := Synth_Target (Inst, Get_Prefix (Expr));
+      Pfx := Synth_Target (Inst, Get_Prefix (Attr));
 
       Res := Create_Value_Memory (Pfx.Targ_Type, Expr_Pool'Access);
 
       S := Sig_Index (Signals_Table.Table (Pfx.Obj.Val.S).Sig,
                       Pfx.Off.Net_Off);
 
-      Exec_Read_Signal (S, Get_Memtyp (Res), Read_Signal_Last_Value);
+      Exec_Read_Signal (S, Get_Memtyp (Res), Kind);
       return Res;
+   end Exec_Signal_Value_Attribute;
+
+   function Exec_Last_Value_Attribute (Inst : Synth_Instance_Acc;
+                                       Expr : Node) return Valtyp is
+   begin
+      return Exec_Signal_Value_Attribute (Inst, Expr, Read_Signal_Last_Value);
    end Exec_Last_Value_Attribute;
 
+   function Exec_Driving_Value_Attribute (Inst : Synth_Instance_Acc;
+                                          Expr : Node) return Valtyp is
+   begin
+      return Exec_Signal_Value_Attribute
+        (Inst, Expr, Read_Signal_Driver_Value);
+   end Exec_Driving_Value_Attribute;
+
    type Read_Signal_Last_Enum is
      (
       Read_Signal_Last_Event,
@@ -2269,6 +2294,11 @@ package body Simul.Vhdl_Simul is
                       Pfx.Off.Net_Off);
 
       T := Exec_Read_Signal_Last (S, Get_Memtyp (Res), Attr);
+      if T < 0 then
+         T := Std_Time'Last;
+      else
+         T := Current_Time - T;
+      end if;
       Write_I64 (Res.Val.Mem, Ghdl_I64 (T));
       return Res;
    end Exec_Signal_Last_Attribute;
@@ -3751,6 +3781,9 @@ package body Simul.Vhdl_Simul is
       Synth.Vhdl_Expr.Hook_Signal_Expr := Hook_Signal_Expr'Access;
       Synth.Vhdl_Expr.Hook_Event_Attribute := Exec_Event_Attribute'Access;
       Synth.Vhdl_Expr.Hook_Active_Attribute := Exec_Active_Attribute'Access;
+      Synth.Vhdl_Expr.Hook_Driving_Attribute := Exec_Driving_Attribute'Access;
+      Synth.Vhdl_Expr.Hook_Driving_Value_Attribute :=
+        Exec_Driving_Value_Attribute'Access;
       Synth.Vhdl_Expr.Hook_Last_Value_Attribute :=
         Exec_Last_Value_Attribute'Access;
       Synth.Vhdl_Expr.Hook_Last_Event_Attribute :=
diff --git a/src/synth/synth-vhdl_expr.adb b/src/synth/synth-vhdl_expr.adb
index c701be7c2..af66fb874 100644
--- a/src/synth/synth-vhdl_expr.adb
+++ b/src/synth/synth-vhdl_expr.adb
@@ -2429,6 +2429,19 @@ package body Synth.Vhdl_Expr is
             end if;
             Error_Msg_Synth (Syn_Inst, Expr, "active attribute not allowed");
             return No_Valtyp;
+         when Iir_Kind_Driving_Attribute =>
+            if Hook_Driving_Attribute /= null then
+               return Hook_Driving_Attribute (Syn_Inst, Expr);
+            end if;
+            Error_Msg_Synth (Syn_Inst, Expr, "driving attribute not allowed");
+            return No_Valtyp;
+         when Iir_Kind_Driving_Value_Attribute =>
+            if Hook_Driving_Value_Attribute /= null then
+               return Hook_Driving_Value_Attribute (Syn_Inst, Expr);
+            end if;
+            Error_Msg_Synth (Syn_Inst, Expr,
+                             "driving_value attribute not allowed");
+            return No_Valtyp;
          when Iir_Kind_Last_Value_Attribute =>
             if Hook_Last_Value_Attribute /= null then
                return Hook_Last_Value_Attribute (Syn_Inst, Expr);
diff --git a/src/synth/synth-vhdl_expr.ads b/src/synth/synth-vhdl_expr.ads
index 74412fe22..c991f388a 100644
--- a/src/synth/synth-vhdl_expr.ads
+++ b/src/synth/synth-vhdl_expr.ads
@@ -89,6 +89,8 @@ package Synth.Vhdl_Expr is
      function (Syn_Inst : Synth_Instance_Acc; Expr : Node) return Valtyp;
    Hook_Event_Attribute : Hook_Attribute_Acc;
    Hook_Active_Attribute : Hook_Attribute_Acc;
+   Hook_Driving_Attribute : Hook_Attribute_Acc;
+   Hook_Driving_Value_Attribute : Hook_Attribute_Acc;
    Hook_Last_Value_Attribute : Hook_Attribute_Acc;
    Hook_Last_Event_Attribute : Hook_Attribute_Acc;
    Hook_Last_Active_Attribute : Hook_Attribute_Acc;