diff options
| -rw-r--r-- | translate/grt/grt-errors.adb | 17 | ||||
| -rw-r--r-- | translate/grt/grt-errors.ads | 10 | ||||
| -rw-r--r-- | translate/grt/grt-main.adb | 4 | ||||
| -rw-r--r-- | translate/grt/grt-processes.adb | 19 | ||||
| -rw-r--r-- | translate/grt/grt-signals.ads | 10 |
5 files changed, 30 insertions, 30 deletions
diff --git a/translate/grt/grt-errors.adb b/translate/grt/grt-errors.adb index 4933b7f..c4eb30b 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 dab84cf..ee92cb9 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 3052a95..116ea7b 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 6b5a393..3d40f3a 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 d61dee3..76595c7 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. |