Improve handling of non-sensitized processes.

8 files changed, 328 insertions, 223 deletions

diff --git a/translate/ghdldrv/ghdllocal.adb b/translate/ghdldrv/ghdllocal.adb
index 11da68399..15eebe3f2 100644
--- a/translate/ghdldrv/ghdllocal.adb
+++ b/translate/ghdldrv/ghdllocal.adb
@@ -223,7 +223,7 @@ package body Ghdllocal is
       if Prefix_Path = null then
          Prefix_Path := new String'(Default_Pathes.Prefix);
       else
-         -- assume the user has set the correct path, so do not insert 32
+         -- Assume the user has set the correct path, so do not insert 32.
          Flag_32bit := False;
       end if;
 
diff --git a/translate/grt/grt-processes.adb b/translate/grt/grt-processes.adb
index 058e8a57b..c620cf9c7 100644
--- a/translate/grt/grt-processes.adb
+++ b/translate/grt/grt-processes.adb
@@ -36,22 +36,25 @@ pragma Elaborate_All (Grt.Table);
 package body Grt.Processes is
    Last_Time : constant Std_Time := Std_Time'Last;
 
+   --  Identifier for a process.
+   type Process_Id is new Integer;
+
    --  Table of processes.
    package Process_Table is new Grt.Table
-     (Table_Component_Type => Process_Type,
+     (Table_Component_Type => Process_Acc,
       Table_Index_Type => Process_Id,
       Table_Low_Bound => 1,
       Table_Initial => 16);
 
    --  List of non_sensitized processes.
    package Non_Sensitized_Process_Table is new Grt.Table
-     (Table_Component_Type => Process_Id,
+     (Table_Component_Type => Process_Acc,
       Table_Index_Type => Natural,
       Table_Low_Bound => 1,
       Table_Initial => 2);
 
    --  List of processes to be resume at next cycle.
-   type Process_Id_Array is array (Natural range <>) of Process_Id;
+   type Process_Id_Array is array (Natural range <>) of Process_Acc;
    type Process_Id_Array_Acc is access Process_Id_Array;
 
    Resume_Process_Table : Process_Id_Array_Acc;
@@ -66,8 +69,9 @@ package body Grt.Processes is
    --  Number of resumed processes.
    Nbr_Resumed_Processes : Natural := 0;
 
-   procedure Free is new Ada.Unchecked_Deallocation
-     (Name => Sensitivity_Acc, Object => Sensitivity_El);
+   --  Earliest time out within processes.
+   Process_First_Timeout : Std_Time := Last_Time;
+   Process_Timeout_Chain : Process_Acc := null;
 
    procedure Init is
    begin
@@ -105,6 +109,7 @@ package body Grt.Processes is
       function To_Proc_Acc is new Ada.Unchecked_Conversion
         (Source => System.Address, Target => Proc_Acc);
       Stack : Stack_Type;
+      P : Process_Acc;
    begin
       if State /= State_Sensitized then
          Stack := Stack_Create (Proc, This);
@@ -114,22 +119,22 @@ package body Grt.Processes is
       else
          Stack := Null_Stack;
       end if;
-      Process_Table.Increment_Last;
-      Process_Table.Table (Process_Table.Last) :=
-        (Subprg => To_Proc_Acc (Proc),
-         This => This,
-         Rti => Ctxt,
-         Sensitivity => null,
-         Resumed => False,
-         Postponed => Postponed,
-         State => State,
-         Timeout => Bad_Time,
-         Stack => Stack);
+      P := new Process_Type'(Subprg => To_Proc_Acc (Proc),
+                             This => This,
+                             Rti => Ctxt,
+                             Sensitivity => null,
+                             Resumed => False,
+                             Postponed => Postponed,
+                             State => State,
+                             Timeout => Bad_Time,
+                             Timeout_Chain_Next => null,
+                             Timeout_Chain_Prev => null,
+                             Stack => Stack);
+      Process_Table.Append (P);
       --  Used to create drivers.
-      Set_Current_Process (Process_Table.Last, null);
-
+      Set_Current_Process (P);
       if State /= State_Sensitized then
-         Non_Sensitized_Process_Table.Append (Process_Table.Last);
+         Non_Sensitized_Process_Table.Append (P);
       end if;
       if Postponed then
          Nbr_Postponed_Processes := Nbr_Postponed_Processes + 1;
@@ -145,7 +150,7 @@ package body Grt.Processes is
       Addr : System.Address)
    is
    begin
-      Process_Register (Instance, Proc, (Addr, Ctxt), State_Timeout, False);
+      Process_Register (Instance, Proc, (Addr, Ctxt), State_Ready, False);
    end Ghdl_Process_Register;
 
    procedure Ghdl_Sensitized_Process_Register
@@ -165,7 +170,7 @@ package body Grt.Processes is
       Addr : System.Address)
    is
    begin
-      Process_Register (Instance, Proc, (Addr, Ctxt), State_Timeout, True);
+      Process_Register (Instance, Proc, (Addr, Ctxt), State_Ready, True);
    end Ghdl_Postponed_Process_Register;
 
    procedure Ghdl_Postponed_Sensitized_Process_Register
