simul: add an hook to display report/assert message

3 files changed, 128 insertions, 50 deletions

diff --git a/src/simul/simul-vhdl_simul.adb b/src/simul/simul-vhdl_simul.adb
index 0e19a3159..a3638f21e 100644
--- a/src/simul/simul-vhdl_simul.adb
+++ b/src/simul/simul-vhdl_simul.adb
@@ -60,6 +60,7 @@ with Grt.Stdio;
 with Grt.Processes;
 with Grt.Main;
 with Grt.Errors;
+with Grt.Severity;
 with Grt.Lib;
 with Grt.Analog_Solver;
 
@@ -940,6 +941,47 @@ package body Simul.Vhdl_Simul is
       Release_Expr_Pool (Marker);
    end Execute_Selected_Signal_Assignment;
 
+   procedure Assertion_Report_Msg (Inst : Synth_Instance_Acc;
+                                   Stmt : Node;
+                                   Severity : Natural;
+                                   Msg : Valtyp)
+   is
+      pragma Unreferenced (Inst);
+      use Grt.Severity;
+      use Grt.Errors;
+   begin
+      Report_S (Vhdl.Errors.Disp_Location (Stmt));
+      Diag_C (":@");
+      Diag_C_Now;
+      Diag_C (":(");
+      if Get_Kind (Stmt) = Iir_Kind_Report_Statement then
+         Diag_C ("report");
+      else
+         Diag_C ("assert");
+      end if;
+      Diag_C (' ');
+      case Severity is
+         when Note_Severity =>
+            Diag_C ("note");
+         when Warning_Severity =>
+            Diag_C ("warning");
+         when Error_Severity =>
+            Diag_C ("error");
+         when Failure_Severity =>
+            Diag_C ("failure");
+         when others =>
+            Diag_C ("??");
+      end case;
+      Diag_C ("): ");
+
+      if Msg = No_Valtyp then
+         Diag_C ("Assertion violation.");
+      else
+         Diag_C (Value_To_String (Msg));
+      end if;
+      Report_E;
+   end Assertion_Report_Msg;
+
    procedure Execute_Assertion_Statement (Inst : Synth_Instance_Acc;
                                           Stmt : Node)
    is
@@ -961,8 +1003,7 @@ package body Simul.Vhdl_Simul is
             end if;
       end case;
 
-      Exec_Failed_Assertion
-        (Inst, Stmt, "assertion", "Assertion violation.", 2);
+      Exec_Failed_Assertion (Inst, Stmt);
    end Execute_Assertion_Statement;
 
    procedure Execute_Sequential_Statements_Inner (Process : Process_State_Acc;
@@ -1564,22 +1605,16 @@ package body Simul.Vhdl_Simul is
          case Get_Kind (E.Proc) is
             when Iir_Kind_Psl_Assert_Directive =>
                if Nvec (S_Num) then
-                  Exec_Failed_Assertion
-                    (E.Instance, E.Proc,
-                     "psl assertion", "assertion violation", 2);
+                  Exec_Failed_Assertion (E.Instance, E.Proc);
                end if;
             when Iir_Kind_Psl_Assume_Directive =>
                if Nvec (S_Num) then
-                  Exec_Failed_Assertion
-                    (E.Instance, E.Proc,
-                     "psl assumption", "assumption violation", 2);
+                  Exec_Failed_Assertion (E.Instance, E.Proc);
                end if;
             when Iir_Kind_Psl_Cover_Directive =>
                if Nvec (S_Num) then
                   if Get_Report_Expression (E.Proc) /= Null_Iir then
-                     Exec_Failed_Assertion
-                       (E.Instance, E.Proc,
-                        "psl cover", "sequence covered", 0);
+                     Exec_Failed_Assertion (E.Instance, E.Proc);
                   end if;
                   E.Done := True;
                end if;
@@ -1624,9 +1659,7 @@ package body Simul.Vhdl_Simul is
               and then
               Execute_Psl_Expr (Ent.Instance, Get_Edge_Expr (E), True)
             then
-               Exec_Failed_Assertion
-                 (Ent.Instance, Ent.Proc,
-                  "psl assertion", "assertion violation", 2);
+               Exec_Failed_Assertion (Ent.Instance, Ent.Proc);
                exit;
             end if;
          end if;
@@ -2996,6 +3029,9 @@ package body Simul.Vhdl_Simul is
             Grt.Analog_Solver.Start;
          end if;
 
+         Grt.Errors.Set_Error_Stream (Grt.Stdio.stdout);
+         Assertion_Report_Handler := Assertion_Report_Msg'Access;
+
          loop
             if Break_Time < Grt.Processes.Next_Time then
                Grt.Processes.Next_Time := Break_Time;
diff --git a/src/synth/synth-vhdl_stmts.adb b/src/synth/synth-vhdl_stmts.adb
index dcd7cd06d..23da44f73 100644
--- a/src/synth/synth-vhdl_stmts.adb
+++ b/src/synth/synth-vhdl_stmts.adb
@@ -3058,10 +3058,7 @@ package body Synth.Vhdl_Stmts is
    end Synth_Return_Statement;
 
    procedure Exec_Failed_Assertion (Syn_Inst : Synth_Instance_Acc;
-                                    Stmt : Node;
-                                    Stmt_Msg : String;
-                                    Default_Rep : String;
-                                    Default_Severity : Natural)
+                                    Stmt : Node)
    is
       use Simple_IO;
       Rep_Expr : constant Node := Get_Report_Expression (Stmt);
