Add one_stack setup, add comments.

4 files changed, 103 insertions, 46 deletions

diff --git a/translate/grt/grt-processes.adb b/translate/grt/grt-processes.adb
index 50d760129..6b5a3934d 100644
--- a/translate/grt/grt-processes.adb
+++ b/translate/grt/grt-processes.adb
@@ -123,7 +123,7 @@ package body Grt.Processes is
       Stack : Stack_Type;
       P : Process_Acc;
    begin
-      if State /= State_Sensitized then
+      if State /= State_Sensitized and then not One_Stack then
          Stack := Stack_Create (Proc, This);
          if Stack = Null_Stack then
             Internal_Error ("cannot allocate stack: memory exhausted");
@@ -352,7 +352,16 @@ package body Grt.Processes is
       Update_Process_First_Timeout (Proc);
    end Ghdl_Process_Wait_Set_Timeout;
 
-   function Ghdl_Process_Wait_Suspend return Boolean
+   function Ghdl_Process_Wait_Has_Timeout return Boolean
+   is
+      Proc : constant Process_Acc := Get_Current_Process;
+   begin
+      -- Note: in case of timeout, the timeout is removed when process is
+      -- woken up.
+      return Proc.State = State_Timeout;
+   end Ghdl_Process_Wait_Has_Timeout;
+
+   procedure Ghdl_Process_Wait_Wait
    is
       Proc : constant Process_Acc := Get_Current_Process;
    begin
@@ -364,10 +373,19 @@ package body Grt.Processes is
 --       if Cur_Proc.Timeout = Bad_Time then
 --          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 process is
-      -- woken up.
-      return Proc.State = State_Timeout;
+   end Ghdl_Process_Wait_Wait;
+
+   function Ghdl_Process_Wait_Suspend return Boolean
+   is
+      Proc : constant Process_Acc := Get_Current_Process;
+   begin
+      Ghdl_Process_Wait_Wait;
+      if One_Stack then
+         Internal_Error ("wait_suspend");
+      else
+         Stack_Switch (Get_Main_Stack, Proc.Stack);
+      end if;
+      return Ghdl_Process_Wait_Has_Timeout;
    end Ghdl_Process_Wait_Suspend;
 
    procedure Free is new Ada.Unchecked_Deallocation
@@ -446,8 +464,11 @@ package body Grt.Processes is
       --  Mark this process as dead, in order to kill it.
       --  It cannot be killed now, since this code is still in the process.
       Proc.State := State_Dead;
+
       --  Suspend this process.
-      Stack_Switch (Get_Main_Stack, Proc.Stack);
+      if not One_Stack then
+         Stack_Switch (Get_Main_Stack, Proc.Stack);
+      end if;
    end Ghdl_Process_Wait_Exit;
 
    procedure Ghdl_Process_Wait_Timeout (Time : Std_Time)
@@ -465,7 +486,11 @@ package body Grt.Processes is
       Proc.State := State_Wait;
       Update_Process_First_Timeout (Proc);
       --  Suspend this process.
-      Stack_Switch (Get_Main_Stack, Proc.Stack);
+      if One_Stack then
+         Internal_Error ("wait_timeout");
+      else
+         Stack_Switch (Get_Main_Stack, Proc.Stack);
+      end if;
       --  Clean-up.
       Proc.Timeout := Bad_Time;
       Remove_Process_From_Timeout_Chain (Proc);
@@ -671,7 +696,7 @@ package body Grt.Processes is
          end if;
          Proc.Resumed := False;
          Set_Current_Process (Proc);
-         if Proc.State = State_Sensitized then
+         if Proc.State = State_Sensitized or else One_Stack then
             Proc.Subprg.all (Proc.This);
          else
             Stack_Switch (Proc.Stack, Get_Main_Stack);
@@ -722,7 +747,7 @@ package body Grt.Processes is
 
                Proc.Resumed := False;
                Set_Current_Process (Proc);
-               if Proc.State = State_Sensitized then
+               if Proc.State = State_Sensitized or else One_Stack then
                   Proc.Subprg.all (Proc.This);
                else
                   Stack_Switch (Proc.Stack, Get_Main_Stack);
