diff options
| author | gingold <gingold@b72b5c32-5f01-0410-b925-b5c7b92870f7> | 2009-12-16 04:40:33 +0000 |
|---|---|---|
| committer | gingold <gingold@b72b5c32-5f01-0410-b925-b5c7b92870f7> | 2009-12-16 04:40:33 +0000 |
| commit | 4600532b78f9c901cd32cc079f2567708dc81fc8 (patch) | |
| tree | 625f7d7125205e700844f90cbe73df66d4cc4012 /translate/grt/grt-processes.adb | |
| parent | 19c2aaceb9610aee1de5197a92b87600e484bbde (diff) | |
| download | ghdl-4600532b78f9c901cd32cc079f2567708dc81fc8.tar.gz ghdl-4600532b78f9c901cd32cc079f2567708dc81fc8.tar.bz2 ghdl-4600532b78f9c901cd32cc079f2567708dc81fc8.zip | |
Fix timeout chain corruptio.
From Thomas Sailer.
Rename a type.
Diffstat (limited to 'translate/grt/grt-processes.adb')
| -rw-r--r-- | translate/grt/grt-processes.adb | 21 |
1 files changed, 12 insertions, 9 deletions
diff --git a/translate/grt/grt-processes.adb b/translate/grt/grt-processes.adb index c620cf9c7..4f556d9e3 100644 --- a/translate/grt/grt-processes.adb +++ b/translate/grt/grt-processes.adb @@ -54,12 +54,12 @@ package body Grt.Processes is Table_Initial => 2); -- List of processes to be resume at next cycle. - type Process_Id_Array is array (Natural range <>) of Process_Acc; - type Process_Id_Array_Acc is access Process_Id_Array; + type Process_Acc_Array is array (Natural range <>) of Process_Acc; + type Process_Acc_Array_Acc is access Process_Acc_Array; - Resume_Process_Table : Process_Id_Array_Acc; + Resume_Process_Table : Process_Acc_Array_Acc; Last_Resume_Process : Natural := 0; - Postponed_Resume_Process_Table : Process_Id_Array_Acc; + Postponed_Resume_Process_Table : Process_Acc_Array_Acc; Last_Postponed_Resume_Process : Natural := 0; -- Number of postponed processes. @@ -69,7 +69,7 @@ package body Grt.Processes is -- Number of resumed processes. Nbr_Resumed_Processes : Natural := 0; - -- Earliest time out within processes. + -- Earliest time out within non-sensitized processes. Process_First_Timeout : Std_Time := Last_Time; Process_Timeout_Chain : Process_Acc := null; @@ -304,6 +304,8 @@ package body Grt.Processes is if Proc.Timeout_Chain_Prev /= null then Proc.Timeout_Chain_Prev.Timeout_Chain_Next := Proc.Timeout_Chain_Next; + -- Be sure a second call won't corrupt the chain. + Proc.Timeout_Chain_Prev := null; elsif Process_Timeout_Chain = Proc then -- Only if Proc is in the chain. Process_Timeout_Chain := Proc.Timeout_Chain_Next; @@ -311,6 +313,7 @@ package body Grt.Processes is if Proc.Timeout_Chain_Next /= null then Proc.Timeout_Chain_Next.Timeout_Chain_Prev := Proc.Timeout_Chain_Prev; + Proc.Timeout_Chain_Next := null; end if; end Remove_Process_From_Timeout_Chain; @@ -622,7 +625,7 @@ package body Grt.Processes is Run_Failure : constant Integer := -1; Mt_Last : Natural; - Mt_Table : Process_Id_Array_Acc; + Mt_Table : Process_Acc_Array_Acc; Mt_Index : aliased Natural; procedure Run_Processes_Threads @@ -665,7 +668,7 @@ package body Grt.Processes is function Run_Processes (Postponed : Boolean) return Integer is - Table : Process_Id_Array_Acc; + Table : Process_Acc_Array_Acc; Last : Natural; begin if Options.Flag_Stats then @@ -919,9 +922,9 @@ package body Grt.Processes is -- Allocate processes arrays. Resume_Process_Table := - new Process_Id_Array (1 .. Nbr_Non_Postponed_Processes); + new Process_Acc_Array (1 .. Nbr_Non_Postponed_Processes); Postponed_Resume_Process_Table := - new Process_Id_Array (1 .. Nbr_Postponed_Processes); + new Process_Acc_Array (1 .. Nbr_Postponed_Processes); Status := Run_Through_Longjump (Initialization_Phase'Access); if Status /= Run_Resumed then |