@@ -3090,33 +3087,75 @@ package body Synth.Vhdl_Stmts is
          Strip_Const (Sev);
       end if;
 
-      Put_Err (Disp_Location (Stmt));
-      Put_Err (":(");
-      Put_Err (Stmt_Msg);
-      Put_Err (' ');
       if Sev = No_Valtyp then
-         Sev_V := Default_Severity;
+         case Get_Kind (Stmt) is
+            when Iir_Kind_Report_Statement
+              | Iir_Kind_Psl_Cover_Directive =>
+               Sev_V := Note_Severity;
+            when Iir_Kind_Assertion_Statement
+              | Iir_Kind_Concurrent_Assertion_Statement
+              | Iir_Kind_Psl_Assert_Directive
+              | Iir_Kind_Psl_Assume_Directive =>
+               Sev_V := Error_Severity;
+            when others =>
+               raise Internal_Error;
+         end case;
       else
          Sev_V := Natural (Read_Discrete (Sev));
       end if;
-      case Sev_V is
-         when Note_Severity =>
-            Put_Err ("note");
-         when Warning_Severity =>
-            Put_Err ("warning");
-         when Error_Severity =>
-            Put_Err ("error");
-         when Failure_Severity =>
-            Put_Err ("failure");
-         when others =>
-            Put_Err ("??");
-      end case;
-      Put_Err ("): ");
 
-      if Rep = No_Valtyp then
-         Put_Line_Err (Default_Rep);
+      if Assertion_Report_Handler /= null then
+         Assertion_Report_Handler (Syn_Inst, Stmt, Sev_V, Rep);
       else
-         Put_Line_Err (Value_To_String (Rep));
+         Put_Err (Disp_Location (Stmt));
+         Put_Err (":(");
+         case Get_Kind (Stmt) is
+            when Iir_Kind_Report_Statement =>
+               Put_Err ("report");
+            when Iir_Kind_Assertion_Statement
+              | Iir_Kind_Concurrent_Assertion_Statement =>
+               Put_Err ("assert");
+            when Iir_Kind_Psl_Assert_Directive =>
+               Put_Err ("psl assertion");
+            when Iir_Kind_Psl_Assume_Directive =>
+               Put_Err ("psl assumption");
+            when Iir_Kind_Psl_Cover_Directive =>
+               Put_Err ("psl cover");
+            when others =>
+               raise Internal_Error;
+         end case;
+         Put_Err (' ');
+         case Sev_V is
+            when Note_Severity =>
+               Put_Err ("note");
+            when Warning_Severity =>
+               Put_Err ("warning");
+            when Error_Severity =>
+               Put_Err ("error");
+            when Failure_Severity =>
+               Put_Err ("failure");
+            when others =>
+               Put_Err ("??");
+         end case;
+         Put_Err ("): ");
+
+         if Rep = No_Valtyp then
+            case Get_Kind (Stmt) is
+               when Iir_Kind_Report_Statement
+                 | Iir_Kind_Assertion_Statement
+                 | Iir_Kind_Concurrent_Assertion_Statement
+                 | Iir_Kind_Psl_Assert_Directive =>
+                  Put_Err ("Assertion violation.");
+               when Iir_Kind_Psl_Assume_Directive =>
+                  Put_Err ("Assumption violation.");
+               when Iir_Kind_Psl_Cover_Directive =>
+                  Put_Err ("sequence coveredr");
+               when others =>
+                  raise Internal_Error;
+            end case;
+         else
+            Put_Line_Err (Value_To_String (Rep));
+         end if;
       end if;
 
       Release_Expr_Pool (Marker);
