grt: remove ghdl_exit_cb*, replaced by an error hook.

5 files changed, 30 insertions, 30 deletions

diff --git a/translate/grt/grt-errors.adb b/translate/grt/grt-errors.adb
index 4933b7fe1..c4eb30b1b 100644
--- a/translate/grt/grt-errors.adb
+++ b/translate/grt/grt-errors.adb
@@ -25,6 +25,7 @@
 with Grt.Stdio; use Grt.Stdio;
 with Grt.Astdio; use Grt.Astdio;
 with Grt.Options; use Grt.Options;
+with Grt.Hooks; use Grt.Hooks;
 
 package body Grt.Errors is
    procedure Fatal_Error;
@@ -42,13 +43,6 @@ package body Grt.Errors is
       pragma Import (C, C_Exit, "exit");
       pragma No_Return (C_Exit);
    begin
-      if Ghdl_Exit_Cb1 /= null then
-         Ghdl_Exit_Cb1.all (Code);
-      end if;
-
-      if Ghdl_Exit_Cb /= null then
-         Ghdl_Exit_Cb.all (Code);
-      end if;
       C_Exit (Code);
    end Ghdl_Exit;
 
@@ -58,6 +52,15 @@ package body Grt.Errors is
 
    procedure Fatal_Error is
    begin
+      if Error_Hook /= null then
+         --  Call the hook, but avoid infinite loop by reseting it.
+         declare
+            Current_Hook : constant Proc_Hook_Type := Error_Hook;
+         begin
+            Error_Hook := null;
+            Current_Hook.all;
+         end;
+      end if;
       Maybe_Return_Via_Longjump (-1);
       if Expect_Failure then
          Ghdl_Exit (0);
diff --git a/translate/grt/grt-errors.ads b/translate/grt/grt-errors.ads
index dab84cf03..ee92cb987 100644
--- a/translate/grt/grt-errors.ads
+++ b/translate/grt/grt-errors.ads
@@ -23,6 +23,7 @@
 --  however invalidate any other reasons why the executable file might be
 --  covered by the GNU Public License.
 with Grt.Types; use Grt.Types;
+with Grt.Hooks;
 
 package Grt.Errors is
    pragma Preelaborate (Grt.Errors);
@@ -61,18 +62,13 @@ package Grt.Errors is
    --  Display an error message for an overflow.
    procedure Grt_Overflow_Error;
 
-   type Exit_Cb_Type is access procedure (Code : Integer);
-   pragma Convention (C, Exit_Cb_Type);
-
-   Ghdl_Exit_Cb : Exit_Cb_Type := null;
-   Ghdl_Exit_Cb1 : Exit_Cb_Type := null;
+   --  Hook called in case of error.
+   Error_Hook : Grt.Hooks.Proc_Hook_Type := null;
 
    --  If true, an error is expected and the exit status is inverted.
    Expect_Failure : Boolean := False;
 
 private
-   pragma Export (C, Ghdl_Exit_Cb, "__ghdl_exit_cb");
-
    pragma Export (C, Grt_Overflow_Error, "grt_overflow_error");
 
    pragma No_Return (Error);
diff --git a/translate/grt/grt-main.adb b/translate/grt/grt-main.adb
index 3052a958b..116ea7b2e 100644
--- a/translate/grt/grt-main.adb
+++ b/translate/grt/grt-main.adb
@@ -135,10 +135,6 @@ package body Grt.Main is
       Grt.Signals.Init;
 
       if Flag_Stats then
-         if Boolean'(False) then
-            --  Replaced by Setjump/Longjump.
-            Grt.Errors.Ghdl_Exit_Cb1 := Disp_Stats_Hook'Access;
-         end if;
          Stats.Start_Elaboration;
       end if;
 
diff --git a/translate/grt/grt-processes.adb b/translate/grt/grt-processes.adb
index 6b5a3934d..3d40f3a96 100644
--- a/translate/grt/grt-processes.adb
+++ b/translate/grt/grt-processes.adb
@@ -776,6 +776,12 @@ package body Grt.Processes is
    is
       Status : Integer;
    begin
+      --  Allocate processes arrays.
+      Resume_Process_Table :=
+        new Process_Acc_Array (1 .. Nbr_Non_Postponed_Processes);
+      Postponed_Resume_Process_Table :=
+        new Process_Acc_Array (1 .. Nbr_Postponed_Processes);
+
       --  LRM93 12.6.4
       --  At the beginning of initialization, the current time, Tc, is assumed
       --  to be 0 ns.
@@ -821,6 +827,9 @@ package body Grt.Processes is
       --    of step f of the simulation cycle, below.
       Current_Time := Compute_Next_Time;
 
+      --  Clear current_delta, will be set by Simulation_Cycle.
+      Current_Delta := 0;
+
       return Run_Resumed;
    end Initialization_Phase;
 
@@ -962,18 +971,11 @@ package body Grt.Processes is
 --          Grt.Disp.Disp_Signals_Type;
 --       end if;
 
-      --  Allocate processes arrays.
-      Resume_Process_Table :=
-        new Process_Acc_Array (1 .. Nbr_Non_Postponed_Processes);
-      Postponed_Resume_Process_Table :=
-        new Process_Acc_Array (1 .. Nbr_Postponed_Processes);
-
       Status := Run_Through_Longjump (Initialization_Phase'Access);
       if Status /= Run_Resumed then
          return -1;
       end if;
 
-      Current_Delta := 0;
       Nbr_Delta_Cycles := 0;
       Nbr_Cycles := 0;
       if Trace_Signals then
@@ -981,7 +983,8 @@ package body Grt.Processes is
       end if;
 
       if Current_Time /= 0 then
-         --  This is the end of a cycle.
+         --  This is the end of a cycle.  This can happen when the time is not
+         --  zero after initialization.
          Cycle_Time := 0;
          Grt.Hooks.Call_Cycle_Hooks;
       end if;
diff --git a/translate/grt/grt-signals.ads b/translate/grt/grt-signals.ads
index d61dee3db..76595c75b 100644
--- a/translate/grt/grt-signals.ads
+++ b/translate/grt/grt-signals.ads
@@ -665,12 +665,14 @@ package Grt.Signals is
    procedure Ghdl_Signal_Effective_Value (Targ : Ghdl_Signal_Ptr;
                                           Src : Ghdl_Signal_Ptr);
 
-   --  Create a new 'stable (VAL) signal.
+   --  Create a new 'stable (VAL) signal.  The prefixes are set by
+   --  ghdl_signal_attribute_register_prefix.
    function Ghdl_Create_Stable_Signal (Val : Std_Time) return Ghdl_Signal_Ptr;
-   --  Create a new 'quiet (VAL) signal.
+   --  Create a new 'quiet (VAL) signal.  The prefixes are set by
+   --  ghdl_signal_attribute_register_prefix.
    function Ghdl_Create_Quiet_Signal (Val : Std_Time) return Ghdl_Signal_Ptr;
-
-   --  Create a new 'transaction signal.
+   --  Create a new 'transaction signal.  The prefixes are set by
+   --  ghdl_signal_attribute_register_prefix.
    function Ghdl_Create_Transaction_Signal return Ghdl_Signal_Ptr;
 
    --  Create a new SIG'delayed (VAL) signal.