@@ -184,20 +189,22 @@ package body Grt.Processes is
    is
       function To_Proc_Acc is new Ada.Unchecked_Conversion
         (Source => System.Address, Target => Proc_Acc);
-   begin
-      Process_Table.Increment_Last;
-      Process_Table.Table (Process_Table.Last) :=
-        (Rti => Ctxt,
-         Sensitivity => null,
-         Resumed => False,
-         Postponed => False,
-         State => State_Sensitized,
-         Timeout => Bad_Time,
-         Subprg => To_Proc_Acc (Proc),
-         This => This,
-         Stack => Null_Stack);
+      P : Process_Acc;
+   begin
+      P := new Process_Type'(Rti => Ctxt,
+                             Sensitivity => null,
+                             Resumed => False,
+                             Postponed => False,
+                             State => State_Sensitized,
+                             Timeout => Bad_Time,
+                             Timeout_Chain_Next => null,
+                             Timeout_Chain_Prev => null,
+                             Subprg => To_Proc_Acc (Proc),
+                             This => This,
+                             Stack => Null_Stack);
+      Process_Table.Append (P);
       --  Used to create drivers.
-      Set_Current_Process (Process_Table.Last, null);
+      Set_Current_Process (P);
    end Verilog_Process_Register;
 
    procedure Ghdl_Initial_Register (Instance : System.Address;
@@ -217,16 +224,16 @@ package body Grt.Processes is
    procedure Ghdl_Process_Add_Sensitivity (Sig : Ghdl_Signal_Ptr)
    is
    begin
-      Resume_Process_If_Event (Sig, Process_Table.Last);
+      Resume_Process_If_Event
+        (Sig, Process_Table.Table (Process_Table.Last));
    end Ghdl_Process_Add_Sensitivity;
 
-   procedure Resume_Process (Proc : Process_Id)
+   procedure Resume_Process (Proc : Process_Acc)
    is
-      P : Process_Type renames Process_Table.Table (Proc);
    begin
-      if not P.Resumed then
-         P.Resumed := True;
-         if P.Postponed then
+      if not Proc.Resumed then
+         Proc.Resumed := True;
+         if Proc.Postponed then
             Last_Postponed_Resume_Process := Last_Postponed_Resume_Process + 1;
             Postponed_Resume_Process_Table (Last_Postponed_Resume_Process)
               := Proc;
@@ -260,26 +267,63 @@ package body Grt.Processes is
       Grt.Stack2.Release (Get_Stack2, Mark);
    end Ghdl_Stack2_Release;
 
-   function To_Acc is new Ada.Unchecked_Conversion
-     (Source => System.Address, Target => Process_Acc);
-
    procedure Ghdl_Process_Wait_Add_Sensitivity (Sig : Ghdl_Signal_Ptr)
    is
-      El : Sensitivity_Acc;
-   begin
-      El := new Sensitivity_El'(Sig => Sig,
-                                Next => Get_Current_Process.Sensitivity);
-      Get_Current_Process.Sensitivity := El;
+      Proc : constant Process_Acc := Get_Current_Process;
+      El : Action_List_Acc;
+   begin
+      El := new Action_List'(Dynamic => True,
+                             Next => Sig.Event_List,
+                             Proc => Proc,
+                             Prev => null,
+                             Sig => Sig,
+                             Chain => Proc.Sensitivity);
+      if Sig.Event_List /= null and then Sig.Event_List.Dynamic then
+         Sig.Event_List.Prev := El;
+      end if;
+      Sig.Event_List := El;
+      Proc.Sensitivity := El;
    end Ghdl_Process_Wait_Add_Sensitivity;
 
+   procedure Update_Process_First_Timeout (Proc : Process_Acc) is
+   begin
+      if Proc.Timeout < Process_First_Timeout then
+         Process_First_Timeout := Proc.Timeout;
+      end if;
+      Proc.Timeout_Chain_Next := Process_Timeout_Chain;
+      Proc.Timeout_Chain_Prev := null;
+      if Process_Timeout_Chain /= null then
+         Process_Timeout_Chain.Timeout_Chain_Prev := Proc;
+      end if;
+      Process_Timeout_Chain := Proc;
+   end Update_Process_First_Timeout;
+
+   procedure Remove_Process_From_Timeout_Chain (Proc : Process_Acc) is
+   begin
+      --  Remove Proc from the timeout list.
+      if Proc.Timeout_Chain_Prev /= null then
+         Proc.Timeout_Chain_Prev.Timeout_Chain_Next :=
+           Proc.Timeout_Chain_Next;
+      elsif Process_Timeout_Chain = Proc then
+         --  Only if Proc is in the chain.
+         Process_Timeout_Chain := Proc.Timeout_Chain_Next;
+      end if;
+      if Proc.Timeout_Chain_Next /= null then
+         Proc.Timeout_Chain_Next.Timeout_Chain_Prev :=
+           Proc.Timeout_Chain_Prev;
+      end if;
+   end Remove_Process_From_Timeout_Chain;
+
    procedure Ghdl_Process_Wait_Set_Timeout (Time : Std_Time)
    is