diff --git a/translate/grt/grt-processes.ads b/translate/grt/grt-processes.ads
index 55662335e..22326eb5e 100644
--- a/translate/grt/grt-processes.ads
+++ b/translate/grt/grt-processes.ads
@@ -49,6 +49,10 @@ package Grt.Processes is
    --  If true, the simulation should be stopped.
    Break_Simulation : Boolean;
 
+   --  If true, there is one stack for all processes.  Non-sensitized
+   --  processes must save their state.
+   One_Stack : Boolean := False;
+
    type Process_Type is private;
    --  type Process_Acc is access all Process_Type;
 
@@ -104,20 +108,34 @@ package Grt.Processes is
    --  Resume a process.
    procedure Resume_Process (Proc : Process_Acc);
 
-   --  Wait without timeout or sensitivity.
+   --  Wait without timeout or sensitivity: wait;
    procedure Ghdl_Process_Wait_Exit;
-   --  Wait for a timeout.
+   --  Wait for a timeout (without sensitivity): wait for X;
    procedure Ghdl_Process_Wait_Timeout (Time : Std_Time);
-   --  Add a sensitivity for a wait.
-   procedure Ghdl_Process_Wait_Add_Sensitivity (Sig : Ghdl_Signal_Ptr);
+
+   --  Full wait statement:
+   --  1. Call Ghdl_Process_Wait_Set_Timeout (if there is a timeout)
+   --  2. Call Ghdl_Process_Wait_Add_Sensitivity (for each signal)
+   --  3. Call Ghdl_Process_Wait_Suspend, go to 4 if it returns true (timeout)
+   --     Evaluate the condition and go to 4 if true
+   --     Else, restart 3
+   --  4. Call Ghdl_Process_Wait_Close
+
    --  Add a timeout for a wait.
    procedure Ghdl_Process_Wait_Set_Timeout (Time : Std_Time);
+   --  Add a sensitivity for a wait.
+   procedure Ghdl_Process_Wait_Add_Sensitivity (Sig : Ghdl_Signal_Ptr);
    --  Wait until timeout or sensitivity.
    --  Return TRUE in case of timeout.
    function Ghdl_Process_Wait_Suspend return Boolean;
    --  Finish a wait statement.
    procedure Ghdl_Process_Wait_Close;
 
+   --  For one stack setups, wait_suspend is decomposed into the suspension
+   --  procedure and the function to get resume status.
+   procedure Ghdl_Process_Wait_Wait;
+   function Ghdl_Process_Wait_Has_Timeout return Boolean;
+
    --  Verilog.
    procedure Ghdl_Process_Delay (Del : Ghdl_U32);
 
diff --git a/translate/grt/grt-rtis.ads b/translate/grt/grt-rtis.ads
index 414c77a8d..924b2e0d1 100644
--- a/translate/grt/grt-rtis.ads
+++ b/translate/grt/grt-rtis.ads
@@ -169,6 +169,7 @@ package Grt.Rtis is
    Ghdl_Rti_Signal_Mode_In      : constant Ghdl_Rti_U8 := 5;
 
    Ghdl_Rti_Signal_Kind_Mask     : constant Ghdl_Rti_U8 := 3 * 16;
+   Ghdl_Rti_Signal_Kind_Offset   : constant Ghdl_Rti_U8 := 1 * 16;
    Ghdl_Rti_Signal_Kind_No       : constant Ghdl_Rti_U8 := 0 * 16;
    Ghdl_Rti_Signal_Kind_Register : constant Ghdl_Rti_U8 := 1 * 16;
    Ghdl_Rti_Signal_Kind_Bus      : constant Ghdl_Rti_U8 := 2 * 16;
diff --git a/translate/grt/grt-signals.ads b/translate/grt/grt-signals.ads
index cc6733d52..4d24639fc 100644
--- a/translate/grt/grt-signals.ads
+++ b/translate/grt/grt-signals.ads
@@ -439,18 +439,36 @@ package Grt.Signals is
    procedure Resume_Process_If_Event
      (Sig : Ghdl_Signal_Ptr; Proc : Process_Acc);
 