@@ -3130,7 +3169,7 @@ package body Synth.Vhdl_Stmts is
    procedure Execute_Report_Statement (Inst : Synth_Instance_Acc;
                                        Stmt : Node) is
    begin
-      Exec_Failed_Assertion (Inst, Stmt, "report", "Assertion violation.", 0);
+      Exec_Failed_Assertion (Inst, Stmt);
    end Execute_Report_Statement;
 
    --  Return True if EXPR can be evaluated with static values.
@@ -3171,8 +3210,7 @@ package body Synth.Vhdl_Stmts is
         and then (Sev_Expr = Null_Node
                     or else Is_Static_Expr (Inst, Sev_Expr))
       then
-         Exec_Failed_Assertion
-           (Inst, Stmt, "report", "Assertion violation.", 0);
+         Exec_Failed_Assertion (Inst, Stmt);
       end if;
    end Synth_Dynamic_Report_Statement;
 
@@ -3191,8 +3229,7 @@ package body Synth.Vhdl_Stmts is
       if Read_Discrete (Cond) = 1 then
          return;
       end if;
-      Exec_Failed_Assertion
-        (Inst, Stmt, "assertion", "Assertion violation.", 2);
+      Exec_Failed_Assertion (Inst, Stmt);
    end Execute_Assertion_Statement;
 
    procedure Synth_Dynamic_Assertion_Statement (C : Seq_Context; Stmt : Node)
@@ -3474,8 +3511,7 @@ package body Synth.Vhdl_Stmts is
       end if;
       if Is_Static (Val.Val) then
          if Read_Discrete (Val) /= 1 then
-            Exec_Failed_Assertion
-              (Syn_Inst, Stmt, "assertion", "Assertion violation.", 2);
+            Exec_Failed_Assertion (Syn_Inst, Stmt);
          end if;
          return;
       end if;
diff --git a/src/synth/synth-vhdl_stmts.ads b/src/synth/synth-vhdl_stmts.ads
index db78c44d7..99aa5ff97 100644
--- a/src/synth/synth-vhdl_stmts.ads
+++ b/src/synth/synth-vhdl_stmts.ads
@@ -28,6 +28,15 @@ with Netlists; use Netlists;
 with Synth.Vhdl_Environment; use Synth.Vhdl_Environment.Env;
 
 package Synth.Vhdl_Stmts is
+   type Assertion_Report_Handler_Acc is access procedure
+     (Inst : Synth_Instance_Acc;
+      Stmt : Node;
+      Severity : Natural;
+      Msg : Valtyp);
+
+   --  Procedure to call for report/assertion message.
+   Assertion_Report_Handler : Assertion_Report_Handler_Acc;
+
    --  Create a new Synth_Instance for calling subprogram IMP/BOD.
    function Synth_Subprogram_Call_Instance (Inst : Synth_Instance_Acc;
                                             Imp : Node;
@@ -104,10 +113,7 @@ package Synth.Vhdl_Stmts is
    procedure Execute_Report_Statement (Inst : Synth_Instance_Acc;
                                        Stmt : Node);
    procedure Exec_Failed_Assertion (Syn_Inst : Synth_Instance_Acc;
-                                    Stmt : Node;
-                                    Stmt_Msg : String;
-                                    Default_Rep : String;
-                                    Default_Severity : Natural);
+                                    Stmt : Node);
 
    procedure Init_For_Loop_Statement (Inst : Synth_Instance_Acc;
                                       Stmt : Node;