+      Proc : constant Process_Acc := Get_Current_Process;
    begin
       if Time < 0 then
          --  LRM93 8.1
          Error ("negative timeout clause");
       end if;
-      Get_Current_Process.Timeout := Current_Time + Time;
+      Proc.Timeout := Current_Time + Time;
+      Update_Process_First_Timeout (Proc);
    end Ghdl_Process_Wait_Set_Timeout;
 
    function Ghdl_Process_Wait_Suspend return Boolean
@@ -295,27 +339,75 @@ package body Grt.Processes is
 --          Cur_Proc.Timeout := Std_Time'Last;
 --       end if;
       Stack_Switch (Get_Main_Stack, Proc.Stack);
-      -- Note: in case of timeout, the timeout is removed when processis is
+      -- Note: in case of timeout, the timeout is removed when process is
       -- woken up.
       return Proc.State = State_Timeout;
    end Ghdl_Process_Wait_Suspend;
 
+   procedure Free is new Ada.Unchecked_Deallocation
+     (Action_List, Action_List_Acc);
+
    procedure Ghdl_Process_Wait_Close
    is
       Proc : constant Process_Acc := Get_Current_Process;
-      El : Sensitivity_Acc;
-      N_El : Sensitivity_Acc;
+      El : Action_List_Acc;
+      N_El : Action_List_Acc;
    begin
       --  Remove the sensitivity.
       El := Proc.Sensitivity;
       Proc.Sensitivity := null;
       while El /= null loop
-         N_El := El.Next;
+         pragma Assert (El.Proc = Get_Current_Process);
+         if El.Prev = null then
+            El.Sig.Event_List := El.Next;
+         else
+            pragma Assert (El.Prev.Dynamic);
+            El.Prev.Next := El.Next;
+         end if;
+         if El.Next /= null and then El.Next.Dynamic then
+            El.Next.Prev := El.Prev;
+         end if;
+         N_El := El.Chain;
          Free (El);
          El := N_El;
       end loop;
-      --  Remove the timeout.
-      Proc.Timeout := Bad_Time;
+
+      --  Remove Proc from the timeout list.
+      Remove_Process_From_Timeout_Chain (Proc);
+
+      --  This is necessary when the process has been woken-up by an event
+      --  before the timeout triggers.
+      if Process_First_Timeout = Proc.Timeout then
+         --  Remove the timeout.
+         Proc.Timeout := Bad_Time;
+
+         declare
+            Next_Timeout : Std_Time;
+            P : Process_Acc;
+         begin
+            Next_Timeout := Last_Time;
+            P := Process_Timeout_Chain;
+            while P /= null loop
+               case P.State is
+                  when State_Delayed
+                    | State_Wait =>
+                     if P.Timeout > 0
+                       and then P.Timeout < Next_Timeout
+                     then
+                        Next_Timeout := P.Timeout;
+                     end if;
+                  when others =>
+                     null;
+               end case;
+               P := P.Timeout_Chain_Next;
+            end loop;
+            Process_First_Timeout := Next_Timeout;
+         end;
+      else
+         --  Remove the timeout.
+         Proc.Timeout := Bad_Time;
+      end if;
+      Proc.State := State_Ready;
    end Ghdl_Process_Wait_Close;
 
    procedure Ghdl_Process_Wait_Exit
@@ -345,8 +437,13 @@ package body Grt.Processes is
       end if;
       Proc.Timeout := Current_Time + Time;
       Proc.State := State_Wait;
+      Update_Process_First_Timeout (Proc);
       --  Suspend this process.
       Stack_Switch (Get_Main_Stack, Proc.Stack);
+      --  Clean-up.
+      Proc.Timeout := Bad_Time;
+      Remove_Process_From_Timeout_Chain (Proc);
+      Proc.State := State_Ready;
    end Ghdl_Process_Wait_Timeout;
 
    --  Verilog.
@@ -356,6 +453,7 @@ package body Grt.Processes is
    begin
       Proc.Timeout := Current_Time + Std_Time (Del);
       Proc.State := State_Delayed;
+      Update_Process_First_Timeout (Proc);
    end Ghdl_Process_Delay;
 
    --  Protected object lock.
@@ -364,7 +462,7 @@ package body Grt.Processes is
    type Object_Lock is record
       --  The owner of the lock.
       --  Nul_Process_Id means the lock is free.
-      Process : Process_Id;
+      Process : Process_Acc;
       --  Number of times the lock has been acquired.
       Count : Natural;
    end record;
@@ -379,14 +477,14 @@ package body Grt.Processes is
    is
       Lock : constant Object_Lock_Acc := To_Lock_Acc_Acc (Obj).all;
    begin
-      if Lock.Process = Nul_Process_Id then
+      if Lock.Process = null then
          if Lock.Count /= 0 then
             Internal_Error ("protected_enter");
          end if;