+   --  Creating a signal:
+   --  1) call Ghdl_Signal_Name_Rti (CTXT and ADDR are unused) to register
+   --     the RTI for the whole signal (in particular the mode and the
+   --     has_active flag)
+   --  2) call Ghdl_Create_Signal_XXX for each non-composite element
+
    procedure Ghdl_Signal_Name_Rti (Sig : Ghdl_Rti_Access;
                                    Ctxt : Ghdl_Rti_Access;
                                    Addr : System.Address);
 
+   --  FIXME: document.
    procedure Ghdl_Signal_Merge_Rti (Sig : Ghdl_Signal_Ptr;
                                     Rti : Ghdl_Rti_Access);
 
+   --  Assigning a waveform to a signal:
+   --
+   --  For simple waveform (sig <= val), the short form can be used:
+   --    Ghdl_Signal_Simple_Assign_XX (Sig, Val);
+   --  For all other forms
+   --  SIG <= reject R inertial V1 after T1, V2 after T2, ...:
+   --    Ghdl_Signal_Start_Assign_XX (SIG, R, V1, T1);
+   --    Ghdl_Signal_Next_Assign_XX (SIG, V2, T2);
+   --    ...
+   --  If the delay mechanism is transport, they R = 0,
+   --  if there is no rejection time, the mechanism is internal and R = T1.
+
    --  Performs some internal checks on signals (transaction order).
    --  Internal_error is called in case of error.
    procedure Ghdl_Signal_Internal_Checks;
 
-   --  Subprograms to be called by generated code.
    procedure Ghdl_Signal_Simple_Assign_Error (Sign : Ghdl_Signal_Ptr;
                                               File : Ghdl_C_String;
                                               Line : Ghdl_I32);
@@ -475,11 +493,10 @@ package Grt.Signals is
 
    function Ghdl_Signal_Driving (Sig : Ghdl_Signal_Ptr) return Ghdl_B2;
 
