aboutsummaryrefslogtreecommitdiffstats
path: root/translate
diff options
context:
space:
mode:
Diffstat (limited to 'translate')
-rw-r--r--translate/grt/grt-errors.adb17
-rw-r--r--translate/grt/grt-errors.ads10
-rw-r--r--translate/grt/grt-main.adb4
-rw-r--r--translate/grt/grt-processes.adb19
-rw-r--r--translate/grt/grt-signals.ads10
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.