-         Lock.Process := Get_Current_Process_Id;
+         Lock.Process := Get_Current_Process;
          Lock.Count := 1;
       else
-         if Lock.Process /= Get_Current_Process_Id then
+         if Lock.Process /= Get_Current_Process then
             Internal_Error ("protected_enter(2)");
          end if;
          Lock.Count := Lock.Count + 1;
@@ -397,7 +495,7 @@ package body Grt.Processes is
    is
       Lock : constant Object_Lock_Acc := To_Lock_Acc_Acc (Obj).all;
    begin
-      if Lock.Process /= Get_Current_Process_Id then
+      if Lock.Process /= Get_Current_Process then
          Internal_Error ("protected_leave(1)");
       end if;
 
@@ -406,7 +504,7 @@ package body Grt.Processes is
       end if;
       Lock.Count := Lock.Count - 1;
       if Lock.Count = 0 then
-         Lock.Process := Nul_Process_Id;
+         Lock.Process := null;
       end if;
    end Ghdl_Protected_Leave;
 
@@ -414,8 +512,7 @@ package body Grt.Processes is
    is
       Lock : constant Object_Lock_Acc_Acc := To_Lock_Acc_Acc (Obj);
    begin
-      Lock.all := new Object_Lock'(Process => Nul_Process_Id,
-                                   Count => 0);
+      Lock.all := new Object_Lock'(Process => null, Count => 0);
    end Ghdl_Protected_Init;
 
    procedure Ghdl_Protected_Fini (Obj : System.Address)
@@ -425,7 +522,7 @@ package body Grt.Processes is
 
       Lock : constant Object_Lock_Acc_Acc := To_Lock_Acc_Acc (Obj);
    begin
-      if Lock.all.Count /= 0 or Lock.all.Process /= Nul_Process_Id then
+      if Lock.all.Count /= 0 or Lock.all.Process /= null then
          Internal_Error ("protected_fini");
       end if;
       Deallocate (Lock.all);
@@ -448,40 +545,63 @@ package body Grt.Processes is
       end if;
 
       --     3) The next time at which a process resumes.
-      for I in Non_Sensitized_Process_Table.First ..
-        Non_Sensitized_Process_Table.Last
-      loop
-         declare
-            Pid : constant Process_Id :=
-              Non_Sensitized_Process_Table.Table (I);
-            Proc : Process_Type renames Process_Table.Table (Pid);
-         begin
-            if Proc.State = State_Wait
-              and then Proc.Timeout < Res
-              and then Proc.Timeout >= 0
-            then
-               --  No signals to be updated.
-               Grt.Signals.Flush_Active_List;
-
-               if Proc.Timeout = Current_Time then
-                  --  Can't be better.
-                  return Current_Time;
-               else
-                  Res := Proc.Timeout;
-               end if;
-            end if;
-         end;
-      end loop;
+      if Process_First_Timeout < Res then
+         --  No signals to be updated.
+         Grt.Signals.Flush_Active_List;
+
+         Res := Process_First_Timeout;
+      end if;
 
       return Res;
    end Compute_Next_Time;
 
-   procedure Disp_Process_Name (Stream : Grt.Stdio.FILEs; Proc : Process_Id)
+   procedure Disp_Process_Name (Stream : Grt.Stdio.FILEs; Proc : Process_Acc)
    is
    begin
-      Grt.Rtis_Utils.Put (Stream, Process_Table.Table (Proc).Rti);
+      Grt.Rtis_Utils.Put (Stream, Proc.Rti);
    end Disp_Process_Name;
 
+   procedure Disp_All_Processes
+   is
+      use Grt.Stdio;
+      use Grt.Astdio;
+   begin
+      for I in Process_Table.First .. Process_Table.Last loop
+         declare
+            Proc : constant Process_Acc := Process_Table.Table (I);
+         begin
+            Disp_Process_Name (stdout, Proc);
+            New_Line (stdout);
+            Put (stdout, "  State: ");
+            case Proc.State is
+               when State_Sensitized =>
+                  Put (stdout, "sensitized");
+               when State_Wait =>
+                  Put (stdout, "wait");
+                  if Proc.Timeout /= Bad_Time then
+                     Put (stdout, " until ");
+                     Put_Time (stdout, Proc.Timeout);
+                  end if;
+               when State_Ready =>
+                  Put (stdout, "ready");
+               when State_Timeout =>
+                  Put (stdout, "timeout");
+               when State_Delayed =>
+                  Put (stdout, "delayed");
+               when State_Dead =>
+                  Put (stdout, "dead");
+            end case;
+--              Put (stdout, ": time: ");
+--              Put_U64 (stdout, Proc.Stats_Time);
+--              Put (stdout, ", runs: ");
+--              Put_U32 (stdout, Proc.Stats_Run);
+            New_Line (stdout);
+         end;
+      end loop;
+   end Disp_All_Processes;
+
+   pragma Unreferenced (Disp_All_Processes);
+
    type Run_Handler is access function return Integer;
    --  pragma Convention (C, Run_Handler);
 