-   function Ghdl_Create_Signal_B2
-     (Init_Val : Ghdl_B2;
-      Resolv_Func : System.Address;
-      Resolv_Inst : System.Address)
-     return Ghdl_Signal_Ptr;
+   function Ghdl_Create_Signal_B2 (Init_Val : Ghdl_B2;
+                                   Resolv_Func : System.Address;
+                                   Resolv_Inst : System.Address)
+                                  return Ghdl_Signal_Ptr;
    procedure Ghdl_Signal_Init_B2 (Sig : Ghdl_Signal_Ptr; Init_Val : Ghdl_B2);
    procedure Ghdl_Signal_Associate_B2 (Sig : Ghdl_Signal_Ptr; Val : Ghdl_B2);
    procedure Ghdl_Signal_Simple_Assign_B2 (Sign : Ghdl_Signal_Ptr;
@@ -494,11 +511,10 @@ package Grt.Signals is
    function Ghdl_Signal_Driving_Value_B2 (Sig : Ghdl_Signal_Ptr)
                                          return Ghdl_B2;
 
-   function Ghdl_Create_Signal_E8
-     (Init_Val : Ghdl_E8;
-      Resolv_Func : System.Address;
-      Resolv_Inst : System.Address)
-     return Ghdl_Signal_Ptr;
+   function Ghdl_Create_Signal_E8 (Init_Val : Ghdl_E8;
+                                   Resolv_Func : System.Address;
+                                   Resolv_Inst : System.Address)
+                                  return Ghdl_Signal_Ptr;
    procedure Ghdl_Signal_Init_E8 (Sig : Ghdl_Signal_Ptr; Init_Val : Ghdl_E8);
    procedure Ghdl_Signal_Associate_E8 (Sig : Ghdl_Signal_Ptr; Val : Ghdl_E8);
    procedure Ghdl_Signal_Simple_Assign_E8 (Sign : Ghdl_Signal_Ptr;
@@ -513,11 +529,10 @@ package Grt.Signals is
    function Ghdl_Signal_Driving_Value_E8 (Sig : Ghdl_Signal_Ptr)
                                          return Ghdl_E8;
 
-   function Ghdl_Create_Signal_E32
-     (Init_Val : Ghdl_E32;
-      Resolv_Func : System.Address;
-      Resolv_Inst : System.Address)
-     return Ghdl_Signal_Ptr;
+   function Ghdl_Create_Signal_E32 (Init_Val : Ghdl_E32;
+                                    Resolv_Func : System.Address;
+                                    Resolv_Inst : System.Address)
+                                   return Ghdl_Signal_Ptr;
    procedure Ghdl_Signal_Init_E32 (Sig : Ghdl_Signal_Ptr; Init_Val : Ghdl_E32);
    procedure Ghdl_Signal_Associate_E32 (Sig : Ghdl_Signal_Ptr; Val : Ghdl_E32);
    procedure Ghdl_Signal_Simple_Assign_E32 (Sign : Ghdl_Signal_Ptr;
@@ -532,11 +547,10 @@ package Grt.Signals is
    function Ghdl_Signal_Driving_Value_E32 (Sig : Ghdl_Signal_Ptr)
                                          return Ghdl_E32;
 
-   function Ghdl_Create_Signal_I32
-     (Init_Val : Ghdl_I32;
-      Resolv_Func : System.Address;
-      Resolv_Inst : System.Address)
-     return Ghdl_Signal_Ptr;
+   function Ghdl_Create_Signal_I32 (Init_Val : Ghdl_I32;
+                                    Resolv_Func : System.Address;
+                                    Resolv_Inst : System.Address)
+                                   return Ghdl_Signal_Ptr;
    procedure Ghdl_Signal_Init_I32 (Sig : Ghdl_Signal_Ptr; Init_Val : Ghdl_I32);
    procedure Ghdl_Signal_Associate_I32 (Sig : Ghdl_Signal_Ptr; Val : Ghdl_I32);
    procedure Ghdl_Signal_Simple_Assign_I32 (Sign : Ghdl_Signal_Ptr;
@@ -551,11 +565,10 @@ package Grt.Signals is
    function Ghdl_Signal_Driving_Value_I32 (Sig : Ghdl_Signal_Ptr)
                                          return Ghdl_I32;
 
-   function Ghdl_Create_Signal_I64
-     (Init_Val : Ghdl_I64;
-      Resolv_Func : System.Address;
-      Resolv_Inst : System.Address)
-     return Ghdl_Signal_Ptr;
+   function Ghdl_Create_Signal_I64 (Init_Val : Ghdl_I64;
+                                    Resolv_Func : System.Address;
+                                    Resolv_Inst : System.Address)
+                                   return Ghdl_Signal_Ptr;
    procedure Ghdl_Signal_Init_I64 (Sig : Ghdl_Signal_Ptr; Init_Val : Ghdl_I64);
    procedure Ghdl_Signal_Associate_I64 (Sig : Ghdl_Signal_Ptr; Val : Ghdl_I64);
    procedure Ghdl_Signal_Simple_Assign_I64 (Sign : Ghdl_Signal_Ptr;
@@ -570,11 +583,10 @@ package Grt.Signals is
    function Ghdl_Signal_Driving_Value_I64 (Sig : Ghdl_Signal_Ptr)
                                           return Ghdl_I64;
 
-   function Ghdl_Create_Signal_F64
-     (Init_Val : Ghdl_F64;
-      Resolv_Func : System.Address;
-      Resolv_Inst : System.Address)
-     return Ghdl_Signal_Ptr;
+   function Ghdl_Create_Signal_F64 (Init_Val : Ghdl_F64;
+                                    Resolv_Func : System.Address;
+                                    Resolv_Inst : System.Address)
+                                   return Ghdl_Signal_Ptr;
    procedure Ghdl_Signal_Init_F64 (Sig : Ghdl_Signal_Ptr; Init_Val : Ghdl_F64);
    procedure Ghdl_Signal_Associate_F64 (Sig : Ghdl_Signal_Ptr; Val : Ghdl_F64);
    procedure Ghdl_Signal_Simple_Assign_F64 (Sign : Ghdl_Signal_Ptr;
@@ -643,7 +655,8 @@ package Grt.Signals is
    --  Create a new implicitly defined GUARD signal.
    function Ghdl_Signal_Create_Guard (This : System.Address;
                                       Proc : Guard_Func_Acc)
-     return Ghdl_Signal_Ptr;
+                                     return Ghdl_Signal_Ptr;
+
    --  Add SIG to the list of referenced signals that appear in the guard
    --  expression.
    procedure Ghdl_Signal_Guard_Dependence (Sig : Ghdl_Signal_Ptr);