@@ -507,7 +627,7 @@ package body Grt.Processes is
 
    procedure Run_Processes_Threads
    is
-      Pid : Process_Id;
+      Proc : Process_Acc;
       Idx : Natural;
    begin
       loop
@@ -516,35 +636,30 @@ package body Grt.Processes is
          if Idx > Mt_Last then
             return;
          end if;
-         Pid := Mt_Table (Idx);
-
-         declare
-            Proc : Process_Type renames Process_Table.Table (Pid);
-         begin
-            if Grt.Options.Trace_Processes then
-               Grt.Astdio.Put ("run process ");
-               Disp_Process_Name (Stdio.stdout, Pid);
-               Grt.Astdio.Put (" [");
-               Grt.Astdio.Put (Stdio.stdout, Proc.This);
-               Grt.Astdio.Put ("]");
-               Grt.Astdio.New_Line;
-            end if;
-            if not Proc.Resumed then
-               Internal_Error ("run non-resumed process");
-            end if;
-            Proc.Resumed := False;
-            Set_Current_Process
-              (Pid, To_Acc (Process_Table.Table (Pid)'Address));
-            if Proc.State = State_Sensitized then
-               Proc.Subprg.all (Proc.This);
-            else
-               Stack_Switch (Proc.Stack, Get_Main_Stack);
-            end if;
-            if Grt.Options.Checks then
-               Ghdl_Signal_Internal_Checks;
-               Grt.Stack2.Check_Empty (Get_Stack2);
-            end if;
-         end;
+         Proc := Mt_Table (Idx);
+
+         if Grt.Options.Trace_Processes then
+            Grt.Astdio.Put ("run process ");
+            Disp_Process_Name (Stdio.stdout, Proc);
+            Grt.Astdio.Put (" [");
+            Grt.Astdio.Put (Stdio.stdout, Proc.This);
+            Grt.Astdio.Put ("]");
+            Grt.Astdio.New_Line;
+         end if;
+         if not Proc.Resumed then
+            Internal_Error ("run non-resumed process");
+         end if;
+         Proc.Resumed := False;
+         Set_Current_Process (Proc);
+         if Proc.State = State_Sensitized then
+            Proc.Subprg.all (Proc.This);
+         else
+            Stack_Switch (Proc.Stack, Get_Main_Stack);
+         end if;
+         if Grt.Options.Checks then
+            Ghdl_Signal_Internal_Checks;
+            Grt.Stack2.Check_Empty (Get_Stack2);
+         end if;
       end loop;
    end Run_Processes_Threads;
 
@@ -571,15 +686,14 @@ package body Grt.Processes is
       if Options.Nbr_Threads = 1 then
          for I in 1 .. Last loop
             declare
-               Pid : constant Process_Id := Table (I);
-               Proc : Process_Type renames Process_Table.Table (Pid);
+               Proc : constant Process_Acc := Table (I);
             begin
                if not Proc.Resumed then
                   Internal_Error ("run non-resumed process");
                end if;
                if Grt.Options.Trace_Processes then
                   Grt.Astdio.Put ("run process ");
-                  Disp_Process_Name (Stdio.stdout, Pid);
+                  Disp_Process_Name (Stdio.stdout, Proc);
                   Grt.Astdio.Put (" [");
                   Grt.Astdio.Put (Stdio.stdout, Proc.This);
                   Grt.Astdio.Put ("]");
@@ -587,8 +701,7 @@ package body Grt.Processes is
                end if;
 
                Proc.Resumed := False;
-               Set_Current_Process
-                 (Pid, To_Acc (Process_Table.Table (Pid)'Address));
+               Set_Current_Process (Proc);
                if Proc.State = State_Sensitized then
                   Proc.Subprg.all (Proc.This);
                else
@@ -642,7 +755,7 @@ package body Grt.Processes is
       null;
 
       for I in Process_Table.First .. Process_Table.Last loop
-         Resume_Process (I);
+         Resume_Process (Process_Table.Table (I));
       end loop;
 
       --  - Each nonpostponed process in the model is executed until it
@@ -697,47 +810,43 @@ package body Grt.Processes is
       --  d) For each process P, if P is currently sensitive to a signal S and
       --     if an event has occured on S in this simulation cycle, then P
       --     resumes.
-      for I in Non_Sensitized_Process_Table.First ..
-        Non_Sensitized_Process_Table.Last
-      loop
+      if Current_Time = Process_First_Timeout then
+         Tn := Last_Time;
          declare
-            Pid : constant Process_Id :=
-              Non_Sensitized_Process_Table.Table (I);
-            Proc : Process_Type renames Process_Table.Table (Pid);
-            El : Sensitivity_Acc;
+            Proc : Process_Acc;
          begin
-            case Proc.State is
-               when State_Sensitized =>
-                  null;
-               when State_Delayed =>
-                  if Proc.Timeout = Current_Time then
-                     Proc.Timeout := Bad_Time;
-                     Resume_Process (Pid);
-                     Proc.State := State_Sensitized;
-                  end if;
-               when State_Wait =>
-                  if Proc.Timeout = Current_Time then
-                     Proc.Timeout := Bad_Time;
-                     Resume_Process (Pid);
-                     Proc.State := State_Timeout;
-                  else
-                     El := Proc.Sensitivity;
-                     while El /= null loop
-                        if El.Sig.Event then
-                           Resume_Process (Pid);
-                           exit;
-                        else
-                           El := El.Next;
-                        end if;
-                     end loop;
-                  end if;
-               when State_Timeout =>
-                  Internal_Error ("process in timeout");
-               when State_Dead =>
-                  null;
-            end case;
+            Proc := Process_Timeout_Chain;
+            while Proc /= null loop
+               case Proc.State is
+                  when State_Sensitized =>
+                     null;
+                  when State_Delayed =>
+                     if Proc.Timeout = Current_Time then
+                        Proc.Timeout := Bad_Time;
+                        Resume_Process (Proc);
+                        Proc.State := State_Sensitized;
+                     elsif Proc.Timeout > 0 and then Proc.Timeout < Tn then
+                        Tn := Proc.Timeout;
+                     end if;
+                  when State_Wait =>
+                     if Proc.Timeout = Current_Time then
+                        Proc.Timeout := Bad_Time;
+                        Resume_Process (Proc);
+                        Proc.State := State_Timeout;
+                     elsif Proc.Timeout > 0 and then Proc.Timeout < Tn then
+                        Tn := Proc.Timeout;
+                     end if;
+                  when State_Timeout
+                    | State_Ready =>
+                     Internal_Error ("process in timeout");
+                  when State_Dead =>
+                     null;
+               end case;
+               Proc := Proc.Timeout_Chain_Next;
+            end loop;
          end;
-      end loop;
+         Process_First_Timeout := Tn;
+      end if;
 
       --  e) Each nonpostponed that has resumed in the current simulation cycle
       --     is executed until it suspends.
diff --git a/translate/grt/grt-processes.ads b/translate/grt/grt-processes.ads
index a3a2cf0d3..22d7071df 100644
--- a/translate/grt/grt-processes.ads
+++ b/translate/grt/grt-processes.ads
@@ -42,6 +42,9 @@ package Grt.Processes is
    --  If true, the simulation should be stopped.
    Break_Simulation : Boolean;
 
+   type Process_Type is private;
+   --  type Process_Acc is access all Process_Type;
+
    --  Return the identifier of the current process.
    --  During the elaboration, this is the identifier of the last process
    --  being elaborated.  So, this function can be used to create signal
@@ -56,7 +59,7 @@ package Grt.Processes is
    function Get_Nbr_Resumed_Processes return Natural;
 
    --  Disp the name of process PROC.
-   procedure Disp_Process_Name (Stream : Grt.Stdio.FILEs; Proc : Process_Id);
+   procedure Disp_Process_Name (Stream : Grt.Stdio.FILEs; Proc : Process_Acc);
 
    --  Register a process during elaboration.
    --  This procedure is called by vhdl elaboration code.
@@ -88,7 +91,7 @@ package Grt.Processes is
    procedure Ghdl_Process_Add_Sensitivity (Sig : Ghdl_Signal_Ptr);
 
    --  Resume a process.
-   procedure Resume_Process (Proc : Process_Id);
+   procedure Resume_Process (Proc : Process_Acc);
 
    --  Wait without timeout or sensitivity.
    procedure Ghdl_Process_Wait_Exit;
@@ -118,26 +121,19 @@ package Grt.Processes is
    procedure Ghdl_Protected_Init (Obj : System.Address);
    procedure Ghdl_Protected_Fini (Obj : System.Address);
 
-   type Process_Type is private;
-   type Process_Acc is access all Process_Type;
 private
-      --  Access to a process subprogram.
+   --  Access to a process subprogram.
    type Proc_Acc is access procedure (Self : System.Address);
 
-   --  Simply linked list for sensitivity.
-   type Sensitivity_El;
-   type Sensitivity_Acc is access Sensitivity_El;
-   type Sensitivity_El is record
-      Sig : Ghdl_Signal_Ptr;
-      Next : Sensitivity_Acc;
-   end record;
-
    --  State of a process.
    type Process_State is
      (
       --  Sensitized process.  Its state cannot change.
       State_Sensitized,
 
+      --  Non-sensitized process, ready to run.
+      State_Ready,
+
       --  Verilog process, being suspended.
       State_Delayed,
 
@@ -178,8 +174,11 @@ private
       --  Timeout value for wait.
       Timeout : Std_Time;
 
-      --  Sensitivity list.
-      Sensitivity : Sensitivity_Acc;
+      --  Sensitivity list while the (non-sensitized) process is waiting.
+      Sensitivity : Action_List_Acc;
+
+      Timeout_Chain_Next : Process_Acc;
+      Timeout_Chain_Prev : Process_Acc;
    end record;
 
    pragma Export (C, Ghdl_Process_Register,
diff --git a/translate/grt/grt-signals.adb b/translate/grt/grt-signals.adb
index 1cdd1b58f..bbbc7368b 100644
--- a/translate/grt/grt-signals.adb
+++ b/translate/grt/grt-signals.adb
@@ -266,9 +266,9 @@ package body Grt.Signals is
                         / System.Storage_Unit);
       end Size;
 
-      Id : Process_Id;
+      Proc : Process_Acc;
    begin
-      Id := Get_Current_Process_Id;
+      Proc := Get_Current_Process;
       if Sign.S.Nbr_Drivers = 0 then
          Check_New_Source (Sign);
          Sign.S.Drivers := Malloc (Size (1));
@@ -276,7 +276,7 @@ package body Grt.Signals is
       else
          -- Do not create a driver twice.
          for I in 0 .. Sign.S.Nbr_Drivers - 1 loop
-            if Sign.S.Drivers (I).Proc = Id then
+            if Sign.S.Drivers (I).Proc = Proc then
                return True;
             end if;
          end loop;
@@ -287,7 +287,7 @@ package body Grt.Signals is
       Sign.S.Drivers (Sign.S.Nbr_Drivers - 1) :=
         (First_Trans => Trans,
          Last_Trans => Trans,
-         Proc => Id);
+         Proc => Proc);
       return False;
    end Ghdl_Signal_Add_Driver;
 
@@ -444,14 +444,14 @@ package body Grt.Signals is
 
    function Find_Driver (Sig : Ghdl_Signal_Ptr) return Ghdl_Index_Type
    is
-      Id : Process_Id;
+      Proc : Process_Acc;
    begin
       if Sig.S.Drivers = null then
          Error ("assignment to a signal without any driver");
       end if;
-      Id := Get_Current_Process_Id;
+      Proc := Get_Current_Process;
       for I in 0 .. Sig.S.Nbr_Drivers - 1 loop
-         if Sig.S.Drivers (I).Proc = Id then
+         if Sig.S.Drivers (I).Proc = Proc then
             return I;
          end if;
       end loop;
@@ -460,14 +460,14 @@ package body Grt.Signals is
 
    function Get_Driver (Sig : Ghdl_Signal_Ptr) return Driver_Acc
    is
-      Id : Process_Id;
+      Proc : Process_Acc;
    begin
       if Sig.S.Drivers = null then
          return null;
       end if;
-      Id := Get_Current_Process_Id;
+      Proc := Get_Current_Process;
       for I in 0 .. Sig.S.Nbr_Drivers - 1 loop
-         if Sig.S.Drivers (I).Proc = Id then
+         if Sig.S.Drivers (I).Proc = Proc then
             return Sig.S.Drivers (I)'Access;
          end if;
       end loop;
@@ -1815,11 +1815,11 @@ package body Grt.Signals is
    end Call_Conversion_Function;
 
    procedure Resume_Process_If_Event
-     (Sig : Ghdl_Signal_Ptr; Proc : Process_Id)
+     (Sig : Ghdl_Signal_Ptr; Proc : Process_Acc)
    is
       El : Action_List_Acc;
    begin
-      El := new Action_List'(Kind => Action_Process,
+      El := new Action_List'(Dynamic => False,
                              Proc => Proc,
                              Next => Sig.Event_List);
       Sig.Event_List := El;
@@ -2745,12 +2745,7 @@ package body Grt.Signals is
 
          El := Sig.Event_List;
          while El /= null loop
-            case El.Kind is
-               when Action_Process =>
-                  Resume_Process (El.Proc);
-               when Action_Signal =>
-                  Internal_Error ("set_effective_value");
-            end case;
+            Resume_Process (El.Proc);
             El := El.Next;
          end loop;
       end if;
diff --git a/translate/grt/grt-signals.ads b/translate/grt/grt-signals.ads
index d16e88716..2ada098e0 100644
--- a/translate/grt/grt-signals.ads
+++ b/translate/grt/grt-signals.ads
@@ -20,6 +20,7 @@ with Ada.Unchecked_Conversion;
 with Grt.Table;
 with Grt.Types; use Grt.Types;
 with Grt.Rtis; use Grt.Rtis;
+limited with Grt.Processes;
 pragma Elaborate_All (Grt.Table);
 
 package Grt.Signals is
@@ -59,12 +60,14 @@ package Grt.Signals is
       end case;
    end record;
 
+   type Process_Acc is access Grt.Processes.Process_Type;
+
    --  A driver is bound to a process (PROC) and contains a list of
    --  transactions.
    type Driver_Type is record
       First_Trans : Transaction_Acc;
       Last_Trans : Transaction_Acc;
-      Proc : Process_Id;
+      Proc : Process_Acc;
    end record;
 
    type Driver_Acc is access all Driver_Type;
@@ -89,19 +92,33 @@ package Grt.Signals is
    function To_Signal_Arr_Ptr is new Ada.Unchecked_Conversion
      (Source => System.Address, Target => Signal_Arr_Ptr);
 
+   --  List of processes to wake-up in case of event on the signal.
    type Action_List;
    type Action_List_Acc is access Action_List;
-   type Action_Kind is (Action_Signal, Action_Process);
-   type Action_List (Kind : Action_Kind) is record
+
+   type Action_List (Dynamic : Boolean) is record
+      --  Next action for the current signal.
       Next : Action_List_Acc;
-      case Kind is
-         when Action_Signal =>
+
+      --  Process to wake-up.
+      Proc : Process_Acc;
+
+      case Dynamic is
+         when True =>
+            --  For a non-sensitized process.
+            --  Previous action (to speed-up remove from the chain).
+            Prev : Action_List_Acc;
+
             Sig : Ghdl_Signal_Ptr;
-         when Action_Process =>
-            Proc : Process_Id;
+
+            --  Chain of signals for the process.
+            Chain : Action_List_Acc;
+         when False =>
+            null;
       end case;
    end record;
 
+
    --  How to compute resolved signal.
    type Resolved_Signal_Type is record
       Resolv_Proc : System.Address;
@@ -408,7 +425,7 @@ package Grt.Signals is
    --  Add PROC in the list of processes to be resumed in case of event on
    --  SIG.
    procedure Resume_Process_If_Event
-     (Sig : Ghdl_Signal_Ptr; Proc : Process_Id);
+     (Sig : Ghdl_Signal_Ptr; Proc : Process_Acc);
 
    procedure Ghdl_Signal_Name_Rti (Sig : Ghdl_Rti_Access;
                                    Ctxt : Ghdl_Rti_Access;
diff --git a/translate/grt/grt-types.ads b/translate/grt/grt-types.ads
index 6fd0bb616..a132c6a5b 100644
--- a/translate/grt/grt-types.ads
+++ b/translate/grt/grt-types.ads
@@ -139,10 +139,6 @@ package Grt.Types is
    end record;
    type Ghdl_Location_Ptr is access Ghdl_Location;
 
-   --  Identifier for a process.
-   type Process_Id is new Integer;
-   Nul_Process_Id : constant Process_Id := 0;
-
    --  Signal index.
    type Sig_Table_Index is new Integer;
 
diff --git a/translate/grt/grt-unithread.adb b/translate/grt/grt-unithread.adb
index 3197e2cce..b3809c382 100644
--- a/translate/grt/grt-unithread.adb
+++ b/translate/grt/grt-unithread.adb
@@ -52,7 +52,6 @@ package body Grt.Unithread is
    end Atomic_Inc;
 
    Current_Process : Process_Acc;
-   Current_Process_Id : Process_Id;
 
    --  Called by linux.c
    function Grt_Get_Current_Process return Process_Acc;
@@ -64,10 +63,9 @@ package body Grt.Unithread is
    end Grt_Get_Current_Process;
 
 
-   procedure Set_Current_Process (Id : Process_Id; Proc : Process_Acc) is
+   procedure Set_Current_Process (Proc : Process_Acc) is
    begin
       Current_Process := Proc;
-      Current_Process_Id := Id;
    end Set_Current_Process;
 
    function Get_Current_Process return Process_Acc is
@@ -75,11 +73,6 @@ package body Grt.Unithread is
       return Current_Process;
    end Get_Current_Process;
 
-   function Get_Current_Process_Id return Process_Id is
-   begin
-      return Current_Process_Id;
-   end Get_Current_Process_Id;
-
    Stack2 : Stack2_Ptr;
 
    function Get_Stack2 return Stack2_Ptr is
diff --git a/translate/grt/grt-unithread.ads b/translate/grt/grt-unithread.ads
index 0f8f48a23..b54991fe1 100644
--- a/translate/grt/grt-unithread.ads
+++ b/translate/grt/grt-unithread.ads
@@ -20,8 +20,6 @@ pragma Unreferenced (System.Storage_Elements);
 with Grt.Signals; use Grt.Signals;
 with Grt.Stack2; use Grt.Stack2;
 with Grt.Stacks; use Grt.Stacks;
-with Grt.Types; use Grt.Types;
-with Grt.Processes; use Grt.Processes;
 
 package Grt.Unithread is
    procedure Init;
@@ -38,9 +36,8 @@ package Grt.Unithread is
    function Atomic_Inc (Val : access Natural) return Natural;
 
    --  Set and get the current process being executed by the thread.
-   procedure Set_Current_Process (Id : Process_Id; Proc : Process_Acc);
+   procedure Set_Current_Process (Proc : Process_Acc);
    function Get_Current_Process return Process_Acc;
-   function Get_Current_Process_Id return Process_Id;
 
    --  The secondary stack for the thread.
    function Get_Stack2 return Stack2_Ptr;
@@ -62,6 +59,5 @@ private
 
    pragma Inline (Set_Current_Process);
    pragma Inline (Get_Current_Process);
-   pragma Inline (Get_Current_Process_Id);
 
 end Grt.Unithread;