Suppress stack switching; save process state in secondary stack.

36 files changed, 2705 insertions, 1255 deletions

diff --git a/src/ghdldrv/ghdlrun.adb b/src/ghdldrv/ghdlrun.adb
index 13bb6f890..51cc6b057 100644
--- a/src/ghdldrv/ghdlrun.adb
+++ b/src/ghdldrv/ghdlrun.adb
@@ -267,6 +267,8 @@ package body Ghdlrun is
            Grt.Processes.Ghdl_Process_Wait_Exit'Address);
       Def (Trans_Decls.Ghdl_Process_Wait_Suspend,
            Grt.Processes.Ghdl_Process_Wait_Suspend'Address);
+      Def (Trans_Decls.Ghdl_Process_Wait_Timed_Out,
+           Grt.Processes.Ghdl_Process_Wait_Timed_Out'Address);
       Def (Trans_Decls.Ghdl_Process_Wait_Timeout,
            Grt.Processes.Ghdl_Process_Wait_Timeout'Address);
       Def (Trans_Decls.Ghdl_Process_Wait_Set_Timeout,
diff --git a/src/grt/Makefile.inc b/src/grt/Makefile.inc
index df368946f..5b64a5440 100644
--- a/src/grt/Makefile.inc
+++ b/src/grt/Makefile.inc
@@ -45,63 +45,22 @@ endif
 GRT_ELF_OPTS:=-Wl,--version-script=@/grt.ver -Wl,--export-dynamic
 
 # Set target files.
-ifeq ($(filter-out i%86 linux,$(arch) $(osys)),)
-  GRT_TARGET_OBJS=i386.o linux.o times.o
-  GRT_EXTRA_LIB=-ldl -lm $(GRT_ELF_OPTS)
-endif
-ifeq ($(filter-out x86_64 linux,$(arch) $(osys)),)
-  GRT_TARGET_OBJS=amd64.o linux.o times.o
-  GRT_EXTRA_LIB=-ldl -lm $(GRT_ELF_OPTS)
-endif
-ifeq ($(filter-out i%86 netbsd,$(arch) $(osys)),)
-  GRT_TARGET_OBJS=i386.o linux.o times.o
-  GRT_EXTRA_LIB=-lm $(GRT_ELF_OPTS)
-endif
-ifeq ($(filter-out x86_64 netbsd,$(arch) $(osys)),)
-  GRT_TARGET_OBJS=amd64.o linux.o times.o
-  GRT_EXTRA_LIB=-lm $(GRT_ELF_OPTS)
-endif
-ifeq ($(filter-out i%86 freebsd%,$(arch) $(osys)),)
-  GRT_TARGET_OBJS=i386.o linux.o times.o
-  GRT_EXTRA_LIB=-lm $(GRT_ELF_OPTS)
-  ADAC=ada
-endif
-ifeq ($(filter-out x86_64 freebsd% dragonfly%,$(arch) $(osys)),)
-  GRT_TARGET_OBJS=amd64.o linux.o times.o
-  GRT_EXTRA_LIB=-lm $(GRT_ELF_OPTS)
-  ADAC=ada
-endif
-ifeq ($(filter-out i%86 darwin%,$(arch) $(osys)),)
-  GRT_TARGET_OBJS=i386.o linux.o times.o
-  GRT_EXTRA_LIB=
-endif
-ifeq ($(filter-out x86_64 darwin%,$(arch) $(osys)),)
-  GRT_TARGET_OBJS=amd64.o linux.o times.o
-  GRT_EXTRA_LIB=
-endif
-ifeq ($(filter-out sparc solaris%,$(arch) $(osys)),)
-  GRT_TARGET_OBJS=sparc.o linux.o times.o
-  GRT_EXTRA_LIB=-ldl -lm
-endif
-ifeq ($(filter-out powerpc linux%,$(arch) $(osys)),)
-  GRT_TARGET_OBJS=ppc.o linux.o times.o
-  GRT_EXTRA_LIB=-ldl -lm $(GRT_ELF_OPTS)
-endif
-ifeq ($(filter-out ia64 linux,$(arch) $(osys)),)
-  GRT_TARGET_OBJS=ia64.o linux.o times.o
-  GRT_EXTRA_LIB=-ldl -lm $(GRT_ELF_OPTS)
-endif
-ifeq ($(filter-out i%86 mingw32,$(arch) $(osys)),)
-  GRT_TARGET_OBJS=win32.o clock.o
-endif
-# Doesn't work for unknown reasons.
-#ifeq ($(filter-out i%86 cygwin,$(arch) $(osys)),)
-#  GRT_TARGET_OBJS=win32.o clock.o
-#endif
-# Fall-back: use a generic implementation based on pthreads.
-ifndef GRT_TARGET_OBJS
-  GRT_TARGET_OBJS=pthread.o times.o
-  GRT_EXTRA_LIB=-lpthread -ldl -lm
+ifeq ($(filter-out mingw32,$(arch) $(osys)),)
+  GRT_TARGET_OBJS=jumps.o math.o clock.o
+else
+  GRT_TARGET_OBJS=jumps.o times.o
+  ifeq ($(filter-out linux,$(arch) $(osys)),)
+    GRT_EXTRA_LIB=-ldl -lm $(GRT_ELF_OPTS)
+  endif
+  ifeq ($(filter-out netbsd freebsd% dragonfly%,$(arch) $(osys)),)
+    GRT_EXTRA_LIB=-lm $(GRT_ELF_OPTS)
+  endif
+  ifeq ($(filter-out solaris%,$(arch) $(osys)),)
+    GRT_EXTRA_LIB=-ldl -lm
+  endif
+  ifeq ($(filter-out darwin%,$(arch) $(osys)),)
+    GRT_EXTRA_LIB=
+  endif
 endif
 
 GRT_FST_OBJS := fstapi.o lz4.o fastlz.o
@@ -148,34 +107,13 @@ run-bind.o: run-bind.adb
 main.o: $(GRTSRCDIR)/main.adb
 	$(GRT_ADACOMPILE)
 
-i386.o: $(GRTSRCDIR)/config/i386.S
-	$(CC) -c $(GRT_FLAGS) -o $@ $<
-
-chkstk.o: $(GRTSRCDIR)/config/chkstk.S
-	$(CC) -c $(GRT_FLAGS) -o $@ $<
-
-sparc.o: $(GRTSRCDIR)/config/sparc.S
-	$(CC) -c $(GRT_FLAGS) -o $@ $<
-
-ppc.o: $(GRTSRCDIR)/config/ppc.S
-	$(CC) -c $(GRT_FLAGS) -o $@ $<
-
-ia64.o: $(GRTSRCDIR)/config/ia64.S
-	$(CC) -c $(GRT_FLAGS) -o $@ $<
-
-amd64.o: $(GRTSRCDIR)/config/amd64.S
-	$(CC) -c $(GRT_FLAGS) -o $@ $<
-
-linux.o: $(GRTSRCDIR)/config/linux.c
+jumps.o: $(GRTSRCDIR)/config/jumps.c
 	$(CC) -c $(GRT_FLAGS) $(GRT_CFLAGS) -o $@ $<
 
 win32.o: $(GRTSRCDIR)/config/win32.c
 	$(CC) -c $(GRT_FLAGS) -o $@ $<
 
-win32thr.o: $(GRTSRCDIR)/config/win32thr.c
-	$(CC) -c $(GRT_FLAGS) -o $@ $<
-
-pthread.o: $(GRTSRCDIR)/config/pthread.c
+math.o: $(GRTSRCDIR)/config/math.c
 	$(CC) -c $(GRT_FLAGS) -o $@ $<
 
 times.o : $(GRTSRCDIR)/config/times.c
@@ -202,6 +140,9 @@ lz4.o: $(GRTSRCDIR)/fst/lz4.c
 fastlz.o: $(GRTSRCDIR)/fst/fastlz.c
 	$(CC) -c $(GRT_FLAGS) -o $@ $<
 
+chkstk.o: $(GRTSRCDIR)/config/chkstk.S
+	$(CC) -c $(GRT_FLAGS) -o $@ $<
+
 grt-disp-config:
 	@echo "target: $(target)"
 	@echo "targ: $(targ)"
diff --git a/src/grt/config/jumps.c b/src/grt/config/jumps.c
new file mode 100644
index 000000000..360ea8089
--- /dev/null
+++ b/src/grt/config/jumps.c
@@ -0,0 +1,171 @@
+/*  Longjump/Setjump wrapper
+    Copyright (C) 2002 - 2015 Tristan Gingold.
+
+    GHDL is free software; you can redistribute it and/or modify it under
+    the terms of the GNU General Public License as published by the Free
+    Software Foundation; either version 2, or (at your option) any later
+    version.
+
+    GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+    WARRANTY; without even the implied warranty of MERCHANTABILITY or
+    FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+    for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with GCC; see the file COPYING.  If not, write to the Free
+    Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+    02111-1307, USA.
+
+    As a special exception, if other files instantiate generics from this
+    unit, or you link this unit with other files to produce an executable,
+    this unit does not by itself cause the resulting executable to be
+    covered by the GNU General Public License. This exception does not
+    however invalidate any other reasons why the executable file might be
+    covered by the GNU Public License.
+*/
+
+#include <stddef.h>
+#include <signal.h>
+#include <fcntl.h>
+#include <sys/ucontext.h>
+
+/* There is a simple setjmp/longjmp mechanism used to report failures.
+   We have the choice between 3 mechanisms:
+   * USE_BUITLIN_SJLJ: gcc builtin setjmp/longjmp, very fast but gcc specific.
+   * USE__SETJMP: _setjmp/_longjmp
+   * USE_SETJMP: setjmp/longjmp, slower because signals mask is saved/restored.
+*/
+
+#if defined (__GNUC__) && !defined (__clang__)
+#define USE_BUILTIN_SJLJ
+#else
+#define USE__SETJMP
+#endif
+/* #define USE_SETJMP */
+
+#ifdef USE_BUILTIN_SJLJ
+typedef void *JMP_BUF[5];
+static int sjlj_val;
+# define SETJMP(BUF) (__builtin_setjmp (BUF), sjlj_val)
+# define LONGJMP(BUF, VAL) \
+  do { sjlj_val = (VAL); __builtin_longjmp (BUF, 1); } while (0)
+#else
+# include <setjmp.h>
+typedef jmp_buf JMP_BUF;
+# ifdef USE__SETJMP
+#  define SETJMP _setjmp
+#  define LONGJMP _longjmp
+# elif defined (USE_SETJMP)
+#  define SETJMP setjmp
+#  define LONGJMP longjmp
+# else
+#  error "SETJMP/LONGJMP not configued"
+# endif
+#endif
+
+static int run_env_en;
+static JMP_BUF run_env;
+
+extern void grt_overflow_error (void);
+
+#ifdef __APPLE__
+#define NEED_SIGFPE_HANDLER
+#endif
+#if defined (__linux__) && defined (__i386__)
+#define NEED_SIGSEGV_HANDLER
+#endif
+
+#ifdef NEED_SIGFPE_HANDLER
+static struct sigaction prev_sigfpe_act;
+
+/* Handler for SIGFPE signal, raised in case of overflow (i386).  */
+static void grt_overflow_handler (int signo, siginfo_t *info, void *ptr)
+{
+  grt_overflow_error ();
+}
+#endif
+
+#ifdef NEED_SIGSEGV_HANDLER
+static struct sigaction prev_sigsegv_act;
+
+/* Linux handler for overflow.  This is used only by mcode.  */
+static void grt_sigsegv_handler (int signo, siginfo_t *info, void *ptr)
+{
+#if defined (__linux__) && defined (__i386__)
+  /* Linux generates a SIGSEGV (!) for an overflow exception.  */
+  if (uctxt->uc_mcontext.gregs[REG_TRAPNO] == 4)
+    {
+      grt_overflow_error ();
+    }
+#endif
+
+  /* We loose.  */
+}
+#endif /* __linux__ && __i386__ */
+
+static void grt_signal_setup (void)
+{
+#ifdef NEED_SIGSEGV_HANDLER
+  {
+    struct sigaction sigsegv_act;
+
+    sigsegv_act.sa_sigaction = &grt_sigsegv_handler;
+    sigemptyset (&sigsegv_act.sa_mask);
+    sigsegv_act.sa_flags = SA_ONSTACK | SA_SIGINFO;
+#ifdef SA_ONESHOT
+    sigsegv_act.sa_flags |= SA_ONESHOT;
+#elif defined (SA_RESETHAND)
+    sigsegv_act.sa_flags |= SA_RESETHAND;
+#endif
+
+    /* We don't care about the return status.
+       If the handler is not installed, then some feature are lost.  */
+    sigaction (SIGSEGV, &sigsegv_act, &prev_sigsegv_act);
+  }
+#endif
+
+#ifdef NEED_SIGFPE_HANDLER
+  {
+    struct sigaction sig_ovf_act;
+
+    sig_ovf_act.sa_sigaction = &grt_overflow_handler;
+    sigemptyset (&sig_ovf_act.sa_mask);
+    sig_ovf_act.sa_flags = SA_SIGINFO;
+
+    sigaction (SIGFPE, &sig_ovf_act, &prev_sigfpe_act);
+  }
+#endif
+}
+
+static void grt_signal_restore (void)
+{
+#ifdef NEED_SIGSEGV_HANDLER
+  sigaction (SIGSEGV, &prev_sigsegv_act, NULL);
+#endif
+
+#ifdef NEED_SIGFPE_HANDLER
+  sigaction (SIGFPE, &prev_sigfpe_act, NULL);
+#endif
+}
+
+void
+__ghdl_maybe_return_via_longjump (int val)
+{
+  if (run_env_en)
+    LONGJMP (run_env, val);
+}
+
+int
+__ghdl_run_through_longjump (int (*func)(void))
+{
+  int res;
+
+  run_env_en = 1;
+  grt_signal_setup ();
+  res = SETJMP (run_env);
+  if (res == 0)
+    res = (*func)();
+  grt_signal_restore ();
+  run_env_en = 0;
+  return res;
+}
diff --git a/src/grt/config/math.c b/src/grt/config/math.c
new file mode 100644
index 000000000..704225f67
--- /dev/null
+++ b/src/grt/config/math.c
@@ -0,0 +1,55 @@
+/*  Math routines for Win32
+    Copyright (C) 2005 - 2015 Tristan Gingold.
+
+    GHDL is free software; you can redistribute it and/or modify it under
+    the terms of the GNU General Public License as published by the Free
+    Software Foundation; either version 2, or (at your option) any later
+    version.
+
+    GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+    WARRANTY; without even the implied warranty of MERCHANTABILITY or
+    FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+    for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with GCC; see the file COPYING.  If not, write to the Free
+    Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+    02111-1307, USA.
+
+    As a special exception, if other files instantiate generics from this
+    unit, or you link this unit with other files to produce an executable,
+    this unit does not by itself cause the resulting executable to be
+    covered by the GNU General Public License. This exception does not
+    however invalidate any other reasons why the executable file might be
+    covered by the GNU Public License.
+*/
+
+#include <math.h>
+
+double acosh (double x)
+{
+  return log (x + sqrt (x*x - 1));
+}
+
+double asinh (double x)
+{
+  return log (x + sqrt (x*x + 1));
+}
+
+double atanh (double x)
+{
+  return log ((1 + x) / (1 - x)) / 2;
+}
+
+#ifndef WITH_GNAT_RUN_TIME
+void __gnat_raise_storage_error(void)
+{
+   abort ();
+}
+
+void __gnat_raise_program_error(void)
+{
+   abort ();
+}
+#endif
+
diff --git a/src/grt/grt-errors.adb b/src/grt/grt-errors.adb
index ed936688b..29da11206 100644
--- a/src/grt/grt-errors.adb
+++ b/src/grt/grt-errors.adb
@@ -238,6 +238,14 @@ package body Grt.Errors is
       Newline_Err;
    end Info;
 
+   procedure Warning (Str : String) is
+   begin
+      Put_Err (Progname);
+      Put_Err (":warning: ");
+      Put_Err (Str);
+      Newline_Err;
+   end Warning;
+
    procedure Internal_Error (Msg : String) is
    begin
       Put_Err (Progname);
diff --git a/src/grt/grt-errors.ads b/src/grt/grt-errors.ads
index 33c993226..8dcf55b4d 100644
--- a/src/grt/grt-errors.ads
+++ b/src/grt/grt-errors.ads
@@ -51,6 +51,9 @@ package Grt.Errors is
    --  Complete error message.
    procedure Error (Str : String);
 
+   --  Warning message.
+   procedure Warning (Str : String);
+
    --  Internal error.  The message must contain the subprogram name which
    --  has called this procedure.
    procedure Internal_Error (Msg : String);
diff --git a/src/grt/grt-main.adb b/src/grt/grt-main.adb
index 4d4106bee..5d825deb4 100644
--- a/src/grt/grt-main.adb
+++ b/src/grt/grt-main.adb
@@ -26,7 +26,6 @@ with System.Storage_Elements; --  Work around GNAT bug.
 pragma Unreferenced (System.Storage_Elements);
 with Grt.Types; use Grt.Types;
 with Grt.Errors;
-with Grt.Stacks;
 with Grt.Processes;
 with Grt.Signals;
 with Grt.Options; use Grt.Options;
@@ -133,8 +132,6 @@ package body Grt.Main is
       end if;
 
       --  Internal initializations.
-      Grt.Stacks.Stack_Init;
-
       Grt.Hooks.Call_Init_Hooks;
 
       Grt.Processes.Init;
@@ -146,8 +143,7 @@ package body Grt.Main is
       end if;
 
       --  Elaboration.  Run through longjump to catch errors.
-      if Grt.Processes.Run_Through_Longjump (Ghdl_Elaborate_Wrapper'Access) < 0
-      then
+      if Run_Through_Longjump (Ghdl_Elaborate_Wrapper'Access) < 0 then
          Grt.Errors.Error ("error during elaboration");
          return;
       end if;
@@ -175,7 +171,7 @@ package body Grt.Main is
          end if;
 
          --  Do the simulation.
-         Status := Grt.Processes.Simulation;
+         Status := Run_Through_Longjump (Grt.Processes.Simulation'Access);
       end if;
 
       if Flag_Stats then
diff --git a/src/grt/grt-main.ads b/src/grt/grt-main.ads
index 6dd774197..9fbf7b167 100644
--- a/src/grt/grt-main.ads
+++ b/src/grt/grt-main.ads
@@ -31,4 +31,11 @@ package Grt.Main is
    --  been assigned to generics, but before being used.
    procedure Ghdl_Init_Top_Generics;
    pragma Export (C, Ghdl_Init_Top_Generics, "__ghdl_init_top_generics");
+
+   type Run_Handler is access function return Integer;
+
+   --  Run HAND through a wrapper that catch some errors (in particular on
+   --  windows).  Returns < 0 in case of error.
+   function Run_Through_Longjump (Hand : Run_Handler) return Integer;
+   pragma Import (Ada, Run_Through_Longjump, "__ghdl_run_through_longjump");
 end Grt.Main;
diff --git a/src/grt/grt-options.adb b/src/grt/grt-options.adb
index f3b9e8cdb..446439f5f 100644
--- a/src/grt/grt-options.adb
+++ b/src/grt/grt-options.adb
@@ -160,8 +160,6 @@ package body Grt.Options is
       P ("       X is expressed as a time value, without spaces: 1ns, ps...");
       P (" --stop-delta=X    stop the simulation cycle after X delta");
       P (" --expect-failure  invert exit status");
-      P (" --stack-size=X    set the stack size of non-sensitized processes");
-      P (" --stack-max-size=X  set the maximum stack size");
       P (" --no-run          do not simulate, only elaborate");
       --  P (" --threads=N       use N threads for simulation");
       Grt.Hooks.Call_Help_Hooks;
@@ -210,39 +208,6 @@ package body Grt.Options is
       end loop;
    end Extract_Integer;
 
-   function Extract_Size (Str : String; Option_Name : String) return Natural
-   is
-      Ok : Boolean;
-      Val : Integer_64;
-      Pos : Natural;
-   begin
-      Extract_Integer (Str, Ok, Val, Pos);
-      if not Ok then
-         Val := 1;
-      end if;
-      if Pos > Str'Last then
-         --  No suffix.
-         if Val > Integer_64(Natural'Last) then
-            Error_C ("Size exceeds limit for option ");
-            Error_E (Option_Name);
-         else
-            return Natural (Val);
-         end if;
-      end if;
-      if Pos = Str'Last
-        or else (Pos + 1 = Str'Last
-                 and then (Str (Pos + 1) = 'b' or Str (Pos + 1) = 'o'))
-      then
-         if Str (Pos) = 'k' or Str (Pos) = 'K' then
-            return Natural (Val) * 1024;
-         elsif Str (Pos) = 'm' or Str (Pos) = 'M' then
-            return Natural (Val) * 1024 * 1024;
-         end if;
-      end if;
-      Error_C ("bad memory unit for option ");
-      Error_E (Option_Name);
-   end Extract_Size;
-
    function To_Lower (C : Character) return Character is
    begin
       if C in 'A' .. 'Z' then
@@ -434,17 +399,9 @@ package body Grt.Options is
       elsif Option = "--expect-failure" then
          Expect_Failure := True;
       elsif Len >= 13 and then Option (1 .. 13) = "--stack-size=" then
-         Stack_Size := Extract_Size
-           (Option (14 .. Len), "--stack-size");
-         if Stack_Size > Stack_Max_Size then
-            Stack_Max_Size := Stack_Size;
-         end if;
+         Warning ("option --stack-size is deprecated");
       elsif Len >= 17 and then Option (1 .. 17) = "--stack-max-size=" then
-         Stack_Max_Size := Extract_Size
-           (Option (18 .. Len), "--stack-size");
-         if Stack_Size > Stack_Max_Size then
-            Stack_Size := Stack_Max_Size;
-         end if;
+         Warning ("option --stack-max-size is deprecated");
       elsif Len >= 11 and then Option (1 .. 11) = "--activity=" then
          if Option (12 .. Len) = "none" then
             Flag_Activity := Activity_None;
diff --git a/src/grt/grt-options.ads b/src/grt/grt-options.ads
index eaf3d022d..34180f15d 100644
--- a/src/grt/grt-options.ads
+++ b/src/grt/grt-options.ads
@@ -125,12 +125,6 @@ package Grt.Options is
    --  Set by --stop-delta=XXX to stop the simulation after XXX delta cycles.
    Stop_Delta : Natural := 5000;
 
-   --  The default stack size for non-sensitized processes.
-   Stack_Size : Natural := 8 * 1024;
-
-   --  The maximum stack size for non-sensitized processes.
-   Stack_Max_Size : Natural := 128 * 1024;
-
    --  Set by --no-run
    --  If set, do not simulate, only elaborate.
    Flag_No_Run : Boolean := False;
@@ -166,7 +160,5 @@ package Grt.Options is
    First_Generic_Override : Generic_Override_Acc;
    Last_Generic_Override : Generic_Override_Acc;
 private
-   pragma Export (C, Stack_Size);
-   pragma Export (C, Stack_Max_Size);
    pragma Export (C, Nbr_Threads, "grt_nbr_threads");
 end Grt.Options;
diff --git a/src/grt/grt-processes.adb b/src/grt/grt-processes.adb
index 01e8394bc..748ab6dd9 100644
--- a/src/grt/grt-processes.adb
+++ b/src/grt/grt-processes.adb
@@ -23,7 +23,6 @@
 --  however invalidate any other reasons why the executable file might be
 --  covered by the GNU Public License.
 with Grt.Table;
-with Ada.Unchecked_Conversion;
 with Ada.Unchecked_Deallocation;
 with System.Storage_Elements; --  Work around GNAT bug.
 pragma Unreferenced (System.Storage_Elements);
@@ -87,9 +86,23 @@ package body Grt.Processes is
    Process_First_Timeout : Std_Time := Last_Time;
    Process_Timeout_Chain : Process_Acc := null;
 
+   Elab_Process : Process_Acc;
+
    procedure Init is
    begin
-      null;
+      --  Create a dummy process so that elaboration has a context.
+      Elab_Process := new Process_Type'(Subprg => null,
+                                        This => null,
+                                        Rti => Null_Context,
+                                        Sensitivity => null,
+                                        Stack2 => Null_Stack2_Ptr,
+                                        Resumed => False,
+                                        Postponed => False,
+                                        State => State_Sensitized,
+                                        Timeout => Bad_Time,
+                                        Timeout_Chain_Next => null,
+                                        Timeout_Chain_Prev => null);
+      Set_Current_Process (Elab_Process);
    end Init;
 
    function Get_Nbr_Processes return Natural is
@@ -120,28 +133,19 @@ package body Grt.Processes is
                                State : Process_State;
                                Postponed : Boolean)
    is
-      Stack : Stack_Type;
       P : Process_Acc;
    begin
-      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");
-         end if;
-      else
-         Stack := Null_Stack;
-      end if;
       P := new Process_Type'(Subprg => Proc,
                              This => This,
                              Rti => Ctxt,
                              Sensitivity => null,
+                             Stack2 => Null_Stack2_Ptr,
                              Resumed => False,
                              Postponed => Postponed,
                              State => State,
                              Timeout => Bad_Time,
                              Timeout_Chain_Next => null,
-                             Timeout_Chain_Prev => null,
-                             Stack => Stack);
+                             Timeout_Chain_Prev => null);
       Process_Table.Append (P);
       --  Used to create drivers.
       Set_Current_Process (P);
@@ -203,12 +207,12 @@ package body Grt.Processes is
                              Resumed => False,
                              Postponed => False,
                              State => State_Sensitized,
+                             Stack2 => Null_Stack2_Ptr,
                              Timeout => Bad_Time,
                              Timeout_Chain_Next => null,
                              Timeout_Chain_Prev => null,
                              Subprg => Proc,
-                             This => This,
-                             Stack => Null_Stack);
+                             This => This);
       Process_Table.Append (P);
       --  Used to create drivers.
       Set_Current_Process (P);
@@ -268,26 +272,42 @@ package body Grt.Processes is
    end Resume_Process;
 
    function Ghdl_Stack2_Allocate (Size : Ghdl_Index_Type)
-     return System.Address
+                                 return System.Address
    is
+      Proc : constant Process_Acc := Get_Current_Process;
    begin
-      return Grt.Stack2.Allocate (Get_Stack2, Size);
+      return Grt.Stack2.Allocate (Proc.Stack2, Size);
    end Ghdl_Stack2_Allocate;
 
    function Ghdl_Stack2_Mark return Mark_Id
    is
-      St2 : Stack2_Ptr := Get_Stack2;
+      Proc : constant Process_Acc := Get_Current_Process;
+      St2 : Stack2_Ptr;
    begin
+      St2 := Proc.Stack2;
+
+      --  Check that stack2 has been created.  This check is done only here,
+      --  because Mark is called before Release (obviously) but also before
+      --  Allocate.
       if St2 = Null_Stack2_Ptr then
-         St2 := Grt.Stack2.Create;
-         Set_Stack2 (St2);
+         if Proc.State = State_Sensitized then
+            --  Sensitized processes share the stack2, as the stack2 is empty
+            --  when sensitized processes suspend.
+            St2 := Get_Common_Stack2;
+         else
+            St2 := Grt.Stack2.Create;
+         end if;
+         Proc.Stack2 := St2;
       end if;
+
       return Grt.Stack2.Mark (St2);
    end Ghdl_Stack2_Mark;
 
-   procedure Ghdl_Stack2_Release (Mark : Mark_Id) is
+   procedure Ghdl_Stack2_Release (Mark : Mark_Id)
+   is
+      Proc : constant Process_Acc := Get_Current_Process;
    begin
-      Grt.Stack2.Release (Get_Stack2, Mark);
+      Grt.Stack2.Release (Proc.Stack2, Mark);
    end Ghdl_Stack2_Release;
 
    procedure Free is new Ada.Unchecked_Deallocation
@@ -374,16 +394,16 @@ package body Grt.Processes is
       Update_Process_First_Timeout (Proc);
    end Ghdl_Process_Wait_Set_Timeout;
 
-   function Ghdl_Process_Wait_Has_Timeout return Boolean
+   function Ghdl_Process_Wait_Timed_Out 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;
+   end Ghdl_Process_Wait_Timed_Out;
 
-   procedure Ghdl_Process_Wait_Wait
+   procedure Ghdl_Process_Wait_Suspend
    is
       Proc : constant Process_Acc := Get_Current_Process;
    begin
@@ -392,22 +412,6 @@ package body Grt.Processes is
       end if;
       --  Suspend this process.
       Proc.State := State_Wait;
---       if Cur_Proc.Timeout = Bad_Time then
---          Cur_Proc.Timeout := Std_Time'Last;
---       end if;
-   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 Ghdl_Process_Wait_Close
@@ -497,14 +501,10 @@ package body Grt.Processes is
       if Proc.State = State_Sensitized then
          Error ("wait statement in a sensitized process");
       end if;
+
       --  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.
-      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)
@@ -519,18 +519,8 @@ package body Grt.Processes is
          Error ("negative timeout clause");
       end if;
       Proc.Timeout := Current_Time + Time;
-      Proc.State := State_Wait;
+      Proc.State := State_Delayed;
       Update_Process_First_Timeout (Proc);
-      --  Suspend this process.
-      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);
-      Proc.State := State_Ready;
    end Ghdl_Process_Wait_Timeout;
 
    --  Verilog.
@@ -705,8 +695,6 @@ package body Grt.Processes is
    Run_Resumed : constant Integer := 2;
    --  Simulation is finished.
    Run_Finished : constant Integer := 3;
-   --  Failure, simulation should stop.
-   Run_Failure : constant Integer := -1;
    --  Stop/finish request from user (via std.env).
    Run_Stop : constant Integer := -2;
    pragma Unreferenced (Run_Stop);
@@ -741,19 +729,14 @@ package body Grt.Processes is
          end if;
          Proc.Resumed := False;
          Set_Current_Process (Proc);
-         if Proc.State = State_Sensitized or else One_Stack then
-            Proc.Subprg.all (Proc.This);
-         else
-            Stack_Switch (Proc.Stack, Get_Main_Stack);
-         end if;
+         Proc.Subprg.all (Proc.This);
          if Grt.Options.Checks then
             Ghdl_Signal_Internal_Checks;
-            Grt.Stack2.Check_Empty (Get_Stack2);
          end if;
       end loop;
    end Run_Processes_Threads;
 
-   function Run_Processes (Postponed : Boolean) return Integer
+   function Run_Processes (Postponed : Boolean) return Natural
    is
       Table : Process_Acc_Array_Acc;
       Last : Natural;
@@ -792,14 +775,9 @@ package body Grt.Processes is
 
                Proc.Resumed := False;
                Set_Current_Process (Proc);
-               if Proc.State = State_Sensitized or else One_Stack then
-                  Proc.Subprg.all (Proc.This);
-               else
-                  Stack_Switch (Proc.Stack, Get_Main_Stack);
-               end if;
+               Proc.Subprg.all (Proc.This);
                if Grt.Options.Checks then
                   Ghdl_Signal_Internal_Checks;
-                  Grt.Stack2.Check_Empty (Get_Stack2);
                end if;
             end;
          end loop;
@@ -817,9 +795,10 @@ package body Grt.Processes is
       end if;
    end Run_Processes;
 
-   function Initialization_Phase return Integer
+   procedure Initialization_Phase
    is
-      Status : Integer;
+      Status : Natural;
+      pragma Unreferenced (Status);
    begin
       --  Allocate processes arrays.
       Resume_Process_Table :=
@@ -857,15 +836,9 @@ package body Grt.Processes is
       --  - Each nonpostponed process in the model is executed until it
       --    suspends.
       Status := Run_Processes (Postponed => False);
-      if Status = Run_Failure then
-         return Run_Failure;
-      end if;
 
       --  - Each postponed process in the model is executed until it suspends.
       Status := Run_Processes (Postponed => True);
-      if Status = Run_Failure then
-         return Run_Failure;
-      end if;
 
       --  - The time of the next simulation cycle (which in this case is the
       --    first simulation cycle), Tn, is calculated according to the rules
@@ -874,8 +847,6 @@ package body Grt.Processes is
 
       --  Clear current_delta, will be set by Simulation_Cycle.
       Current_Delta := 0;
-
-      return Run_Resumed;
    end Initialization_Phase;
 
    --  Launch a simulation cycle.
@@ -913,17 +884,20 @@ package body Grt.Processes is
          Tn := Last_Time;
          declare
             Proc : Process_Acc;
+            Next_Proc : Process_Acc;
          begin
             Proc := Process_Timeout_Chain;
             while Proc /= null loop
+               Next_Proc := Proc.Timeout_Chain_Next;
                case Proc.State is
                   when State_Sensitized =>
                      null;
                   when State_Delayed =>
                      if Proc.Timeout = Current_Time then
                         Proc.Timeout := Bad_Time;
+                        Remove_Process_From_Timeout_Chain (Proc);
                         Resume_Process (Proc);
-                        Proc.State := State_Sensitized;
+                        Proc.State := State_Ready;
                      elsif Proc.Timeout > 0 and then Proc.Timeout < Tn then
                         Tn := Proc.Timeout;
                      end if;
@@ -941,7 +915,7 @@ package body Grt.Processes is
                   when State_Dead =>
                      null;
                end case;
-               Proc := Proc.Timeout_Chain_Next;
+               Proc := Next_Proc;
             end loop;
          end;
          Process_First_Timeout := Tn;
@@ -950,9 +924,6 @@ package body Grt.Processes is
       --  e) Each nonpostponed that has resumed in the current simulation cycle
       --     is executed until it suspends.
       Status := Run_Processes (Postponed => False);
-      if Status = Run_Failure then
-         return Run_Failure;
-      end if;
 
       --  f) The time of the next simulation cycle, Tn, is determined by
       --     setting it to the earliest of
@@ -995,8 +966,6 @@ package body Grt.Processes is
             if Tn = Current_Time then
                Error ("postponed process causes a delta cycle");
             end if;
-         elsif Status = Run_Failure then
-            return Run_Failure;
          end if;
          Current_Time := Tn;
          return Run_Resumed;
@@ -1016,10 +985,7 @@ package body Grt.Processes is
 --          Grt.Disp.Disp_Signals_Type;
 --       end if;
 
-      Status := Run_Through_Longjump (Initialization_Phase'Access);
-      if Status /= Run_Resumed then
-         return Status;
-      end if;
+      Initialization_Phase;
 
       Nbr_Delta_Cycles := 0;
       Nbr_Cycles := 0;
@@ -1039,7 +1005,7 @@ package body Grt.Processes is
          if Disp_Time then
             Grt.Disp.Disp_Now;
          end if;
-         Status := Run_Through_Longjump (Simulation_Cycle'Access);
+         Status := Simulation_Cycle;
          exit when Status < 0;
          if Trace_Signals then
             Grt.Disp_Signals.Disp_All_Signals;
diff --git a/src/grt/grt-processes.ads b/src/grt/grt-processes.ads
index 2d953ecf1..ecef800d4 100644
--- a/src/grt/grt-processes.ads
+++ b/src/grt/grt-processes.ads
@@ -23,10 +23,10 @@
 --  however invalidate any other reasons why the executable file might be
 --  covered by the GNU Public License.
 with System;
+with Ada.Unchecked_Conversion;
 with Grt.Stack2; use Grt.Stack2;
 with Grt.Types; use Grt.Types;
 with Grt.Signals; use Grt.Signals;
-with Grt.Stacks; use Grt.Stacks;
 with Grt.Rtis; use Grt.Rtis;
 with Grt.Rtis_Addr;
 with Grt.Stdio;
@@ -51,10 +51,6 @@ 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;
 
@@ -74,6 +70,21 @@ package Grt.Processes is
    --  Disp the name of process PROC.
    procedure Disp_Process_Name (Stream : Grt.Stdio.FILEs; Proc : Process_Acc);
 
+   --  Instance is the parameter of the process procedure.
+   --  This is in fact a fully opaque type whose content is private to the
+   --  process.
+   type Instance is limited private;
+   type Instance_Acc is access all Instance;
+   pragma Convention (C, Instance_Acc);
+
+   --  A process is identified by a procedure having a single private
+   --  parameter (its instance).
+   type Proc_Acc is access procedure (Self : Instance_Acc);
+   pragma Convention (C, Proc_Acc);
+
+   function To_Address is new Ada.Unchecked_Conversion
+     (Instance_Acc, System.Address);
+
    --  Register a process during elaboration.
    --  This procedure is called by vhdl elaboration code.
    procedure Ghdl_Process_Register (Instance : Instance_Acc;
@@ -131,16 +142,12 @@ package Grt.Processes is
    --  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;
+   procedure Ghdl_Process_Wait_Suspend;
+   --  Return TRUE if woken up by a timeout.
+   function Ghdl_Process_Wait_Timed_Out 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);
 
@@ -156,14 +163,9 @@ package Grt.Processes is
    procedure Ghdl_Protected_Init (Obj : System.Address);
    procedure Ghdl_Protected_Fini (Obj : System.Address);
 
-   type Run_Handler is access function return Integer;
-
-   --  Run HAND through a wrapper that catch some errors (in particular on
-   --  windows).  Returns < 0 in case of error.
-   function Run_Through_Longjump (Hand : Run_Handler) return Integer;
-   pragma Import (Ada, Run_Through_Longjump, "__ghdl_run_through_longjump");
-
 private
+   type Instance is null record;
+
    --  State of a process.
    type Process_State is
      (
@@ -173,10 +175,11 @@ private
       --  Non-sensitized process, ready to run.
       State_Ready,
 
-      --  Verilog process, being suspended.
+      --  Non-sensitized process being suspended on a timeout (without
+      --  sensitivity).
       State_Delayed,
 
-      --  Non-sensitized process being suspended.
+      --  Non-sensitized process being suspended, with sensitivity.
       State_Wait,
 
       --  Non-sensitized process being awaked by a wait timeout.  This state
@@ -189,35 +192,33 @@ private
       State_Dead);
 
    type Process_Type is record
-      --  Stack for the process.
-      --  This must be the first field of the record (and this is the only
-      --  part visible).
-      --  Must be NULL_STACK for sensitized processes.
-      Stack : Stacks.Stack_Type;
-
       --  Subprogram containing process code.
       Subprg : Proc_Acc;
 
       --  Instance (THIS parameter) for the subprogram.
       This : Instance_Acc;
 
-      --  Name of the process.
-      Rti : Rtis_Addr.Rti_Context;
-
       --  True if the process is resumed and will be run at next cycle.
       Resumed : Boolean;
 
       --  True if the process is postponed.
       Postponed : Boolean;
 
+      --  State of the process.
       State : Process_State;
 
-      --  Timeout value for wait.
-      Timeout : Std_Time;
+      --  Secondary stack for this process.
+      Stack2 : Stack2_Ptr;
 
       --  Sensitivity list while the (non-sensitized) process is waiting.
       Sensitivity : Action_List_Acc;
 
+      --  Name of the process.
+      Rti : Rtis_Addr.Rti_Context;
+
+      --  Timeout value for wait.
+      Timeout : Std_Time;
+
       Timeout_Chain_Next : Process_Acc;
       Timeout_Chain_Prev : Process_Acc;
    end record;
@@ -249,6 +250,8 @@ private
                   "__ghdl_process_wait_set_timeout");
    pragma Export (Ada, Ghdl_Process_Wait_Suspend,
                   "__ghdl_process_wait_suspend");
+   pragma Export (Ada, Ghdl_Process_Wait_Timed_Out,
+                  "__ghdl_process_wait_timed_out");
    pragma Export (C, Ghdl_Process_Wait_Close,
                   "__ghdl_process_wait_close");
 
diff --git a/src/grt/grt-stack2.adb b/src/grt/grt-stack2.adb
index 82341d072..cb56225b7 100644
--- a/src/grt/grt-stack2.adb
+++ b/src/grt/grt-stack2.adb
@@ -149,16 +149,6 @@ package body Grt.Stack2 is
       return To_Addr (Res);
    end Create;
 
-   procedure Check_Empty (S : Stack2_Ptr)
-   is
-      S2 : Stack2_Acc;
-   begin
-      S2 := To_Acc (S);
-      if S2 /= null and then S2.Top /= S2.First_Chunk.First then
-         Internal_Error ("stack2.check_empty: stack is not empty");
-      end if;
-   end Check_Empty;
-
    --  May be used to debug.
    procedure Dump_Stack2 (S : Stack2_Ptr);
    pragma Unreferenced (Dump_Stack2);
diff --git a/src/grt/grt-stack2.ads b/src/grt/grt-stack2.ads
index b3de6b76d..1c0c79afe 100644
--- a/src/grt/grt-stack2.ads
+++ b/src/grt/grt-stack2.ads
@@ -26,18 +26,41 @@ with System;
 with Grt.Types; use Grt.Types;
 
 --  Secondary stack management.
+--  The secondary stack is used by vhdl to return object from function whose
+--  type is unconstrained.  This is less efficient than returning the object
+--  on the stack, but compatible with any ABI.
+--
+--  The management is very simple: mark and release.  Allocate reserved a
+--  chunk of memory from the secondary stack, Release deallocate all the
+--  memory allocated since the mark.
+
 package Grt.Stack2 is
-   type Stack2_Ptr is new System.Address;
-   Null_Stack2_Ptr : constant Stack2_Ptr := Stack2_Ptr (System.Null_Address);
+   --  Designate a secondary stack.
+   type Stack2_Ptr is private;
 
-   type Mark_Id is new Integer_Address;
+   --  Indicator for a non-existing secondary stack.  Create never return that
+   --  value.
+   Null_Stack2_Ptr : constant Stack2_Ptr;
+
+   --  Type of a mark.
+   type Mark_Id is private;
 
+   --  Get the current mark, which indicate a current amount of allocated
+   --  memory.
    function Mark (S : Stack2_Ptr) return Mark_Id;
+
+   --  Deallocate (free) all the memory allocated since MARK.
    procedure Release (S : Stack2_Ptr; Mark : Mark_Id);
+
+   --  Allocate SIZE bytes (aligned on the maximum alignment) on stack S.
    function Allocate (S : Stack2_Ptr; Size : Ghdl_Index_Type)
-     return System.Address;
+                     return System.Address;
+
+   --  Create a secondary stack.
    function Create return Stack2_Ptr;
+private
+   type Stack2_Ptr is new System.Address;
+   Null_Stack2_Ptr : constant Stack2_Ptr := Stack2_Ptr (System.Null_Address);
 
-   --  Check S is empty.
-   procedure Check_Empty (S : Stack2_Ptr);
+   type Mark_Id is new Integer_Address;
 end Grt.Stack2;
diff --git a/src/grt/grt-stacks.adb b/src/grt/grt-stacks.adb
deleted file mode 100644
index adb008d02..000000000
--- a/src/grt/grt-stacks.adb
+++ /dev/null
@@ -1,43 +0,0 @@
---  GHDL Run Time (GRT) - process stacks.
---  Copyright (C) 2002 - 2014 Tristan Gingold
---
---  GHDL is free software; you can redistribute it and/or modify it under
---  the terms of the GNU General Public License as published by the Free
---  Software Foundation; either version 2, or (at your option) any later
---  version.
---
---  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
---  WARRANTY; without even the implied warranty of MERCHANTABILITY or
---  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
---  for more details.
---
---  You should have received a copy of the GNU General Public License
---  along with GCC; see the file COPYING.  If not, write to the Free
---  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
---  02111-1307, USA.
---
---  As a special exception, if other files instantiate generics from this
---  unit, or you link this unit with other files to produce an executable,
---  this unit does not by itself cause the resulting executable to be
---  covered by the GNU General Public License. This exception does not
---  however invalidate any other reasons why the executable file might be
---  covered by the GNU Public License.
-with Grt.Errors; use Grt.Errors;
-
-package body Grt.Stacks is
-   procedure Error_Grow_Failed is
-   begin
-      Error ("cannot grow the stack");
-   end Error_Grow_Failed;
-
-   procedure Error_Memory_Access is
-   begin
-      Error
-        ("invalid memory access (dangling accesses or stack size too small)");
-   end Error_Memory_Access;
-
-   procedure Error_Null_Access is
-   begin
-      Error ("NULL access dereferenced");
-   end Error_Null_Access;
-end Grt.Stacks;
diff --git a/src/grt/grt-stacks.ads b/src/grt/grt-stacks.ads
deleted file mode 100644
index dd9434080..000000000
--- a/src/grt/grt-stacks.ads
+++ /dev/null
@@ -1,87 +0,0 @@
---  GHDL Run Time (GRT) - process stacks.
---  Copyright (C) 2002 - 2014 Tristan Gingold
---
---  GHDL is free software; you can redistribute it and/or modify it under
---  the terms of the GNU General Public License as published by the Free
---  Software Foundation; either version 2, or (at your option) any later
---  version.
---
---  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
---  WARRANTY; without even the implied warranty of MERCHANTABILITY or
---  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
---  for more details.
---
---  You should have received a copy of the GNU General Public License
---  along with GCC; see the file COPYING.  If not, write to the Free
---  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
---  02111-1307, USA.
---
---  As a special exception, if other files instantiate generics from this
---  unit, or you link this unit with other files to produce an executable,
---  this unit does not by itself cause the resulting executable to be
---  covered by the GNU General Public License. This exception does not
---  however invalidate any other reasons why the executable file might be
---  covered by the GNU Public License.
-with System; use System;
-with Ada.Unchecked_Conversion;
-
-package Grt.Stacks is
-   --  Instance is the parameter of the process procedure.
-   --  This is in fact a fully opaque type whose content is private to the
-   --  process.
-   type Instance is limited private;
-   type Instance_Acc is access all Instance;
-   pragma Convention (C, Instance_Acc);
-
-   --  A process is identified by a procedure having a single private
-   --  parameter (its instance).
-   type Proc_Acc is access procedure (Self : Instance_Acc);
-   pragma Convention (C, Proc_Acc);
-
-   function To_Address is new Ada.Unchecked_Conversion
-     (Instance_Acc, System.Address);
-
-   type Stack_Type is new Address;
-   Null_Stack : constant Stack_Type := Stack_Type (Null_Address);
-
-   --  Initialize the stacks package.
-   --  This may adjust stack sizes.
-   --  Must be called after grt.options.decode.
-   procedure Stack_Init;
-
-   --  Create a new stack, which on first execution will call FUNC with
-   --  an argument ARG.
-   function Stack_Create (Func : Proc_Acc; Arg : Instance_Acc)
-                         return Stack_Type;
-
-   --  Resume stack TO and save the current context to the stack pointed by
-   --  CUR.
-   procedure Stack_Switch (To : Stack_Type; From : Stack_Type);
-
-   --  Delete stack STACK, which must not be currently executed.
-   procedure Stack_Delete (Stack : Stack_Type);
-
-   --  Error during stack handling:
-   --  Cannot grow the stack.
-   procedure Error_Grow_Failed;
-   pragma No_Return (Error_Grow_Failed);
-
-   --  Invalid memory access detected (other than dereferencing a NULL access).
-   procedure Error_Memory_Access;
-   pragma No_Return (Error_Memory_Access);
-
-   --  A NULL access is dereferenced.
-   procedure Error_Null_Access;
-   pragma No_Return (Error_Null_Access);
-private
-   type Instance is null record;
-
-   pragma Import (C, Stack_Init, "grt_stack_init");
-   pragma Import (C, Stack_Create, "grt_stack_create");
-   pragma Import (C, Stack_Switch, "grt_stack_switch");
-   pragma Import (C, Stack_Delete, "grt_stack_delete");
-
-   pragma Export (C, Error_Grow_Failed, "grt_stack_error_grow_failed");
-   pragma Export (C, Error_Memory_Access, "grt_stack_error_memory_access");
-   pragma Export (C, Error_Null_Access, "grt_stack_error_null_access");
-end Grt.Stacks;
diff --git a/src/grt/grt-unithread.adb b/src/grt/grt-unithread.adb
index 6acb52169..7e135339b 100644
--- a/src/grt/grt-unithread.adb
+++ b/src/grt/grt-unithread.adb
@@ -80,27 +80,10 @@ package body Grt.Unithread is
       return Current_Process;
    end Get_Current_Process;
 
-   Stack2 : Stack2_Ptr;
+   Common_Stack2 : constant Stack2_Ptr := Create;
 
-   function Get_Stack2 return Stack2_Ptr is
+   function Get_Common_Stack2 return Stack2_Ptr is
    begin
-      return Stack2;
-   end Get_Stack2;
-
-   procedure Set_Stack2 (St : Stack2_Ptr) is
-   begin
-      Stack2 := St;
-   end Set_Stack2;
-
-   Main_Stack : Stack_Type;
-
-   function Get_Main_Stack return Stack_Type is
-   begin
-      return Main_Stack;
-   end Get_Main_Stack;
-
-   procedure Set_Main_Stack (St : Stack_Type) is
-   begin
-      Main_Stack := St;
-   end Set_Main_Stack;
+      return Common_Stack2;
+   end Get_Common_Stack2;
 end Grt.Unithread;
diff --git a/src/grt/grt-unithread.ads b/src/grt/grt-unithread.ads
index b35b7be33..6bfacab21 100644
--- a/src/grt/grt-unithread.ads
+++ b/src/grt/grt-unithread.ads
@@ -26,7 +26,6 @@ with System.Storage_Elements; --  Work around GNAT bug.
 pragma Unreferenced (System.Storage_Elements);
 with Grt.Signals; use Grt.Signals;
 with Grt.Stack2; use Grt.Stack2;
-with Grt.Stacks; use Grt.Stacks;
 
 package Grt.Unithread is
    procedure Init;
@@ -46,28 +45,17 @@ package Grt.Unithread is
    procedure Set_Current_Process (Proc : Process_Acc);
    function Get_Current_Process return Process_Acc;
 
-   --  The secondary stack for the thread.  In this implementation, there is
-   --  only one secondary stack, shared by all processes. This is allowed,
-   --  because a wait statement cannot appear within a function.  So at a wait
-   --  statement, the secondary stack must be empty.
-   function Get_Stack2 return Stack2_Ptr;
-   procedure Set_Stack2 (St : Stack2_Ptr);
-
-   --  The main stack.  This is initialized by STACK_INIT.
-   --  The return point.
-   function Get_Main_Stack return Stack_Type;
-   procedure Set_Main_Stack (St : Stack_Type);
+   --  The stack2 for all sensitized process.  Since they cannot have
+   --  wait statements, the stack2 is always empty when the process is
+   --  suspended.
+   function Get_Common_Stack2 return Stack2_Ptr;
 private
    pragma Inline (Run_Parallel);
    pragma Inline (Atomic_Insert);
    pragma Inline (Atomic_Inc);
-   pragma Inline (Get_Stack2);
-   pragma Inline (Set_Stack2);
-
-   pragma Inline (Get_Main_Stack);
-   pragma Export (C, Set_Main_Stack, "grt_set_main_stack");
 
    pragma Inline (Set_Current_Process);
    pragma Inline (Get_Current_Process);
 
+   pragma Inline (Get_Common_Stack2);
 end Grt.Unithread;
diff --git a/src/vhdl/iirs_utils.adb b/src/vhdl/iirs_utils.adb
index 544b0d5da..189f0f371 100644
--- a/src/vhdl/iirs_utils.adb
+++ b/src/vhdl/iirs_utils.adb
@@ -350,6 +350,25 @@ package body Iirs_Utils is
       end if;
    end Is_Signal_Name;
 
+   function Is_Signal_Object (Name : Iir) return Boolean
+   is
+      Adecl: Iir;
+   begin
+      Adecl := Get_Object_Prefix (Name, True);
+      case Get_Kind (Adecl) is
+         when Iir_Kind_Signal_Declaration
+           | Iir_Kind_Interface_Signal_Declaration
+           | Iir_Kind_Guard_Signal_Declaration
+           | Iir_Kinds_Signal_Attribute =>
+            return True;
+         when Iir_Kind_Object_Alias_Declaration =>
+            --  Must have been handled by Get_Object_Prefix.
+            raise Internal_Error;
+         when others =>
+            return False;
+      end case;
+   end Is_Signal_Object;
+
    function Get_Association_Interface (Assoc : Iir) return Iir
    is
       Formal : Iir;
@@ -1201,24 +1220,6 @@ package body Iirs_Utils is
       end case;
    end Get_Entity_From_Entity_Aspect;
 
-   function Is_Signal_Object (Name : Iir) return Boolean
-   is
-      Adecl: Iir;
-   begin
-      Adecl := Get_Object_Prefix (Name, True);
-      case Get_Kind (Adecl) is
-         when Iir_Kind_Signal_Declaration
-           | Iir_Kind_Interface_Signal_Declaration
-           | Iir_Kind_Guard_Signal_Declaration
-           | Iir_Kinds_Signal_Attribute =>
-            return True;
-         when Iir_Kind_Object_Alias_Declaration =>
-            raise Internal_Error;
-         when others =>
-            return False;
-      end case;
-   end Is_Signal_Object;
-
    --  LRM08 4.7 Package declarations
    --  If the package header is empty, the package declared by a package
    --  declaration is called a simple package.
diff --git a/src/vhdl/sem_stmts.adb b/src/vhdl/sem_stmts.adb
index a1d3275e0..4541be455 100644
--- a/src/vhdl/sem_stmts.adb
+++ b/src/vhdl/sem_stmts.adb
@@ -1246,11 +1246,16 @@ package body Sem_Stmts is
                begin
                   Sem_Procedure_Call (Call, Stmt);
 
-                  --  Set suspend flag.
+                  --  Set suspend flag, if calling a suspendable procedure
+                  --  from a procedure or from a process.
                   Imp := Get_Implementation (Call);
                   if Imp /= Null_Iir
                     and then Get_Kind (Imp) = Iir_Kind_Procedure_Declaration
                     and then Get_Suspend_Flag (Imp)
+                    and then (Get_Kind (Get_Current_Subprogram)
+                                /= Iir_Kind_Function_Declaration)
+                    and then (Get_Kind (Get_Current_Subprogram)
+                                /= Iir_Kind_Sensitized_Process_Statement)
                   then
                      Set_Suspend_Flag (Stmt, True);
                      Mark_Suspendable (Stmt);
diff --git a/src/vhdl/translate/trans-chap2.adb b/src/vhdl/translate/trans-chap2.adb
index 5fa301b45..8a9f7a0ff 100644
--- a/src/vhdl/translate/trans-chap2.adb
+++ b/src/vhdl/translate/trans-chap2.adb
@@ -29,6 +29,7 @@ with Trans.Chap5;
 with Trans.Chap6;
 with Trans.Chap8;
 with Trans.Rtis;
+with Trans.Helpers2;
 with Trans_Decls; use Trans_Decls;
 with Translation; use Translation;
 
@@ -78,36 +79,6 @@ package body Trans.Chap2 is
       end if;
    end Push_Subprg_Identifier;
 
-   procedure Translate_Subprogram_Interfaces (Spec : Iir)
-   is
-      Inter : Iir;
-      Mark  : Id_Mark_Type;
-   begin
-      --  Set the identifier prefix with the subprogram identifier and
-      --  overload number if any.
-      Push_Subprg_Identifier (Spec, Mark);
-
-      --  Translate interface types.
-      Inter := Get_Interface_Declaration_Chain (Spec);
-      while Inter /= Null_Iir loop
-         Chap3.Translate_Object_Subtype (Inter);
-         Inter := Get_Chain (Inter);
-      end loop;
-      Pop_Identifier_Prefix (Mark);
-   end Translate_Subprogram_Interfaces;
-
-   procedure Elab_Subprogram_Interfaces (Spec : Iir)
-   is
-      Inter : Iir;
-   begin
-      --  Translate interface types.
-      Inter := Get_Interface_Declaration_Chain (Spec);
-      while Inter /= Null_Iir loop
-         Chap3.Elab_Object_Subtype (Get_Type (Inter));
-         Inter := Get_Chain (Inter);
-      end loop;
-   end Elab_Subprogram_Interfaces;
-
    --  Return the type of a subprogram interface.
    --  Return O_Tnode_Null if the parameter is passed through the
    --  interface record.
@@ -145,6 +116,76 @@ package body Trans.Chap2 is
       end if;
    end Translate_Interface_Type;
 
+   procedure Translate_Subprogram_Interfaces (Spec : Iir)
+   is
+      Inter : Iir;
+      Mark  : Id_Mark_Type;
+      Info  : Subprg_Info_Acc;
+      El_List : O_Element_List;
+      Arg_Info : Ortho_Info_Acc;
+   begin
+      --  Set the identifier prefix with the subprogram identifier and
+      --  overload number if any.
+      Push_Subprg_Identifier (Spec, Mark);
+
+      --  Translate interface types.
+      Inter := Get_Interface_Declaration_Chain (Spec);
+      while Inter /= Null_Iir loop
+         Chap3.Translate_Object_Subtype (Inter);
+         Inter := Get_Chain (Inter);
+      end loop;
+
+      if Get_Kind (Spec) = Iir_Kind_Procedure_Declaration then
+         --  Create the param record (except for foreign subprogram).
+         Info := Get_Info (Spec);
+         Inter := Get_Interface_Declaration_Chain (Spec);
+         if (Inter /= Null_Iir or else Get_Suspend_Flag (Spec))
+           and then not Get_Foreign_Flag (Spec)
+         then
+            Start_Record_Type (El_List);
+            while Inter /= Null_Iir loop
+               Arg_Info := Add_Info (Inter, Kind_Interface);
+               New_Record_Field (El_List, Arg_Info.Interface_Field,
+                                 Create_Identifier_Without_Prefix (Inter),
+                                 Translate_Interface_Type (Inter, False));
+               Inter := Get_Chain (Inter);
+            end loop;
+
+            if Get_Suspend_Flag (Spec) then
+               New_Record_Field (El_List, Info.Subprg_State_Field,
+                                 Get_Identifier ("STATE"), Ghdl_Index_Type);
+               New_Record_Field (El_List, Info.Subprg_Locvars_Field,
+                                 Get_Identifier ("FRAME"), Ghdl_Ptr_Type);
+            end if;
+
+            --  Declare the record type and an access to the record.
+            Finish_Record_Type (El_List, Info.Subprg_Params_Type);
+            New_Type_Decl (Create_Identifier ("PARAMSTYPE"),
+                           Info.Subprg_Params_Type);
+            Info.Subprg_Params_Ptr :=
+              New_Access_Type (Info.Subprg_Params_Type);
+            New_Type_Decl (Create_Identifier ("PARAMSPTR"),
+                           Info.Subprg_Params_Ptr);
+         else
+            Info.Subprg_Params_Type := O_Tnode_Null;
+            Info.Subprg_Params_Ptr := O_Tnode_Null;
+         end if;
+      end if;
+      Pop_Identifier_Prefix (Mark);
+   end Translate_Subprogram_Interfaces;
+
+   procedure Elab_Subprogram_Interfaces (Spec : Iir)
+   is
+      Inter : Iir;
+   begin
+      --  Translate interface types.
+      Inter := Get_Interface_Declaration_Chain (Spec);
+      while Inter /= Null_Iir loop
+         Chap3.Elab_Object_Subtype (Get_Type (Inter));
+         Inter := Get_Chain (Inter);
+      end loop;
+   end Elab_Subprogram_Interfaces;
+
    procedure Translate_Subprogram_Declaration (Spec : Iir)
    is
       Info : constant Subprg_Info_Acc := Get_Info (Spec);
@@ -155,7 +196,6 @@ package body Trans.Chap2 is
       Arg_Info : Ortho_Info_Acc;
       Tinfo : Type_Info_Acc;
       Interface_List : O_Inter_List;
-      El_List : O_Element_List;
       Mark : Id_Mark_Type;
       Rtype : Iir;
       Id : O_Ident;
@@ -213,33 +253,6 @@ package body Trans.Chap2 is
             Info.Res_Interface := O_Dnode_Null;
          end if;
       else
-         --  Create info for each interface of the procedure.
-         --  For parameters passed via copy and that needs a copy-out,
-         --  gather them in a record.  An access to the record is then
-         --  passed to the procedure.
-         Inter := Get_Interface_Declaration_Chain (Spec);
-         if Inter /= Null_Iir and then not Is_Foreign then
-            Start_Record_Type (El_List);
-            while Inter /= Null_Iir loop
-               Arg_Info := Add_Info (Inter, Kind_Interface);
-               New_Record_Field (El_List, Arg_Info.Interface_Field,
-                                 Create_Identifier_Without_Prefix (Inter),
-                                 Translate_Interface_Type (Inter, False));
-               Inter := Get_Chain (Inter);
-            end loop;
-            --  Declare the record type and an access to the record.
-            Finish_Record_Type (El_List, Info.Subprg_Params_Type);
-            New_Type_Decl (Create_Identifier ("PARAMSTYPE"),
-                           Info.Subprg_Params_Type);
-            Info.Subprg_Params_Ptr :=
-              New_Access_Type (Info.Subprg_Params_Type);
-            New_Type_Decl (Create_Identifier ("PARAMSPTR"),
-                           Info.Subprg_Params_Ptr);
-         else
-            Info.Subprg_Params_Type := O_Tnode_Null;
-            Info.Subprg_Params_Ptr := O_Tnode_Null;
-         end if;
-
          Start_Procedure_Decl (Interface_List, Id, Storage);
 
          if Info.Subprg_Params_Type /= O_Tnode_Null then
@@ -349,6 +362,12 @@ package body Trans.Chap2 is
       Spec : constant Iir := Get_Subprogram_Specification (Subprg);
       Info : constant Ortho_Info_Acc := Get_Info (Spec);
 
+      --  True if the subprogram is suspendable (can be true only for
+      --  procedures).
+      Has_Suspend : constant Boolean :=
+        Get_Kind (Spec) = Iir_Kind_Procedure_Declaration
+        and then Get_Suspend_Flag (Spec);
+
       Old_Subprogram : Iir;
       Mark           : Id_Mark_Type;
       Final          : Boolean;
@@ -390,39 +409,49 @@ package body Trans.Chap2 is
       Push_Subprg_Identifier (Spec, Mark);
       Restore_Local_Identifier (Info.Subprg_Local_Id);
 
-      if Has_Nested then
+      if Has_Nested or else Has_Suspend then
          --  Unnest subprograms.
          --  Create an instance for the local declarations.
          Push_Instance_Factory (Info.Subprg_Frame_Scope'Access);
          Add_Subprg_Instance_Field (Upframe_Field);
 
          if Info.Subprg_Params_Ptr /= O_Tnode_Null then
+            --  Field for the parameters structure
             Info.Subprg_Params_Var :=
-              Create_Var (Create_Var_Identifier ("RESULT"),
+              Create_Var (Create_Var_Identifier ("PARAMS"),
                           Info.Subprg_Params_Ptr);
+         else
+            --  Create fields for parameters.
+            --  FIXME: do it only if they are referenced in nested
+            --  subprograms.
+            declare
+               Inter      : Iir;
+               Inter_Info : Inter_Info_Acc;
+            begin
+               Inter := Get_Interface_Declaration_Chain (Spec);
+               while Inter /= Null_Iir loop
+                  Inter_Info := Get_Info (Inter);
+                  if Inter_Info.Interface_Node /= O_Dnode_Null then
+                     Inter_Info.Interface_Field :=
+                       Add_Instance_Factory_Field
+                       (Create_Identifier_Without_Prefix (Inter),
+                        Inter_Info.Interface_Type);
+                  end if;
+                  Inter := Get_Chain (Inter);
+               end loop;
+            end;
          end if;
 
-         --  Create fields for parameters.
-         --  FIXME: do it only if they are referenced in nested
-         --  subprograms.
-         declare
-            Inter      : Iir;
-            Inter_Info : Inter_Info_Acc;
-         begin
-            Inter := Get_Interface_Declaration_Chain (Spec);
-            while Inter /= Null_Iir loop
-               Inter_Info := Get_Info (Inter);
-               if Inter_Info.Interface_Node /= O_Dnode_Null then
-                  Inter_Info.Interface_Field :=
-                    Add_Instance_Factory_Field
-                      (Create_Identifier_Without_Prefix (Inter),
-                       Inter_Info.Interface_Type);
-               end if;
-               Inter := Get_Chain (Inter);
-            end loop;
-         end;
-
          Chap4.Translate_Declaration_Chain (Subprg);
+
+         if Has_Suspend then
+            --  Add declarations for statements (iterator, call) and state.
+            Chap4.Translate_Statements_Chain_State_Declaration
+              (Get_Sequential_Statement_Chain (Subprg),
+               Info.Subprg_Locvars_Scope'Access);
+            Add_Scope_Field (Wki_Locvars, Info.Subprg_Locvars_Scope);
+         end if;
+
          Pop_Instance_Factory (Info.Subprg_Frame_Scope'Access);
 
          New_Type_Decl (Create_Identifier ("_FRAMETYPE"),
@@ -466,18 +495,52 @@ package body Trans.Chap2 is
       --  There is a local scope for temporaries.
       Open_Local_Temp;
 
-      if not Has_Nested then
+      if not Has_Suspend and not Has_Nested then
          Chap4.Translate_Declaration_Chain (Subprg);
          Rtis.Generate_Subprogram_Body (Subprg);
          Chap4.Translate_Declaration_Chain_Subprograms (Subprg);
       else
-         New_Var_Decl (Frame, Wki_Frame, O_Storage_Local,
-                       Get_Scope_Type (Info.Subprg_Frame_Scope));
-
          New_Var_Decl (Frame_Ptr, Get_Identifier ("FRAMEPTR"),
                        O_Storage_Local, Frame_Ptr_Type);
-         New_Assign_Stmt (New_Obj (Frame_Ptr),
-                          New_Address (New_Obj (Frame), Frame_Ptr_Type));
+
+         if Has_Suspend then
+            New_Assign_Stmt
+              (New_Obj (Frame_Ptr),
+               New_Convert_Ov (New_Value_Selected_Acc_Value
+                                 (New_Obj (Info.Res_Interface),
+                                  Info.Subprg_Locvars_Field),
+                               Frame_Ptr_Type));
+
+            Chap8.State_Entry (Info);
+
+            --  Initial state: allocate frame.
+            New_Assign_Stmt
+              (New_Obj (Frame_Ptr),
+               Helpers2.Gen_Alloc
+                 (Alloc_Return,
+                  New_Lit
+                    (New_Sizeof (Get_Scope_Type (Info.Subprg_Frame_Scope),
+                                 Ghdl_Index_Type)),
+                  Frame_Ptr_Type));
+            New_Assign_Stmt
+              (New_Selected_Acc_Value (New_Obj (Info.Res_Interface),
+                                       Info.Subprg_Locvars_Field),
+               New_Convert_Ov (New_Obj_Value (Frame_Ptr),
+                               Ghdl_Ptr_Type));
+
+            --  Allocate the return state.  This IS NOT AN ASSERTION as the
+            --  State_Allocate function has a side-effect.
+            if Chap8.State_Allocate /= Chap8.State_Return then
+               raise Internal_Error;
+            end if;
+         else
+            --  Allocate the frame by declaring a local variable.
+            New_Var_Decl (Frame, Wki_Frame, O_Storage_Local,
+                          Get_Scope_Type (Info.Subprg_Frame_Scope));
+
+            New_Assign_Stmt (New_Obj (Frame_Ptr),
+                             New_Address (New_Obj (Frame), Frame_Ptr_Type));
+         end if;
 
          --  FIXME: use direct reference (ie Frame instead of Frame_Ptr)
          Set_Scope_Via_Param_Ptr (Info.Subprg_Frame_Scope, Frame_Ptr);
@@ -487,7 +550,7 @@ package body Trans.Chap2 is
            (Frame_Ptr, Upframe_Field, Info.Subprg_Instance);
 
          if Info.Subprg_Params_Type /= O_Tnode_Null then
-            --  Initialize the RESULT field
+            --  Initialize the PARAMS field
             New_Assign_Stmt (Get_Var (Info.Subprg_Params_Var),
                              New_Obj_Value (Info.Res_Interface));
             --  Do not reference the RESULT field in the subprogram body,
@@ -497,42 +560,43 @@ package body Trans.Chap2 is
          end if;
 
          --  Copy parameters to FRAME.
-         declare
-            Inter      : Iir;
-            Inter_Info : Inter_Info_Acc;
-         begin
-            Inter := Get_Interface_Declaration_Chain (Spec);
-            while Inter /= Null_Iir loop
-               Inter_Info := Get_Info (Inter);
-               if Inter_Info.Interface_Node /= O_Dnode_Null then
-                  New_Assign_Stmt
-                    (New_Selected_Element (New_Obj (Frame),
-                     Inter_Info.Interface_Field),
-                     New_Obj_Value (Inter_Info.Interface_Node));
-
-                  --  Forget the reference to the field in FRAME, so that
-                  --  this subprogram will directly reference the parameter
-                  --  (and not its copy in the FRAME).
-                  Inter_Info.Interface_Field := O_Fnode_Null;
-               end if;
-               Inter := Get_Chain (Inter);
-            end loop;
-         end;
+         if Info.Subprg_Params_Ptr = O_Tnode_Null then
+            declare
+               Inter      : Iir;
+               Inter_Info : Inter_Info_Acc;
+            begin
+               Inter := Get_Interface_Declaration_Chain (Spec);
+               while Inter /= Null_Iir loop
+                  Inter_Info := Get_Info (Inter);
+                  if Inter_Info.Interface_Node /= O_Dnode_Null then
+                     New_Assign_Stmt
+                       (New_Selected_Element (New_Obj (Frame),
+                                              Inter_Info.Interface_Field),
+                        New_Obj_Value (Inter_Info.Interface_Node));
+
+                     --  Forget the reference to the field in FRAME, so that
+                     --  this subprogram will directly reference the parameter
+                     --  (and not its copy in the FRAME).
+                     Inter_Info.Interface_Field := O_Fnode_Null;
+                  end if;
+                  Inter := Get_Chain (Inter);
+               end loop;
+            end;
+         end if;
+      end if;
+
+      Is_Prot := Is_Subprogram_Method (Spec);
+      if Is_Prot then
+         --  Lock the object.
+         Chap3.Call_Ghdl_Protected_Procedure (Get_Method_Type (Spec),
+                                              Ghdl_Protected_Enter);
       end if;
 
       Chap4.Elab_Declaration_Chain (Subprg, Final);
 
-      --  If finalization is required, create a dummy loop around the
-      --  body and convert returns into exit out of this loop.
-      --  If the subprogram is a function, also create a variable for the
-      --  result.
-      Is_Prot := Is_Subprogram_Method (Spec);
+      --  If finalization is required and if the subprogram is a function,
+      --  create a variable for the result.
       if Final or Is_Prot then
-         if Is_Prot then
-            --  Lock the object.
-            Chap3.Call_Ghdl_Protected_Procedure (Get_Method_Type (Spec),
-                                                 Ghdl_Protected_Enter);
-         end if;
          Is_Ortho_Func := Is_Subprogram_Ortho_Function (Spec);
          if Is_Ortho_Func then
             New_Var_Decl
@@ -540,6 +604,11 @@ package body Trans.Chap2 is
                O_Storage_Local,
                Get_Ortho_Type (Get_Return_Type (Spec), Mode_Value));
          end if;
+      end if;
+
+      --  If finalization is required, create a dummy loop around the
+      --  body and convert returns into exit out of this loop.
+      if not Has_Suspend and then (Final or Is_Prot) then
          Start_Loop_Stmt (Info.Subprg_Exit);
       end if;
 
@@ -549,10 +618,14 @@ package body Trans.Chap2 is
         (Get_Sequential_Statement_Chain (Subprg));
       Current_Subprogram := Old_Subprogram;
 
-      if Final or Is_Prot then
+      if Has_Suspend or Final or Is_Prot then
          --  Create a barrier to catch missing return statement.
          if Get_Kind (Spec) = Iir_Kind_Procedure_Declaration then
-            New_Exit_Stmt (Info.Subprg_Exit);
+            if Has_Suspend then
+               Chap8.State_Jump (Chap8.State_Return);
+            else
+               New_Exit_Stmt (Info.Subprg_Exit);
+            end if;
          else
             if not Has_Return then
                --  Missing return
@@ -560,7 +633,11 @@ package body Trans.Chap2 is
                  (Subprg, Chap6.Prg_Err_Missing_Return);
             end if;
          end if;
-         Finish_Loop_Stmt (Info.Subprg_Exit);
+         if Has_Suspend then
+            Chap8.State_Start (Chap8.State_Return);
+         else
+            Finish_Loop_Stmt (Info.Subprg_Exit);
+         end if;
          Chap4.Final_Declaration_Chain (Subprg, False);
 
          if Is_Prot then
@@ -568,6 +645,12 @@ package body Trans.Chap2 is
             Chap3.Call_Ghdl_Protected_Procedure (Get_Method_Type (Spec),
                                                  Ghdl_Protected_Leave);
          end if;
+
+         if Has_Suspend then
+            Chap8.State_Suspend (Chap8.State_Return);
+            Chap8.State_Leave (Spec);
+         end if;
+
          if Is_Ortho_Func then
             New_Return_Stmt (New_Obj_Value (Info.Subprg_Result));
          end if;
@@ -896,6 +979,9 @@ package body Trans.Chap2 is
                Subprg_Params_Var => Instantiate_Var (Src.Subprg_Params_Var),
                Subprg_Params_Type => Src.Subprg_Params_Type,
                Subprg_Params_Ptr => Src.Subprg_Params_Ptr,
+               Subprg_State_Field => Src.Subprg_State_Field,
+               Subprg_Locvars_Field => Src.Subprg_Locvars_Field,
+               Subprg_Locvars_Scope => Src.Subprg_Locvars_Scope,
                Subprg_Frame_Scope => Dest.Subprg_Frame_Scope,
                Subprg_Instance => Instantiate_Subprg_Instance
                  (Src.Subprg_Instance),
diff --git a/src/vhdl/translate/trans-chap3.adb b/src/vhdl/translate/trans-chap3.adb
index 6ab280243..fd946d16e 100644
--- a/src/vhdl/translate/trans-chap3.adb
+++ b/src/vhdl/translate/trans-chap3.adb
@@ -2641,6 +2641,20 @@ package body Trans.Chap3 is
       end if;
    end Get_Object_Size;
 
+   procedure Copy_Bounds (Dest : O_Enode; Src : O_Enode; Obj_Type : Iir)
+   is
+      Tinfo : constant Type_Info_Acc := Get_Info (Obj_Type);
+   begin
+      Gen_Memcpy
+        (Dest, Src,
+         New_Lit (New_Sizeof (Tinfo.T.Bounds_Type, Ghdl_Index_Type)));
+   end Copy_Bounds;
+
+   procedure Copy_Bounds (Dest : Mnode; Src : Mnode; Obj_Type : Iir) is
+   begin
+      Copy_Bounds (M2Addr (Dest), M2Addr (Src), Obj_Type);
+   end Copy_Bounds;
+
    procedure Translate_Object_Allocation
      (Res        : in out Mnode;
       Alloc_Kind : Allocation_Kind;
@@ -2660,10 +2674,7 @@ package body Trans.Chap3 is
                        Dinfo.T.Bounds_Ptr_Type));
 
          --  Copy bounds to the allocated area.
-         Gen_Memcpy
-           (M2Addr (Chap3.Get_Array_Bounds (Res)),
-            M2Addr (Bounds),
-            New_Lit (New_Sizeof (Dinfo.T.Bounds_Type, Ghdl_Index_Type)));
+         Copy_Bounds (Chap3.Get_Array_Bounds (Res), Bounds, Obj_Type);
 
          --  Allocate base.
          Allocate_Fat_Array_Base (Alloc_Kind, Res, Obj_Type);
diff --git a/src/vhdl/translate/trans-chap3.ads b/src/vhdl/translate/trans-chap3.ads
index 459b1c84c..f7a23fdc7 100644
--- a/src/vhdl/translate/trans-chap3.ads
+++ b/src/vhdl/translate/trans-chap3.ads
@@ -180,6 +180,9 @@ package Trans.Chap3 is
    --  Performs deallocation of PARAM (the parameter of a deallocate call).
    procedure Translate_Object_Deallocation (Param : Iir);
 
+   --  Copy bounds from SRC to DEST.
+   procedure Copy_Bounds (Dest : O_Enode; Src : O_Enode; Obj_Type : Iir);
+
    --  Allocate an object of type OBJ_TYPE and set RES.
    --  RES must be a stable access of type ortho_ptr_type.
    --  For an unconstrained array, BOUNDS is a pointer to the boundaries of
diff --git a/src/vhdl/translate/trans-chap4.adb b/src/vhdl/translate/trans-chap4.adb
index 70f41651b..a33f9ca5b 100644
--- a/src/vhdl/translate/trans-chap4.adb
+++ b/src/vhdl/translate/trans-chap4.adb
@@ -20,12 +20,14 @@ with Errorout; use Errorout;
 with Files_Map;
 with Iirs_Utils; use Iirs_Utils;
 with Std_Package; use Std_Package;
+with Canon;
 with Translation; use Translation;
 with Trans.Chap2;
 with Trans.Chap3;
 with Trans.Chap5;
 with Trans.Chap6;
 with Trans.Chap7;
+with Trans.Chap8;
 with Trans.Chap9;
 with Trans.Chap14;
 with Trans.Rtis;
@@ -462,9 +464,8 @@ package body Trans.Chap4 is
          if Type_Info.Type_Mode = Type_Mode_Fat_Array then
             --  Allocate.
             declare
-               Aggr_Type : Iir;
+               Aggr_Type : constant Iir := Get_Type (Value);
             begin
-               Aggr_Type := Get_Type (Value);
                Chap3.Create_Array_Subtype (Aggr_Type);
                Name_Node := Stabilize (Name);
                New_Assign_Stmt
@@ -2025,6 +2026,157 @@ package body Trans.Chap4 is
       end loop;
    end Translate_Declaration_Chain;
 
+   procedure Translate_Statements_Chain_State_Declaration
+     (Stmts : Iir; State_Scope : Var_Scope_Acc)
+   is
+      Num : Nat32;
+      Mark : Id_Mark_Type;
+      Locvar_Id : O_Ident;
+      Els : O_Element_List;
+
+      procedure Push_Prefix (Really_Push : Boolean := True)
+      is
+         Num_Img : String := Nat32'Image (Num);
+      begin
+         Num_Img (Num_Img'First) := 'S';
+         Locvar_Id := Get_Identifier (Num_Img);
+         Num := Num + 1;
+         if Really_Push then
+            Push_Identifier_Prefix (Mark, Num_Img);
+         end if;
+      end Push_Prefix;
+
+      procedure Pop_Prefix (Scope : in out Var_Scope_Type;
+                            Really_Push : Boolean := True)
+      is
+         Locvar_Field : O_Fnode;
+      begin
+         if Really_Push then
+            Pop_Identifier_Prefix (Mark);
+         end if;
+
+         New_Union_Field
+           (Els, Locvar_Field, Locvar_Id, Get_Scope_Type (Scope));
+         Set_Scope_Via_Field (Scope, Locvar_Field, State_Scope);
+      end Pop_Prefix;
+
+      Info : Ortho_Info_Acc;
+      Stmt : Iir;
+      Chain : Iir;
+      Scope_Type : O_Tnode;
+   begin
+      Stmt := Stmts;
+
+      Start_Union_Type (Els);
+      Num := 0;
+
+      while Stmt /= Null_Iir loop
+         case Get_Kind (Stmt) is
+            when Iir_Kind_If_Statement =>
+               if Get_Suspend_Flag (Stmt) then
+                  Chain := Stmt;
+                  while Chain /= Null_Iir loop
+                     Push_Prefix;
+
+                     Info := Add_Info (Chain, Kind_Locvar_State);
+
+                     Translate_Statements_Chain_State_Declaration
+                       (Get_Sequential_Statement_Chain (Chain),
+                        Info.Locvar_Scope'Access);
+
+                     Pop_Prefix (Info.Locvar_Scope);
+
+                     Chain := Get_Else_Clause (Chain);
+                  end loop;
+               end if;
+
+            when Iir_Kind_Case_Statement =>
+               if Get_Suspend_Flag (Stmt) then
+                  Chain := Get_Case_Statement_Alternative_Chain (Stmt);
+                  while Chain /= Null_Iir loop
+                     if not Get_Same_Alternative_Flag (Chain) then
+                        Push_Prefix;
+
+                        Info := Add_Info (Chain, Kind_Locvar_State);
+
+                        Translate_Statements_Chain_State_Declaration
+                          (Get_Associated_Chain (Chain),
+                           Info.Locvar_Scope'Access);
+
+                        Pop_Prefix (Info.Locvar_Scope);
+                     end if;
+                     Chain := Get_Chain (Chain);
+                  end loop;
+               end if;
+
+            when Iir_Kind_While_Loop_Statement =>
+               if Get_Suspend_Flag (Stmt) then
+                  Push_Prefix;
+
+                  Info := Add_Info (Stmt, Kind_Loop_State);
+
+                  Translate_Statements_Chain_State_Declaration
+                    (Get_Sequential_Statement_Chain (Stmt),
+                     Info.Loop_Locvar_Scope'Access);
+
+                  Pop_Prefix (Info.Loop_Locvar_Scope);
+               end if;
+
+            when Iir_Kind_For_Loop_Statement =>
+               if Get_Suspend_Flag (Stmt) then
+                  Push_Prefix;
+
+                  Info := Add_Info (Stmt, Kind_Loop_State);
+
+                  Push_Instance_Factory (Info.Loop_State_Scope'Access);
+
+                  Chap8.Translate_For_Loop_Statement_Declaration (Stmt);
+
+                  Translate_Statements_Chain_State_Declaration
+                    (Get_Sequential_Statement_Chain (Stmt),
+                     Info.Loop_Locvar_Scope'Access);
+
+                  Add_Scope_Field (Wki_Locvars, Info.Loop_Locvar_Scope);
+
+                  Pop_Instance_Factory (Info.Loop_State_Scope'Access);
+
+                  New_Type_Decl (Create_Identifier ("FORTYPE"),
+                                 Get_Scope_Type (Info.Loop_State_Scope));
+
+                  Pop_Prefix (Info.Loop_State_Scope);
+               end if;
+
+            when Iir_Kind_Procedure_Call_Statement =>
+               declare
+                  Call : constant Iir := Get_Procedure_Call (Stmt);
+                  Imp : constant Iir := Get_Implementation (Call);
+               begin
+                  Canon.Canon_Subprogram_Call (Call);
+                  Update_Node_Infos;
+
+                  if Get_Suspend_Flag (Imp) then
+                     Push_Prefix;
+
+                     Info := Add_Info (Call, Kind_Call);
+
+                     Chap8.Translate_Procedure_Call_State (Call);
+
+                     Pop_Prefix (Info.Call_State_Scope);
+                  end if;
+               end;
+            when others =>
+               null;
+         end case;
+         Stmt := Get_Chain (Stmt);
+      end loop;
+
+      Finish_Union_Type (Els, Scope_Type);
+
+      New_Type_Decl
+        (Create_Identifier ("LOCVARTYPE"), Scope_Type);
+      Create_Union_Scope (State_Scope.all, Scope_Type);
+   end Translate_Statements_Chain_State_Declaration;
+
    procedure Translate_Declaration_Chain_Subprograms (Parent : Iir)
    is
       El     : Iir;
diff --git a/src/vhdl/translate/trans-chap4.ads b/src/vhdl/translate/trans-chap4.ads
index 6f9b8aefc..317d10342 100644
--- a/src/vhdl/translate/trans-chap4.ads
+++ b/src/vhdl/translate/trans-chap4.ads
@@ -31,6 +31,10 @@ package Trans.Chap4 is
    --  Translate declarations, except subprograms spec and bodies.
    procedure Translate_Declaration_Chain (Parent : Iir);
 
+   --  Create declarations for statements STMTS to support resume.
+   procedure Translate_Statements_Chain_State_Declaration
+     (Stmts : Iir; State_Scope : Var_Scope_Acc);
+
    --  Translate subprograms in declaration chain of PARENT.
    procedure Translate_Declaration_Chain_Subprograms (Parent : Iir);
 
diff --git a/src/vhdl/translate/trans-chap6.adb b/src/vhdl/translate/trans-chap6.adb
index 9640f4422..96453f2d7 100644
--- a/src/vhdl/translate/trans-chap6.adb
+++ b/src/vhdl/translate/trans-chap6.adb
@@ -739,7 +739,7 @@ package body Trans.Chap6 is
 
    function Translate_Interface_Name
      (Inter : Iir; Info : Ortho_Info_Acc; Kind : Object_Kind_Type)
-         return Mnode
+     return Mnode
    is
       Type_Info : constant Type_Info_Acc := Get_Info (Get_Type (Inter));
    begin
@@ -1016,7 +1016,7 @@ package body Trans.Chap6 is
                   Assoc_Chain := Get_Parameter_Association_Chain (Name);
                   Obj := Get_Method_Object (Name);
                   return E2M
-                    (Chap8.Translate_Subprogram_Call (Imp, Assoc_Chain, Obj),
+                    (Chap8.Translate_Subprogram_Call (Name, Assoc_Chain, Obj),
                      Type_Info, Mode_Value);
                end if;
             end;
diff --git a/src/vhdl/translate/trans-chap6.ads b/src/vhdl/translate/trans-chap6.ads
index 5a11fb6c3..3ce60c3a5 100644
--- a/src/vhdl/translate/trans-chap6.ads
+++ b/src/vhdl/translate/trans-chap6.ads
@@ -57,6 +57,7 @@ package Trans.Chap6 is
    Prg_Err_Dummy_Config     : constant Natural := 3;
    Prg_Err_No_Choice        : constant Natural := 4;
    Prg_Err_Bad_Choice       : constant Natural := 5;
+   Prg_Err_Unreach_State    : constant Natural := 6;
    procedure Gen_Program_Error (Loc : Iir; Code : Natural);
 
    --  Generate code to emit a failure if COND is TRUE, indicating an
diff --git a/src/vhdl/translate/trans-chap7.adb b/src/vhdl/translate/trans-chap7.adb
index 7f12ff120..081526b2e 100644
--- a/src/vhdl/translate/trans-chap7.adb
+++ b/src/vhdl/translate/trans-chap7.adb
@@ -700,8 +700,10 @@ package body Trans.Chap7 is
    end Translate_Range_Length;
 
    function Translate_Operator_Function_Call
-     (Imp : Iir; Left : Iir;  Right : Iir; Res_Type : Iir) return O_Enode
+     (Call : Iir; Left : Iir;  Right : Iir; Res_Type : Iir) return O_Enode
    is
+      Imp : constant Iir := Get_Implementation (Call);
+
       function Create_Assoc (Actual : Iir; Formal : Iir) return Iir
       is
          R : Iir;
@@ -728,7 +730,7 @@ package body Trans.Chap7 is
          Set_Chain (El_L, El_R);
       end if;
 
-      Res := Chap8.Translate_Subprogram_Call (Imp, El_L, Null_Iir);
+      Res := Chap8.Translate_Subprogram_Call (Call, El_L, Null_Iir);
 
       Free_Iir (El_L);
       if Right /= Null_Iir then
@@ -1997,13 +1999,11 @@ package body Trans.Chap7 is
    end Translate_Predefined_Std_Ulogic_Array_Match;
 
    function Translate_Predefined_Operator
-     (Imp         : Iir_Function_Declaration;
-      Left, Right : Iir;
-      Res_Type    : Iir;
-      Loc         : Iir)
+     (Expr : Iir_Function_Declaration; Left, Right : Iir; Res_Type : Iir)
      return O_Enode
    is
-      Kind       : constant Iir_Predefined_Functions :=
+      Imp : constant Iir := Get_Implementation (Expr);
+      Kind : constant Iir_Predefined_Functions :=
         Get_Implicit_Definition (Imp);
       Left_Tree  : O_Enode;
       Right_Tree : O_Enode;
@@ -2049,40 +2049,40 @@ package body Trans.Chap7 is
             --  same for the result.
          when Iir_Predefined_TF_Array_Element_And =>
             return Translate_Predefined_TF_Array_Element
-              (Iir_Predefined_Boolean_And, Left, Right, Res_Type, Loc);
+              (Iir_Predefined_Boolean_And, Left, Right, Res_Type, Expr);
          when Iir_Predefined_TF_Element_Array_And =>
             return Translate_Predefined_TF_Array_Element
-              (Iir_Predefined_Boolean_And, Right, Left, Res_Type, Loc);
+              (Iir_Predefined_Boolean_And, Right, Left, Res_Type, Expr);
          when Iir_Predefined_TF_Array_Element_Or =>
             return Translate_Predefined_TF_Array_Element
-              (Iir_Predefined_Boolean_Or, Left, Right, Res_Type, Loc);
+              (Iir_Predefined_Boolean_Or, Left, Right, Res_Type, Expr);
          when Iir_Predefined_TF_Element_Array_Or =>
             return Translate_Predefined_TF_Array_Element
-              (Iir_Predefined_Boolean_Or, Right, Left, Res_Type, Loc);
+              (Iir_Predefined_Boolean_Or, Right, Left, Res_Type, Expr);
          when Iir_Predefined_TF_Array_Element_Nand =>
             return Translate_Predefined_TF_Array_Element
-              (Iir_Predefined_Boolean_Nand, Left, Right, Res_Type, Loc);
+              (Iir_Predefined_Boolean_Nand, Left, Right, Res_Type, Expr);
          when Iir_Predefined_TF_Element_Array_Nand =>
             return Translate_Predefined_TF_Array_Element
-              (Iir_Predefined_Boolean_Nand, Right, Left, Res_Type, Loc);
+              (Iir_Predefined_Boolean_Nand, Right, Left, Res_Type, Expr);
          when Iir_Predefined_TF_Array_Element_Nor =>
             return Translate_Predefined_TF_Array_Element
-              (Iir_Predefined_Boolean_Nor, Left, Right, Res_Type, Loc);
+              (Iir_Predefined_Boolean_Nor, Left, Right, Res_Type, Expr);
          when Iir_Predefined_TF_Element_Array_Nor =>
             return Translate_Predefined_TF_Array_Element
-              (Iir_Predefined_Boolean_Nor, Right, Left, Res_Type, Loc);
+              (Iir_Predefined_Boolean_Nor, Right, Left, Res_Type, Expr);
          when Iir_Predefined_TF_Array_Element_Xor =>
             return Translate_Predefined_TF_Array_Element
-              (Iir_Predefined_Boolean_Xor, Left, Right, Res_Type, Loc);
+              (Iir_Predefined_Boolean_Xor, Left, Right, Res_Type, Expr);
          when Iir_Predefined_TF_Element_Array_Xor =>
             return Translate_Predefined_TF_Array_Element
-              (Iir_Predefined_Boolean_Xor, Right, Left, Res_Type, Loc);
+              (Iir_Predefined_Boolean_Xor, Right, Left, Res_Type, Expr);
          when Iir_Predefined_TF_Array_Element_Xnor =>
             return Translate_Predefined_TF_Array_Element
-              (Iir_Predefined_Boolean_Xnor, Left, Right, Res_Type, Loc);
+              (Iir_Predefined_Boolean_Xnor, Left, Right, Res_Type, Expr);
          when Iir_Predefined_TF_Element_Array_Xnor =>
             return Translate_Predefined_TF_Array_Element
-              (Iir_Predefined_Boolean_Xnor, Right, Left, Res_Type, Loc);
+              (Iir_Predefined_Boolean_Xnor, Right, Left, Res_Type, Expr);
 
             --  Avoid implicit conversion of the array parameters to the
             --  unbounded type for optimizing purpose.
@@ -2180,7 +2180,7 @@ package body Trans.Chap7 is
                raise Internal_Error;
          end case;
          Res := Translate_Implicit_Conv
-           (Res, Get_Return_Type (Imp), Res_Type, Mode_Value, Loc);
+           (Res, Get_Return_Type (Imp), Res_Type, Mode_Value, Expr);
          return Res;
       end if;
 
@@ -2205,7 +2205,7 @@ package body Trans.Chap7 is
             | Iir_Predefined_Floating_Identity
             | Iir_Predefined_Physical_Identity =>
             return Translate_Implicit_Conv
-              (Left_Tree, Left_Type, Res_Type, Mode_Value, Loc);
+              (Left_Tree, Left_Type, Res_Type, Mode_Value, Expr);
 
          when Iir_Predefined_Access_Equality
             | Iir_Predefined_Access_Inequality =>
@@ -2449,21 +2449,21 @@ package body Trans.Chap7 is
          when Iir_Predefined_Array_Minimum =>
             return Translate_Predefined_Array_Min_Max
               (True, Left_Tree, Right_Tree, Left_Type, Right_Type,
-               Res_Type, Imp, Loc);
+               Res_Type, Imp, Expr);
          when Iir_Predefined_Array_Maximum =>
             return Translate_Predefined_Array_Min_Max
               (False, Left_Tree, Right_Tree, Left_Type, Right_Type,
-               Res_Type, Imp, Loc);
+               Res_Type, Imp, Expr);
 
          when Iir_Predefined_Integer_To_String =>
             case Get_Info (Left_Type).Type_Mode is
                when Type_Mode_I32 =>
                   return Translate_To_String
-                    (Ghdl_To_String_I32, Res_Type, Loc,
+                    (Ghdl_To_String_I32, Res_Type, Expr,
                      New_Convert_Ov (Left_Tree, Ghdl_I32_Type));
                when Type_Mode_I64 =>
                   return Translate_To_String
-                    (Ghdl_To_String_I64, Res_Type, Loc,
+                    (Ghdl_To_String_I64, Res_Type, Expr,
                      New_Convert_Ov (Left_Tree, Ghdl_I64_Type));
                when others =>
                   raise Internal_Error;
@@ -2475,7 +2475,7 @@ package body Trans.Chap7 is
             --  So special case for character.
             if Get_Base_Type (Left_Type) = Character_Type_Definition then
                return Translate_To_String
-                 (Ghdl_To_String_Char, Res_Type, Loc, Left_Tree);
+                 (Ghdl_To_String_Char, Res_Type, Expr, Left_Tree);
             end if;
 
             --  LRM08 5.7 String representations
@@ -2498,23 +2498,23 @@ package body Trans.Chap7 is
                      raise Internal_Error;
                end case;
                return Translate_To_String
-                 (Subprg, Res_Type, Loc,
+                 (Subprg, Res_Type, Expr,
                   New_Convert_Ov (Left_Tree, Conv),
                   New_Lit (Rtis.New_Rti_Address
                     (Get_Info (Left_Type).Type_Rti)));
             end;
          when Iir_Predefined_Floating_To_String =>
             return Translate_To_String
-              (Ghdl_To_String_F64, Res_Type, Loc,
+              (Ghdl_To_String_F64, Res_Type, Expr,
                New_Convert_Ov (Left_Tree, Ghdl_Real_Type));
          when Iir_Predefined_Real_To_String_Digits =>
             return Translate_To_String
-              (Ghdl_To_String_F64_Digits, Res_Type, Loc,
+              (Ghdl_To_String_F64_Digits, Res_Type, Expr,
                New_Convert_Ov (Left_Tree, Ghdl_Real_Type),
                New_Convert_Ov (Right_Tree, Ghdl_I32_Type));
          when Iir_Predefined_Real_To_String_Format =>
             return Translate_To_String
-              (Ghdl_To_String_F64_Format, Res_Type, Loc,
+              (Ghdl_To_String_F64_Format, Res_Type, Expr,
                New_Convert_Ov (Left_Tree, Ghdl_Real_Type),
                Right_Tree);
          when Iir_Predefined_Physical_To_String =>
@@ -2533,23 +2533,23 @@ package body Trans.Chap7 is
                      raise Internal_Error;
                end case;
                return Translate_To_String
-                 (Subprg, Res_Type, Loc,
+                 (Subprg, Res_Type, Expr,
                   New_Convert_Ov (Left_Tree, Conv),
                   New_Lit (Rtis.New_Rti_Address
                     (Get_Info (Left_Type).Type_Rti)));
             end;
          when Iir_Predefined_Time_To_String_Unit =>
             return Translate_To_String
-              (Ghdl_Time_To_String_Unit, Res_Type, Loc,
+              (Ghdl_Time_To_String_Unit, Res_Type, Expr,
                Left_Tree, Right_Tree,
                New_Lit (Rtis.New_Rti_Address
                  (Get_Info (Left_Type).Type_Rti)));
          when Iir_Predefined_Bit_Vector_To_Ostring =>
             return Translate_Bv_To_String
-              (Ghdl_BV_To_Ostring, Left_Tree, Left_Type, Res_Type, Loc);
+              (Ghdl_BV_To_Ostring, Left_Tree, Left_Type, Res_Type, Expr);
          when Iir_Predefined_Bit_Vector_To_Hstring =>
             return Translate_Bv_To_String
-              (Ghdl_BV_To_Hstring, Left_Tree, Left_Type, Res_Type, Loc);
+              (Ghdl_BV_To_Hstring, Left_Tree, Left_Type, Res_Type, Expr);
          when Iir_Predefined_Array_Char_To_String =>
             declare
                El_Type : constant Iir := Get_Element_Subtype (Left_Type);
@@ -2569,7 +2569,7 @@ package body Trans.Chap7 is
                      raise Internal_Error;
                end case;
                return Translate_To_String
-                 (Subprg, Res_Type, Loc,
+                 (Subprg, Res_Type, Expr,
                   New_Convert_Ov (M2E (Chap3.Get_Array_Base (Arg)),
                     Ghdl_Ptr_Type),
                   Chap3.Get_Array_Length (Arg, Left_Type),
@@ -3923,19 +3923,19 @@ package body Trans.Chap7 is
             Imp := Get_Implementation (Expr);
             if Is_Implicit_Subprogram (Imp) then
                return Translate_Predefined_Operator
-                 (Imp, Get_Left (Expr), Get_Right (Expr), Res_Type, Expr);
+                 (Expr, Get_Left (Expr), Get_Right (Expr), Res_Type);
             else
                return Translate_Operator_Function_Call
-                 (Imp, Get_Left (Expr), Get_Right (Expr), Res_Type);
+                 (Expr, Get_Left (Expr), Get_Right (Expr), Res_Type);
             end if;
          when Iir_Kinds_Monadic_Operator =>
             Imp := Get_Implementation (Expr);
             if Is_Implicit_Subprogram (Imp) then
                return Translate_Predefined_Operator
-                 (Imp, Get_Operand (Expr), Null_Iir, Res_Type, Expr);
+                 (Expr, Get_Operand (Expr), Null_Iir, Res_Type);
             else
                return Translate_Operator_Function_Call
-                 (Imp, Get_Operand (Expr), Null_Iir, Res_Type);
+                 (Expr, Get_Operand (Expr), Null_Iir, Res_Type);
             end if;
          when Iir_Kind_Function_Call =>
             Imp := Get_Implementation (Expr);
@@ -3960,13 +3960,14 @@ package body Trans.Chap7 is
                         end if;
                      end if;
                      return Translate_Predefined_Operator
-                       (Imp, Left, Right, Res_Type, Expr);
+                       (Expr, Left, Right, Res_Type);
                   end;
                else
                   Canon.Canon_Subprogram_Call (Expr);
+                  Trans.Update_Node_Infos;
                   Assoc_Chain := Get_Parameter_Association_Chain (Expr);
                   Res := Chap8.Translate_Subprogram_Call
-                    (Imp, Assoc_Chain, Get_Method_Object (Expr));
+                    (Expr, Assoc_Chain, Get_Method_Object (Expr));
                   Expr_Type := Get_Return_Type (Imp);
                end if;
             end;
diff --git a/src/vhdl/translate/trans-chap8.adb b/src/vhdl/translate/trans-chap8.adb
index a30a68ed5..d7b839db5 100644
--- a/src/vhdl/translate/trans-chap8.adb
+++ b/src/vhdl/translate/trans-chap8.adb
@@ -39,6 +39,134 @@ with Trans.Foreach_Non_Composite;
 package body Trans.Chap8 is
    use Trans.Helpers;
 
+   --  The LOCAL_STATE is a local variable read from the frame at entry and
+   --  written before return.  The value INITIAL_STATE (0) is the initial
+   --  state.  For processes, this is the state for the first statement.  For
+   --  subprograms, this is the state at call, before dynamic elaboration of
+   --  local declarations.
+   --  Subprograms have more special values:
+   --   1: The return state.  Finalization is performed.
+   Local_State : O_Dnode := O_Dnode_Null;
+
+   Initial_State : constant State_Type := 0;
+   --  Return_State  : constant State_Value_Type := 1;
+
+   --  Next value available.
+   State_Next : State_Type := Initial_State;
+
+   --  Info node to which the state variable is attached.  Used to set and save
+   --  the state variable.
+   State_Info : Ortho_Info_Acc := null;
+
+   --  Statements construct for the state machine.  The generated code is:
+   --    local var STATE: index_type;
+   --  begin
+   --    STATE := FRAME.all.STATE;
+   --    loop
+   --       case STATE is
+   --         when 0 => ...
+   --         when 1 => ...
+   --         ...
+   --       end case;
+   --    end loop;
+   --   end;
+   State_Case : Ortho_Nodes.O_Case_Block;
+   State_Loop : Ortho_Nodes.O_Snode;
+
+   function Get_State_Var (Info : Ortho_Info_Acc) return O_Lnode is
+   begin
+      case Info.Kind is
+         when Kind_Process =>
+            return Get_Var (Info.Process_State);
+         when Kind_Subprg =>
+            return New_Selected_Acc_Value
+              (New_Obj (Info.Res_Interface), Info.Subprg_State_Field);
+         when others =>
+            raise Internal_Error;
+      end case;
+   end Get_State_Var;
+
+   procedure State_Entry (Info : Ortho_Info_Acc) is
+   begin
+      --  Not reentrant.
+      pragma Assert (not State_Enabled);
+
+      State_Info := Info;
+
+      --  For optimization, create a copy of the STATE variable.
+      New_Var_Decl (Local_State, Get_Identifier ("STATE"),
+                    O_Storage_Local, Ghdl_Index_Type);
+
+      --  Initialize it from the frame.
+      New_Assign_Stmt (New_Obj (Local_State),
+                       New_Value (Get_State_Var (Info)));
+
+      Start_Loop_Stmt (State_Loop);
+      Start_Case_Stmt (State_Case, New_Obj_Value (Local_State));
+
+      State_Start (0);
+      State_Next := 0;
+   end State_Entry;
+
+   procedure State_Leave (Parent : Iir) is
+   begin
+      pragma Assert (State_Enabled);
+      pragma Assert (Get_Info (Parent) = State_Info);
+
+      if State_Debug then
+         Start_Choice (State_Case);
+         New_Default_Choice (State_Case);
+         Finish_Choice (State_Case);
+         Chap6.Gen_Program_Error (Parent, Chap6.Prg_Err_Unreach_State);
+      end if;
+
+      Finish_Case_Stmt (State_Case);
+      Finish_Loop_Stmt (State_Loop);
+      Local_State := O_Dnode_Null;
+      State_Info := null;
+   end State_Leave;
+
+   function State_Enabled return Boolean is
+   begin
+      return Local_State /= O_Dnode_Null;
+   end State_Enabled;
+
+   function State_Allocate return State_Type is
+   begin
+      State_Next := State_Next + 1;
+      return State_Next;
+   end State_Allocate;
+
+   function State_To_Lit (State : State_Type) return O_Cnode is
+   begin
+      return New_Index_Lit (Unsigned_64 (State));
+   end State_To_Lit;
+
+   procedure State_Start (State : State_Type) is
+   begin
+      Start_Choice (State_Case);
+      New_Expr_Choice (State_Case, State_To_Lit (State));
+      Finish_Choice (State_Case);
+   end State_Start;
+
+   procedure State_Jump (Next_State : State_Type) is
+   begin
+      New_Assign_Stmt (New_Obj (Local_State),
+                       New_Lit (State_To_Lit (Next_State)));
+   end State_Jump;
+
+   procedure State_Jump_Force is
+   begin
+      New_Next_Stmt (State_Loop);
+   end State_Jump_Force;
+
+   procedure State_Suspend (Next_State : State_Type) is
+   begin
+      New_Assign_Stmt (Get_State_Var (State_Info),
+                       New_Lit (State_To_Lit (Next_State)));
+      New_Return_Stmt;
+   end State_Suspend;
+
    procedure Translate_Return_Statement (Stmt : Iir_Return_Statement)
    is
       Subprg_Info : constant Ortho_Info_Acc :=
@@ -68,7 +196,13 @@ package body Trans.Chap8 is
    begin
       if Expr = Null_Iir then
          --  Return in a procedure.
-         Gen_Return;
+         if Get_Suspend_Flag (Chap2.Current_Subprogram) then
+            State_Jump (State_Return);
+            State_Jump_Force;
+         else
+            Gen_Return;
+         end if;
+
          return;
       end if;
 
@@ -83,7 +217,8 @@ package body Trans.Chap8 is
                R : O_Enode;
             begin
                --  Always uses a temporary in case of the return expression
-               --  uses secondary stack.
+               --  uses secondary stack.  This can happen in constructs like:
+               --    return my_func (param)(index);
                --  FIXME: don't use the temp if not required.
                R := Chap7.Translate_Expression (Expr, Ret_Type);
                if Has_Stack2_Mark
@@ -144,16 +279,68 @@ package body Trans.Chap8 is
                Close_Temp;
                Gen_Return;
             end;
-         when Type_Mode_File =>
-            --  FIXME: Is it possible ?
-            Error_Kind ("translate_return_statement", Ret_Type);
-         when Type_Mode_Unknown
+         when Type_Mode_File
+            | Type_Mode_Unknown
             | Type_Mode_Protected =>
             raise Internal_Error;
       end case;
    end Translate_Return_Statement;
 
-   procedure Translate_If_Statement (Stmt : Iir)
+   procedure Translate_If_Statement_State_Jumps
+     (Stmt : Iir; Fall_State : State_Type)
+   is
+      Blk         : O_If_Block;
+      Else_Clause : Iir;
+   begin
+      Start_If_Stmt
+        (Blk, Chap7.Translate_Expression (Get_Condition (Stmt)));
+      State_Jump (State_Allocate);
+      New_Else_Stmt (Blk);
+      Else_Clause := Get_Else_Clause (Stmt);
+      if Else_Clause = Null_Iir then
+         State_Jump (Fall_State);
+      else
+         if Get_Condition (Else_Clause) = Null_Iir then
+            State_Jump (State_Allocate);
+         else
+            Open_Temp;
+            Translate_If_Statement_State_Jumps (Else_Clause, Fall_State);
+            Close_Temp;
+         end if;
+      end if;
+      Finish_If_Stmt (Blk);
+   end Translate_If_Statement_State_Jumps;
+
+   procedure Translate_If_Statement_State (Stmt : Iir)
+   is
+      Fall_State : State_Type;
+      Next_State : State_Type;
+      Branch : Iir;
+   begin
+      Fall_State := State_Allocate;
+      Next_State := Fall_State;
+
+      --  Generate the jumps.
+      Open_Temp;
+      Translate_If_Statement_State_Jumps (Stmt, Fall_State);
+      Close_Temp;
+
+      --  Generate statements.
+      Branch := Stmt;
+      loop
+         Next_State := Next_State + 1;
+         State_Start (Next_State);
+         Translate_Statements_Chain (Get_Sequential_Statement_Chain (Branch));
+         State_Jump (Fall_State);
+
+         Branch := Get_Else_Clause (Branch);
+         exit when Branch = Null_Iir;
+      end loop;
+
+      State_Start (Fall_State);
+   end Translate_If_Statement_State;
+
+   procedure Translate_If_Statement_Direct (Stmt : Iir)
    is
       Blk         : O_If_Block;
       Else_Clause : Iir;
@@ -171,11 +358,20 @@ package body Trans.Chap8 is
               (Get_Sequential_Statement_Chain (Else_Clause));
          else
             Open_Temp;
-            Translate_If_Statement (Else_Clause);
+            Translate_If_Statement_Direct (Else_Clause);
             Close_Temp;
          end if;
       end if;
       Finish_If_Stmt (Blk);
+   end Translate_If_Statement_Direct;
+
+   procedure Translate_If_Statement (Stmt : Iir) is
+   begin
+      if Get_Suspend_Flag (Stmt) then
+         Translate_If_Statement_State (Stmt);
+      else
+         Translate_If_Statement_Direct (Stmt);
+      end if;
    end Translate_If_Statement;
 
    function Get_Range_Ptr_Field_Value (O_Range : O_Lnode; Field : O_Fnode)
@@ -187,22 +383,12 @@ package body Trans.Chap8 is
    end Get_Range_Ptr_Field_Value;
 
    --  Inc or dec ITERATOR according to DIR.
-   procedure Gen_Update_Iterator (Iterator : O_Dnode;
-                                  Dir      : Iir_Direction;
-                                  Val      : Unsigned_64;
-                                  Itype    : Iir)
+   procedure Gen_Update_Iterator_Common (Val      : Unsigned_64;
+                                         Itype    : Iir;
+                                         V : out O_Enode)
    is
-      Op        : ON_Op_Kind;
-      Base_Type : Iir;
-      V         : O_Enode;
+      Base_Type : constant Iir := Get_Base_Type (Itype);
    begin
-      case Dir is
-         when Iir_To =>
-            Op := ON_Add_Ov;
-         when Iir_Downto =>
-            Op := ON_Sub_Ov;
-      end case;
-      Base_Type := Get_Base_Type (Itype);
       case Get_Kind (Base_Type) is
          when Iir_Kind_Integer_Type_Definition =>
             V := New_Lit
@@ -224,59 +410,99 @@ package body Trans.Chap8 is
          when others =>
             Error_Kind ("gen_update_iterator", Base_Type);
       end case;
+   end Gen_Update_Iterator_Common;
+
+   procedure Gen_Update_Iterator (Iterator : O_Dnode;
+                                  Dir      : Iir_Direction;
+                                  Val      : Unsigned_64;
+                                  Itype    : Iir)
+   is
+      Op        : ON_Op_Kind;
+      V         : O_Enode;
+   begin
+      case Dir is
+         when Iir_To =>
+            Op := ON_Add_Ov;
+         when Iir_Downto =>
+            Op := ON_Sub_Ov;
+      end case;
+      Gen_Update_Iterator_Common (Val, Itype, V);
       New_Assign_Stmt (New_Obj (Iterator),
                        New_Dyadic_Op (Op, New_Obj_Value (Iterator), V));
    end Gen_Update_Iterator;
 
-   type For_Loop_Data is record
-      Iterator               : Iir_Iterator_Declaration;
-      Stmt                   : Iir_For_Loop_Statement;
-      --  If around the loop, to check if the loop must be executed.
-      If_Blk                 : O_If_Block;
-      Label_Next, Label_Exit : O_Snode;
-      --  Right bound of the iterator, used only if the iterator is a
-      --  range expression.
-      O_Right                : O_Dnode;
-      --  Range variable of the iterator, used only if the iterator is not
-      --  a range expression.
-      O_Range                : O_Dnode;
-   end record;
+   procedure Gen_Update_Iterator (Iterator : Var_Type;
+                                  Dir      : Iir_Direction;
+                                  Val      : Unsigned_64;
+                                  Itype    : Iir)
+   is
+      Op        : ON_Op_Kind;
+      V         : O_Enode;
+   begin
+      case Dir is
+         when Iir_To =>
+            Op := ON_Add_Ov;
+         when Iir_Downto =>
+            Op := ON_Sub_Ov;
+      end case;
+      Gen_Update_Iterator_Common (Val, Itype, V);
+      New_Assign_Stmt (Get_Var (Iterator),
+                       New_Dyadic_Op (Op, New_Value (Get_Var (Iterator)), V));
+   end Gen_Update_Iterator;
 
-   procedure Start_For_Loop (Iterator : Iir_Iterator_Declaration;
-                             Stmt     : Iir_For_Loop_Statement;
-                             Data     : out For_Loop_Data)
+   procedure Translate_For_Loop_Statement_Declaration (Stmt : Iir)
    is
-      Iter_Type      : Iir;
-      Iter_Base_Type : Iir;
-      Var_Iter       : Var_Type;
-      Constraint     : Iir;
-      Cond           : O_Enode;
-      Dir            : Iir_Direction;
-      Iter_Type_Info : Ortho_Info_Acc;
-      Op             : ON_Op_Kind;
+      Iterator : constant Iir := Get_Parameter_Specification (Stmt);
+      Iter_Type : constant Iir := Get_Type (Iterator);
+      Iter_Type_Info : constant Type_Info_Acc :=
+        Get_Info (Get_Base_Type (Iter_Type));
+      Constraint     : constant Iir := Get_Range_Constraint (Iter_Type);
+      It_Info : Ortho_Info_Acc;
    begin
-      --  Initialize DATA.
-      Data.Iterator := Iterator;
-      Data.Stmt := Stmt;
+      --  Iterator range.
+      Chap3.Translate_Object_Subtype (Iterator, False);
 
-      Iter_Type := Get_Type (Iterator);
-      Iter_Base_Type := Get_Base_Type (Iter_Type);
-      Iter_Type_Info := Get_Info (Iter_Base_Type);
-      Var_Iter := Get_Info (Iterator).Iterator_Var;
+      --  Iterator variable.
+      It_Info := Add_Info (Iterator, Kind_Iterator);
+      It_Info.Iterator_Var := Create_Var
+        (Create_Var_Identifier (Iterator),
+         Iter_Type_Info.Ortho_Type (Mode_Value),
+         O_Storage_Local);
 
-      Open_Temp;
+      if Get_Kind (Constraint) = Iir_Kind_Range_Expression then
+         It_Info.Iterator_Right := Create_Var
+           (Create_Var_Identifier ("IT_RIGHT"),
+            Iter_Type_Info.Ortho_Type (Mode_Value),
+            O_Storage_Local);
+      else
+         It_Info.Iterator_Range := Create_Var
+           (Create_Var_Identifier ("IT_RANGE"),
+            Iter_Type_Info.T.Range_Ptr_Type,
+            O_Storage_Local);
+      end if;
+   end Translate_For_Loop_Statement_Declaration;
 
-      Constraint := Get_Range_Constraint (Iter_Type);
+   procedure Start_For_Loop (Iterator : Iir_Iterator_Declaration;
+                             Cond     : out O_Enode)
+   is
+      Iter_Type      : constant Iir := Get_Type (Iterator);
+      Iter_Base_Type : constant Iir := Get_Base_Type (Iter_Type);
+      Iter_Type_Info : constant Ortho_Info_Acc := Get_Info (Iter_Base_Type);
+      It_Info        : constant Ortho_Info_Acc := Get_Info (Iterator);
+      Constraint     : constant Iir := Get_Range_Constraint (Iter_Type);
+      Dir            : Iir_Direction;
+      Op             : ON_Op_Kind;
+   begin
       if Get_Kind (Constraint) = Iir_Kind_Range_Expression then
          New_Assign_Stmt
-           (Get_Var (Var_Iter), Chap7.Translate_Range_Expression_Left
-            (Constraint, Iter_Base_Type));
+           (Get_Var (It_Info.Iterator_Var),
+            Chap7.Translate_Range_Expression_Left (Constraint,
+                                                   Iter_Base_Type));
          Dir := Get_Direction (Constraint);
-         Data.O_Right := Create_Temp
-           (Iter_Type_Info.Ortho_Type (Mode_Value));
          New_Assign_Stmt
-           (New_Obj (Data.O_Right), Chap7.Translate_Range_Expression_Right
-            (Constraint, Iter_Base_Type));
+           (Get_Var (It_Info.Iterator_Right),
+            Chap7.Translate_Range_Expression_Right (Constraint,
+                                                    Iter_Base_Type));
          case Dir is
             when Iir_To =>
                Op := ON_Le;
@@ -285,181 +511,278 @@ package body Trans.Chap8 is
          end case;
          --  Check for at least one iteration.
          Cond := New_Compare_Op
-           (Op, New_Value (Get_Var (Var_Iter)),
-            New_Obj_Value (Data.O_Right),
+           (Op, New_Value (Get_Var (It_Info.Iterator_Var)),
+            New_Value (Get_Var (It_Info.Iterator_Right)),
             Ghdl_Bool_Type);
       else
-         Data.O_Range := Create_Temp (Iter_Type_Info.T.Range_Ptr_Type);
-         New_Assign_Stmt (New_Obj (Data.O_Range),
+         New_Assign_Stmt (Get_Var (It_Info.Iterator_Range),
                           New_Address (Chap7.Translate_Range
-                            (Constraint, Iter_Base_Type),
-                            Iter_Type_Info.T.Range_Ptr_Type));
+                                         (Constraint, Iter_Base_Type),
+                                       Iter_Type_Info.T.Range_Ptr_Type));
          New_Assign_Stmt
-           (Get_Var (Var_Iter), Get_Range_Ptr_Field_Value
-            (New_Obj (Data.O_Range), Iter_Type_Info.T.Range_Left));
-         --  Before starting the loop, check wether there will be at least
+           (Get_Var (It_Info.Iterator_Var),
+            Get_Range_Ptr_Field_Value (Get_Var (It_Info.Iterator_Range),
+                                       Iter_Type_Info.T.Range_Left));
+         --  Before starting the loop, check whether there will be at least
          --  one iteration.
          Cond := New_Compare_Op
            (ON_Gt,
-            Get_Range_Ptr_Field_Value (New_Obj (Data.O_Range),
-              Iter_Type_Info.T.Range_Length),
+            Get_Range_Ptr_Field_Value (Get_Var (It_Info.Iterator_Range),
+                                       Iter_Type_Info.T.Range_Length),
             New_Lit (Ghdl_Index_0),
             Ghdl_Bool_Type);
       end if;
-
-      Start_If_Stmt (Data.If_Blk, Cond);
-
-      --  Start loop.
-      --  There are two blocks: one for the exit, one for the next.
-      Start_Loop_Stmt (Data.Label_Exit);
-      Start_Loop_Stmt (Data.Label_Next);
-
-      if Stmt /= Null_Iir then
-         declare
-            Loop_Info : Loop_Info_Acc;
-         begin
-            Loop_Info := Add_Info (Stmt, Kind_Loop);
-            Loop_Info.Label_Exit := Data.Label_Exit;
-            Loop_Info.Label_Next := Data.Label_Next;
-         end;
-      end if;
    end Start_For_Loop;
 
-   procedure Finish_For_Loop (Data : in out For_Loop_Data)
+   procedure Exit_Cond_For_Loop (Iterator : Iir; Cond : out O_Enode)
    is
-      Cond           : O_Enode;
-      If_Blk1        : O_If_Block;
-      Iter_Type      : Iir;
-      Iter_Base_Type : Iir;
-      Iter_Type_Info : Type_Info_Acc;
-      Var_Iter       : Var_Type;
-      Constraint     : Iir;
-      Deep_Rng       : Iir;
-      Deep_Reverse   : Boolean;
+      Iter_Type      : constant Iir := Get_Type (Iterator);
+      Iter_Base_Type : constant Iir := Get_Base_Type (Iter_Type);
+      Iter_Type_Info : constant Ortho_Info_Acc := Get_Info (Iter_Base_Type);
+      It_Info        : constant Ortho_Info_Acc := Get_Info (Iterator);
+      Constraint     : constant Iir := Get_Range_Constraint (Iter_Type);
+      Val            : O_Enode;
    begin
-      New_Exit_Stmt (Data.Label_Next);
-      Finish_Loop_Stmt (Data.Label_Next);
-
       --  Check end of loop.
       --  Equality is necessary and enough.
-      Iter_Type := Get_Type (Data.Iterator);
-      Iter_Base_Type := Get_Base_Type (Iter_Type);
-      Iter_Type_Info := Get_Info (Iter_Base_Type);
-      Var_Iter := Get_Info (Data.Iterator).Iterator_Var;
-
-      Constraint := Get_Range_Constraint (Iter_Type);
 
       if Get_Kind (Constraint) = Iir_Kind_Range_Expression then
-         Cond := New_Obj_Value (Data.O_Right);
+         Val := New_Value (Get_Var (It_Info.Iterator_Right));
       else
-         Cond := Get_Range_Ptr_Field_Value
-           (New_Obj (Data.O_Range), Iter_Type_Info.T.Range_Right);
+         Val := Get_Range_Ptr_Field_Value
+           (Get_Var (It_Info.Iterator_Range), Iter_Type_Info.T.Range_Right);
       end if;
-      Gen_Exit_When (Data.Label_Exit,
-                     New_Compare_Op (ON_Eq, New_Value (Get_Var (Var_Iter)),
-                       Cond, Ghdl_Bool_Type));
+      Cond := New_Compare_Op (ON_Eq,
+                              New_Value (Get_Var (It_Info.Iterator_Var)), Val,
+                              Ghdl_Bool_Type);
+   end Exit_Cond_For_Loop;
 
+   procedure Update_For_Loop (Iterator : Iir)
+   is
+      Iter_Type      : constant Iir := Get_Type (Iterator);
+      Iter_Base_Type : constant Iir := Get_Base_Type (Iter_Type);
+      Iter_Type_Info : constant Ortho_Info_Acc := Get_Info (Iter_Base_Type);
+      It_Info        : constant Ortho_Info_Acc := Get_Info (Iterator);
+      If_Blk1        : O_If_Block;
+      Deep_Rng       : Iir;
+      Deep_Reverse   : Boolean;
+   begin
       --  Update the iterator.
       Chap6.Get_Deep_Range_Expression (Iter_Type, Deep_Rng, Deep_Reverse);
       if Deep_Rng /= Null_Iir then
          if Get_Direction (Deep_Rng) = Iir_To xor Deep_Reverse then
-            Gen_Update_Iterator
-              (Get_Var_Label (Var_Iter), Iir_To, 1, Iter_Base_Type);
+            Gen_Update_Iterator (It_Info.Iterator_Var,
+                                 Iir_To, 1, Iter_Base_Type);
          else
-            Gen_Update_Iterator
-              (Get_Var_Label (Var_Iter), Iir_Downto, 1, Iter_Base_Type);
+            Gen_Update_Iterator (It_Info.Iterator_Var,
+                                 Iir_Downto, 1, Iter_Base_Type);
          end if;
       else
          Start_If_Stmt
            (If_Blk1, New_Compare_Op
               (ON_Eq,
-               Get_Range_Ptr_Field_Value (New_Obj (Data.O_Range),
-                 Iter_Type_Info.T.Range_Dir),
+               Get_Range_Ptr_Field_Value (Get_Var (It_Info.Iterator_Range),
+                                          Iter_Type_Info.T.Range_Dir),
                New_Lit (Ghdl_Dir_To_Node),
                Ghdl_Bool_Type));
-         Gen_Update_Iterator
-           (Get_Var_Label (Var_Iter), Iir_To, 1, Iter_Base_Type);
+         Gen_Update_Iterator (It_Info.Iterator_Var,
+                              Iir_To, 1, Iter_Base_Type);
          New_Else_Stmt (If_Blk1);
-         Gen_Update_Iterator
-           (Get_Var_Label (Var_Iter), Iir_Downto, 1, Iter_Base_Type);
+         Gen_Update_Iterator (It_Info.Iterator_Var,
+                              Iir_Downto, 1, Iter_Base_Type);
          Finish_If_Stmt (If_Blk1);
       end if;
+   end Update_For_Loop;
+
+   Current_Loop : Iir := Null_Iir;
+
+   procedure Translate_For_Loop_Statement_State
+     (Stmt : Iir_For_Loop_Statement)
+   is
+      Iterator       : constant Iir := Get_Parameter_Specification (Stmt);
+      It_Info        : constant Ortho_Info_Acc := Get_Info (Iterator);
+      Info           : constant Loop_State_Info_Acc := Get_Info (Stmt);
+      Loop_If : O_If_Block;
+      Cond : O_Enode;
+   begin
+      pragma Assert (It_Info /= null);
 
-      Finish_Loop_Stmt (Data.Label_Exit);
-      Finish_If_Stmt (Data.If_Blk);
+      Info.Loop_State_Next := State_Allocate;
+      Info.Loop_State_Exit := State_Allocate;
+      Info.Loop_State_Body := State_Allocate;
+
+      --  Loop header: initialize iterator, skip the whole body in case of
+      --  null range.
+      Open_Temp;
+      Start_For_Loop (Iterator, Cond);
+      Start_If_Stmt (Loop_If, Cond);
+      State_Jump (Info.Loop_State_Body);
+      New_Else_Stmt (Loop_If);
+      State_Jump (Info.Loop_State_Exit);
+      Finish_If_Stmt (Loop_If);
       Close_Temp;
 
-      if Data.Stmt /= Null_Iir then
-         Free_Info (Data.Stmt);
-      end if;
-   end Finish_For_Loop;
+      --  Loop body.
+      State_Start (Info.Loop_State_Body);
+      Translate_Statements_Chain (Get_Sequential_Statement_Chain (Stmt));
+      State_Jump (Info.Loop_State_Next);
 
-   Current_Loop : Iir := Null_Iir;
+      --  Loop next.
+      State_Start (Info.Loop_State_Next);
+      Exit_Cond_For_Loop (Iterator, Cond);
+      Start_If_Stmt (Loop_If, Cond);
+      State_Jump (Info.Loop_State_Exit);
+      New_Else_Stmt (Loop_If);
+      Update_For_Loop (Iterator);
+      State_Jump (Info.Loop_State_Body);
+      Finish_If_Stmt (Loop_If);
 
-   procedure Translate_For_Loop_Statement (Stmt : Iir_For_Loop_Statement)
+      --  Exit state, after loop.
+      State_Start (Info.Loop_State_Exit);
+
+      Free_Info (Iterator);
+   end Translate_For_Loop_Statement_State;
+
+   procedure Translate_For_Loop_Statement_Direct
+     (Stmt : Iir_For_Loop_Statement)
    is
-      Iterator       : constant Iir := Get_Parameter_Specification (Stmt);
-      Iter_Type      : constant Iir := Get_Type (Iterator);
-      Iter_Base_Type : constant Iir := Get_Base_Type (Iter_Type);
-      Iter_Type_Info : constant Type_Info_Acc := Get_Info (Iter_Base_Type);
-      Data           : For_Loop_Data;
-      It_Info        : Ortho_Info_Acc;
-      Var_Iter       : Var_Type;
-      Prev_Loop      : Iir;
+      Iterator : constant Iir := Get_Parameter_Specification (Stmt);
+      Loop_Info : Loop_Info_Acc;
+
+      --  If around the loop, to check if the loop must be executed.
+      Loop_If                 : O_If_Block;
+      Cond : O_Enode;
    begin
-      Prev_Loop := Current_Loop;
-      Current_Loop := Stmt;
       Start_Declare_Stmt;
 
-      Chap3.Translate_Object_Subtype (Iterator, False);
+      Open_Temp;
 
-      --  Create info for the iterator.
-      It_Info := Add_Info (Iterator, Kind_Iterator);
-      Var_Iter := Create_Var
-        (Create_Var_Identifier (Iterator),
-         Iter_Type_Info.Ortho_Type (Mode_Value),
-         O_Storage_Local);
-      It_Info.Iterator_Var := Var_Iter;
+      Translate_For_Loop_Statement_Declaration (Stmt);
+
+      --  Loop header: initialize iterator.
+      Start_For_Loop (Iterator, Cond);
 
-      Start_For_Loop (Iterator, Stmt, Data);
+      --  Skip the whole loop in case of null range.
+      Start_If_Stmt (Loop_If, Cond);
 
+      --  Start loop.
+      --  There are two blocks: one for the exit, one for the next.
+
+      Loop_Info := Add_Info (Stmt, Kind_Loop);
+      Start_Loop_Stmt (Loop_Info.Label_Exit);
+      Start_Loop_Stmt (Loop_Info.Label_Next);
+
+      --  Loop body.
       Translate_Statements_Chain (Get_Sequential_Statement_Chain (Stmt));
 
-      Finish_For_Loop (Data);
+      --  Fake 'next' statement.
+      New_Exit_Stmt (Loop_Info.Label_Next);
+      Finish_Loop_Stmt (Loop_Info.Label_Next);
+
+      --  Exit loop if right bound reached.
+      Exit_Cond_For_Loop (Iterator, Cond);
+      Gen_Exit_When (Loop_Info.Label_Exit, Cond);
+
+      Update_For_Loop (Iterator);
+
+      Finish_Loop_Stmt (Loop_Info.Label_Exit);
+      Finish_If_Stmt (Loop_If);
+      Close_Temp;
+
+      Free_Info (Stmt);
 
       Finish_Declare_Stmt;
 
       Free_Info (Iterator);
+   end Translate_For_Loop_Statement_Direct;
+
+   procedure Translate_For_Loop_Statement (Stmt : Iir_For_Loop_Statement)
+   is
+      Prev_Loop      : Iir;
+   begin
+      Prev_Loop := Current_Loop;
+      Current_Loop := Stmt;
+
+      if Get_Suspend_Flag (Stmt) then
+         Translate_For_Loop_Statement_State (Stmt);
+      else
+         Translate_For_Loop_Statement_Direct (Stmt);
+      end if;
+
       Current_Loop := Prev_Loop;
    end Translate_For_Loop_Statement;
 
-   procedure Translate_While_Loop_Statement
-     (Stmt : Iir_While_Loop_Statement)
+   procedure Translate_While_Loop_Statement (Stmt : Iir_While_Loop_Statement)
    is
-      Info      : Loop_Info_Acc;
-      Cond      : Iir;
+      Cond : constant Iir := Get_Condition (Stmt);
       Prev_Loop : Iir;
    begin
       Prev_Loop := Current_Loop;
       Current_Loop := Stmt;
 
-      Info := Add_Info (Stmt, Kind_Loop);
+      if Get_Suspend_Flag (Stmt) then
+         declare
+            Info : constant Loop_State_Info_Acc := Get_Info (Stmt);
+            Blk : O_If_Block;
+         begin
+            Info.Loop_State_Next := State_Allocate;
+            Info.Loop_State_Exit := State_Allocate;
 
-      Start_Loop_Stmt (Info.Label_Exit);
-      Info.Label_Next := O_Snode_Null;
+            --  NEXT_STATE:
+            State_Jump (Info.Loop_State_Next);
+            State_Start (Info.Loop_State_Next);
 
-      Open_Temp;
-      Cond := Get_Condition (Stmt);
-      if Cond /= Null_Iir then
-         Gen_Exit_When
-           (Info.Label_Exit,
-            New_Monadic_Op (ON_Not, Chap7.Translate_Expression (Cond)));
-      end if;
-      Close_Temp;
+            if Cond /= Null_Iir then
+               Info.Loop_State_Body := State_Allocate;
 
-      Translate_Statements_Chain (Get_Sequential_Statement_Chain (Stmt));
+               --  if COND then
+               --    goto BODY_STATE;
+               --  else
+               --    goto EXIT_STATE;
+               --  end if;
+               Open_Temp;
+               Start_If_Stmt (Blk, Chap7.Translate_Expression (Cond));
+               State_Jump (Info.Loop_State_Body);
+               New_Else_Stmt (Blk);
+               State_Jump (Info.Loop_State_Exit);
+               Finish_If_Stmt (Blk);
+               Close_Temp;
+
+               --  BODY_STATE:
+               State_Start (Info.Loop_State_Body);
+            end if;
+
+            Translate_Statements_Chain (Get_Sequential_Statement_Chain (Stmt));
+
+            --  goto NEXT_STATE
+            State_Jump (Info.Loop_State_Next);
+
+            --  EXIT_STATE:
+            State_Start (Info.Loop_State_Exit);
+         end;
+      else
+         declare
+            Info : Loop_Info_Acc;
+         begin
+            Info := Add_Info (Stmt, Kind_Loop);
+
+            Start_Loop_Stmt (Info.Label_Exit);
+            Info.Label_Next := O_Snode_Null;
+
+            Open_Temp;
+            if Cond /= Null_Iir then
+               Gen_Exit_When
+                 (Info.Label_Exit,
+                  New_Monadic_Op (ON_Not, Chap7.Translate_Expression (Cond)));
+            end if;
+            Close_Temp;
+
+            Translate_Statements_Chain (Get_Sequential_Statement_Chain (Stmt));
+
+            Finish_Loop_Stmt (Info.Label_Exit);
+         end;
+      end if;
 
-      Finish_Loop_Stmt (Info.Label_Exit);
       Free_Info (Stmt);
       Current_Loop := Prev_Loop;
    end Translate_While_Loop_Statement;
@@ -468,14 +791,10 @@ package body Trans.Chap8 is
    is
       Cond       : constant Iir := Get_Condition (Stmt);
       If_Blk     : O_If_Block;
-      Info       : Loop_Info_Acc;
+      Info       : Ortho_Info_Acc;
       Loop_Label : Iir;
       Loop_Stmt  : Iir;
    begin
-      if Cond /= Null_Iir then
-         Start_If_Stmt (If_Blk, Chap7.Translate_Expression (Cond));
-      end if;
-
       Loop_Label := Get_Loop_Label (Stmt);
       if Loop_Label = Null_Iir then
          Loop_Stmt := Current_Loop;
@@ -484,22 +803,58 @@ package body Trans.Chap8 is
       end if;
 
       Info := Get_Info (Loop_Stmt);
-      case Get_Kind (Stmt) is
-         when Iir_Kind_Exit_Statement =>
-            New_Exit_Stmt (Info.Label_Exit);
-         when Iir_Kind_Next_Statement =>
-            if Info.Label_Next /= O_Snode_Null then
-               --  For-loop.
-               New_Exit_Stmt (Info.Label_Next);
-            else
-               --  While-loop.
-               New_Next_Stmt (Info.Label_Exit);
-            end if;
-         when others =>
-            raise Internal_Error;
-      end case;
+
+      --  Common part.
       if Cond /= Null_Iir then
-         Finish_If_Stmt (If_Blk);
+         Start_If_Stmt (If_Blk, Chap7.Translate_Expression (Cond));
+      end if;
+
+      if Get_Suspend_Flag (Loop_Stmt) then
+         --  The corresponding loop is state based.  Jump to the right state.
+         case Get_Kind (Stmt) is
+            when Iir_Kind_Exit_Statement =>
+               State_Jump (Info.Loop_State_Exit);
+            when Iir_Kind_Next_Statement =>
+               State_Jump (Info.Loop_State_Next);
+            when others =>
+               raise Internal_Error;
+         end case;
+
+         --  Force the jump, so that it would work even if the next/exit is
+         --  not immediately within a state construct.  Example:
+         --    loop
+         --      if cond then
+         --        exit;
+         --      else
+         --        i := i + 1;
+         --      end if;
+         --      wait for 1 ns;
+         --    end loop;
+         --  A new state cannot be created here, as the outer construct is the
+         --  if statement and not the case statement for the state machine.
+         State_Jump_Force;
+
+         if Cond /= Null_Iir then
+            Finish_If_Stmt (If_Blk);
+         end if;
+      else
+         case Get_Kind (Stmt) is
+            when Iir_Kind_Exit_Statement =>
+               New_Exit_Stmt (Info.Label_Exit);
+            when Iir_Kind_Next_Statement =>
+               if Info.Label_Next /= O_Snode_Null then
+                  --  For-loop.
+                  New_Exit_Stmt (Info.Label_Next);
+               else
+                  --  While-loop.
+                  New_Next_Stmt (Info.Label_Exit);
+               end if;
+            when others =>
+               raise Internal_Error;
+         end case;
+         if Cond /= Null_Iir then
+            Finish_If_Stmt (If_Blk);
+         end if;
       end if;
    end Translate_Exit_Next_Statement;
 
@@ -737,22 +1092,20 @@ package body Trans.Chap8 is
       Val_Node : O_Dnode;
       Tinfo    : Type_Info_Acc;
       Func     : Iir)
-         return O_Enode
+     return O_Enode
    is
       Assoc     : O_Assoc_List;
       Func_Info : Subprg_Info_Acc;
    begin
-      New_Assign_Stmt
-        (New_Selected_Element (New_Obj (Val_Node),
-         Tinfo.T.Base_Field (Mode_Value)),
-         Val);
+      New_Assign_Stmt (New_Selected_Element (New_Obj (Val_Node),
+                                             Tinfo.T.Base_Field (Mode_Value)),
+                       Val);
       Func_Info := Get_Info (Func);
       Start_Association (Assoc, Func_Info.Ortho_Func);
       Subprgs.Add_Subprg_Instance_Assoc (Assoc, Func_Info.Subprg_Instance);
       New_Association (Assoc, New_Obj_Value (Expr));
-      New_Association
-        (Assoc, New_Address (New_Obj (Val_Node),
-         Tinfo.Ortho_Ptr_Type (Mode_Value)));
+      New_Association (Assoc, New_Address (New_Obj (Val_Node),
+                                           Tinfo.Ortho_Ptr_Type (Mode_Value)));
       return New_Function_Call (Assoc);
    end Translate_Simple_String_Choice;
 
@@ -764,13 +1117,12 @@ package body Trans.Chap8 is
       Expr_Node : out O_Dnode;
       C_Node    : out O_Dnode)
    is
-      Expr      : Iir;
+      Expr      : constant Iir := Get_Expression (Stmt);
       Base_Type : Iir;
    begin
       --  Translate into if/elsif statements.
       --  FIXME: if the number of literals ** length of the array < 256,
       --   use a case statement.
-      Expr := Get_Expression (Stmt);
       Expr_Type := Get_Type (Expr);
       Base_Type := Get_Base_Type (Expr_Type);
       Tinfo := Get_Info (Base_Type);
@@ -789,28 +1141,75 @@ package body Trans.Chap8 is
            (New_Obj (Expr_Node), Tinfo.T.Bounds_Field (Mode_Value)));
    end Translate_String_Case_Statement_Common;
 
+   --  Translate only the statements in choice.  The state after the whole case
+   --  statement is NEXT_STATE, the state for the choices are NEXT_STATE + 1 ..
+   --  NEXT_STATE + nbr_choices.
+   procedure Translate_Case_Statement_State
+     (Stmt : Iir_Case_Statement; Next_State : State_Type)
+   is
+      Choice     : Iir;
+      Choice_State  : State_Type;
+   begin
+      Choice_State := Next_State;
+      Choice := Get_Case_Statement_Alternative_Chain (Stmt);
+      while Choice /= Null_Iir loop
+         if not Get_Same_Alternative_Flag (Choice) then
+            Choice_State := Choice_State + 1;
+            State_Start (Choice_State);
+            Translate_Statements_Chain
+              (Get_Associated_Chain (Choice));
+            State_Jump (Next_State);
+         end if;
+         Choice := Get_Chain (Choice);
+      end loop;
+      State_Start (Next_State);
+   end Translate_Case_Statement_State;
+
    --  Translate a string case statement using a dichotomy.
+   --  NBR_CHOICES is the number of non-others choices.
    procedure Translate_String_Case_Statement_Dichotomy
-     (Stmt : Iir_Case_Statement)
+     (Stmt : Iir_Case_Statement; Nbr_Choices : Positive)
    is
+      Has_Suspend : constant Boolean := Get_Suspend_Flag (Stmt);
+      Choices_Chain : constant Iir :=
+        Get_Case_Statement_Alternative_Chain (Stmt);
+
+      type Choice_Id is new Integer;
+      subtype Valid_Choice_Id is Choice_Id
+        range 0 .. Choice_Id (Nbr_Choices - 1);
+      No_Choice_Id : constant Choice_Id := -1;
+
+      type Choice_Info_Type is record
+         --  List of choices, used to sort them.
+         Choice_Chain  : Choice_Id;
+         --  Association index.
+         Choice_Assoc  : Natural;
+         --  Corresponding choice simple expression.
+         Choice_Expr   : Iir;
+         --  Corresponding choice.
+         Choice_Parent : Iir;
+      end record;
+
+      type Choice_Info_Arr is array (Valid_Choice_Id) of Choice_Info_Type;
+      Choices_Info : Choice_Info_Arr;
+      First, Last : Choice_Id;
+      El : Choice_Id;
+
       --  Selector.
       Expr_Type : Iir;
       Tinfo     : Type_Info_Acc;
       Expr_Node : O_Dnode;
       C_Node    : O_Dnode;
+      Var_Idx   : O_Dnode;
+      Others_Lit : O_Cnode;
 
-      Choices_Chain : Iir;
       Choice        : Iir;
       Has_Others    : Boolean;
       Func          : Iir;
 
-      --  Number of non-others choices.
-      Nbr_Choices : Natural;
       --  Number of associations.
       Nbr_Assocs  : Natural;
 
-      Info        : Ortho_Info_Acc;
-      First, Last : Ortho_Info_Acc;
       Sel_Length  : Iir_Int64;
 
       --  Dichotomy table (table of choices).
@@ -829,53 +1228,44 @@ package body Trans.Chap8 is
       Assoc_Table_Type      : O_Tnode;
       Assoc_Table           : O_Dnode;
    begin
-      Choices_Chain := Get_Case_Statement_Alternative_Chain (Stmt);
-
-      --  Count number of choices and number of associations.
-      Nbr_Choices := 0;
+      --  Fill Choices_Info array, and count number of associations.
+      Last := No_Choice_Id;
       Nbr_Assocs := 0;
-      Choice := Choices_Chain;
-      First := null;
-      Last := null;
       Has_Others := False;
+      Choice := Choices_Chain;
       while Choice /= Null_Iir loop
-         case Get_Kind (Choice) is
-            when Iir_Kind_Choice_By_Others =>
-               Has_Others := True;
-               exit;
-            when Iir_Kind_Choice_By_Expression =>
-               null;
-            when others =>
-               raise Internal_Error;
-         end case;
+         if Get_Kind (Choice) = Iir_Kind_Choice_By_Others then
+            Has_Others := True;
+            exit;
+         end if;
+         pragma Assert (Get_Kind (Choice) = Iir_Kind_Choice_By_Expression);
          if not Get_Same_Alternative_Flag (Choice) then
             Nbr_Assocs := Nbr_Assocs + 1;
          end if;
-         Info := Add_Info (Choice, Kind_Str_Choice);
-         if First = null then
-            First := Info;
-         else
-            Last.Choice_Chain := Info;
-         end if;
-         Last := Info;
-         Info.Choice_Chain := null;
-         Info.Choice_Assoc := Nbr_Assocs - 1;
-         Info.Choice_Parent := Choice;
-         Info.Choice_Expr := Get_Choice_Expression (Choice);
-
-         Nbr_Choices := Nbr_Choices + 1;
+         Last := Last + 1;
+         Choices_Info (Last) :=
+           (Choice_Chain => Last + 1,
+            Choice_Assoc => Nbr_Assocs - 1,
+            Choice_Parent => Choice,
+            Choice_Expr => Get_Choice_Expression (Choice));
          Choice := Get_Chain (Choice);
       end loop;
 
+      --  There is at most one choice (otherwise the linear algorithm must
+      --  have been used).
+      pragma Assert (Last /= No_Choice_Id);
+      First := 0;
+      Choices_Info (Last).Choice_Chain := No_Choice_Id;
+
       --  Sort choices.
       declare
-         procedure Merge_Sort (Head : Ortho_Info_Acc;
+         procedure Merge_Sort (Head : Choice_Id;
                                Nbr  : Natural;
-                               Res  : out Ortho_Info_Acc;
-                               Next : out Ortho_Info_Acc)
+                               Res  : out Choice_Id;
+                               Next : out Choice_Id)
          is
-            L, R, L_End, R_End : Ortho_Info_Acc;
-            E, Last            : Ortho_Info_Acc;
+            L, R, L_End, R_End : Choice_Id;
+            E, Last            : Choice_Id;
             Half               : constant Natural := Nbr / 2;
          begin
             --  Sorting less than 2 elements is easy!
@@ -884,54 +1274,57 @@ package body Trans.Chap8 is
                if Nbr = 0 then
                   Next := Head;
                else
-                  Next := Head.Choice_Chain;
+                  Next := Choices_Info (Head).Choice_Chain;
                end if;
                return;
             end if;
 
+            --  Split in two and sort.
             Merge_Sort (Head, Half, L, L_End);
             Merge_Sort (L_End, Nbr - Half, R, R_End);
             Next := R_End;
 
             --  Merge
-            Last := null;
+            Last := No_Choice_Id;
             loop
                if L /= L_End
                  and then
                    (R = R_End
                     or else
-                    Compare_String_Literals (L.Choice_Expr, R.Choice_Expr)
-                    = Compare_Lt)
+                      Compare_String_Literals (Choices_Info (L).Choice_Expr,
+                                               Choices_Info (R).Choice_Expr)
+                      = Compare_Lt)
                then
+                  --  Pick L.
                   E := L;
-                  L := L.Choice_Chain;
+                  L := Choices_Info (L).Choice_Chain;
                elsif R /= R_End then
+                  --  Pick R.
                   E := R;
-                  R := R.Choice_Chain;
+                  R := Choices_Info (R).Choice_Chain;
                else
                   exit;
                end if;
-               if Last = null then
+               --  Append.
+               if Last = No_Choice_Id then
                   Res := E;
                else
-                  Last.Choice_Chain := E;
+                  Choices_Info (Last).Choice_Chain := E;
                end if;
                Last := E;
             end loop;
-            Last.Choice_Chain := R_End;
+            Choices_Info (Last).Choice_Chain := R_End;
          end Merge_Sort;
-         Next               : Ortho_Info_Acc;
       begin
-         Merge_Sort (First, Nbr_Choices, First, Next);
-         if Next /= null then
-            raise Internal_Error;
-         end if;
+         Merge_Sort (First, Nbr_Choices, First, Last);
+         pragma Assert (Last = No_Choice_Id);
       end;
 
+      Open_Temp;
       Translate_String_Case_Statement_Common
         (Stmt, Expr_Type, Tinfo, Expr_Node, C_Node);
 
-      --  Generate choices table.
+      --  Generate the sorted array of choices.
       Sel_Length := Eval_Discrete_Type_Length
         (Get_String_Type_Bound_Type (Expr_Type));
       String_Type := New_Constrained_Array_Type
@@ -947,16 +1340,17 @@ package body Trans.Chap8 is
                       Table_Type);
       Start_Const_Value (Table);
       Start_Array_Aggr (List, Table_Type);
-      Info := First;
-      while Info /= null loop
+
+      El := First;
+      while El /= No_Choice_Id loop
          New_Array_Aggr_El (List, Chap7.Translate_Static_Expression
-                            (Info.Choice_Expr, Expr_Type));
-         Info := Info.Choice_Chain;
+                              (Choices_Info (El).Choice_Expr, Expr_Type));
+         El := Choices_Info (El).Choice_Chain;
       end loop;
       Finish_Array_Aggr (List, Table_Cst);
       Finish_Const_Value (Table, Table_Cst);
 
-      --  Generate assoc table.
+      --  Generate table from choice to statements block.
       Assoc_Table_Base_Type :=
         New_Array_Type (Ghdl_Index_Type, Ghdl_Index_Type);
       New_Type_Decl (Create_Uniq_Identifier, Assoc_Table_Base_Type);
@@ -968,12 +1362,13 @@ package body Trans.Chap8 is
                       O_Storage_Private, Assoc_Table_Type);
       Start_Const_Value (Assoc_Table);
       Start_Array_Aggr (List, Assoc_Table_Type);
-      Info := First;
-      while Info /= null loop
+      El := First;
+      while El /= No_Choice_Id loop
          New_Array_Aggr_El
-           (List, New_Unsigned_Literal (Ghdl_Index_Type,
-            Unsigned_64 (Info.Choice_Assoc)));
-         Info := Info.Choice_Chain;
+           (List, New_Unsigned_Literal
+              (Ghdl_Index_Type,
+               Unsigned_64 (Choices_Info (El).Choice_Assoc)));
+         El := Choices_Info (El).Choice_Chain;
       end loop;
       Finish_Array_Aggr (List, Table_Cst);
       Finish_Const_Value (Assoc_Table, Table_Cst);
@@ -982,14 +1377,12 @@ package body Trans.Chap8 is
       declare
          Var_Lo, Var_Hi, Var_Mid : O_Dnode;
          Var_Cmp                 : O_Dnode;
-         Var_Idx                 : O_Dnode;
          Label                   : O_Snode;
-         Others_Lit              : O_Cnode;
          If_Blk1, If_Blk2        : O_If_Block;
-         Case_Blk                : O_Case_Block;
       begin
          Var_Idx := Create_Temp (Ghdl_Index_Type);
 
+         --  Declare Lo, Hi, Mid, Cmp.
          Start_Declare_Stmt;
 
          New_Var_Decl (Var_Lo, Wki_Lo, O_Storage_Local, Ghdl_Index_Type);
@@ -998,6 +1391,9 @@ package body Trans.Chap8 is
          New_Var_Decl (Var_Cmp, Wki_Cmp,
                        O_Storage_Local, Ghdl_Compare_Type);
 
+         --  Generate:
+         --    Lo := 0;
+         --    Hi := Nbr_Choices - 1;
          New_Assign_Stmt (New_Obj (Var_Lo), New_Lit (Ghdl_Index_0));
          New_Assign_Stmt
            (New_Obj (Var_Hi),
@@ -1012,48 +1408,75 @@ package body Trans.Chap8 is
               (Ghdl_Index_Type, Unsigned_64 (Nbr_Assocs));
          end if;
 
+         --  Generate:
+         --    loop
+         --       Mid := (Lo + Hi) / 2;
+         --       Cmp := COMPARE (Expr, Table[Mid]);
          Start_Loop_Stmt (Label);
          New_Assign_Stmt
            (New_Obj (Var_Mid),
             New_Dyadic_Op (ON_Div_Ov,
-              New_Dyadic_Op (ON_Add_Ov,
-                New_Obj_Value (Var_Lo),
-                New_Obj_Value (Var_Hi)),
-              New_Lit (New_Unsigned_Literal
-                (Ghdl_Index_Type, 2))));
+                           New_Dyadic_Op (ON_Add_Ov,
+                                          New_Obj_Value (Var_Lo),
+                                          New_Obj_Value (Var_Hi)),
+                           New_Lit (New_Unsigned_Literal
+                                      (Ghdl_Index_Type, 2))));
          New_Assign_Stmt
            (New_Obj (Var_Cmp),
             Translate_Simple_String_Choice
               (Expr_Node,
                New_Address (New_Indexed_Element (New_Obj (Table),
-                 New_Obj_Value (Var_Mid)),
-                 Tinfo.T.Base_Ptr_Type (Mode_Value)),
+                                                 New_Obj_Value (Var_Mid)),
+                            Tinfo.T.Base_Ptr_Type (Mode_Value)),
                C_Node, Tinfo, Func));
+
+         --  Generate:
+         --       if Cmp = Eq then
+         --         Idx := Mid;
+         --         exit;
+         --       end if;
          Start_If_Stmt
            (If_Blk1,
             New_Compare_Op (ON_Eq,
-              New_Obj_Value (Var_Cmp),
-              New_Lit (Ghdl_Compare_Eq),
-              Ghdl_Bool_Type));
+                            New_Obj_Value (Var_Cmp),
+                            New_Lit (Ghdl_Compare_Eq),
+                            Ghdl_Bool_Type));
          New_Assign_Stmt
            (New_Obj (Var_Idx),
             New_Value (New_Indexed_Element (New_Obj (Assoc_Table),
-              New_Obj_Value (Var_Mid))));
+                                            New_Obj_Value (Var_Mid))));
          New_Exit_Stmt (Label);
          Finish_If_Stmt (If_Blk1);
 
+         --  Generate:
+         --       if Cmp = Lt then
+         --         if Mid < Lo then
+         --           Idx := others;
+         --           exit;
+         --         else
+         --           Hi := Mid - 1;
+         --         end if;
+         --       else
+         --         if Mid > Hi then
+         --           Idx := others;
+         --           exit;
+         --         else
+         --           Lo := Mid + 1;
+         --         end if;
+         --       end if;
+         --    end loop;
          Start_If_Stmt
            (If_Blk1,
             New_Compare_Op (ON_Eq,
-              New_Obj_Value (Var_Cmp),
-              New_Lit (Ghdl_Compare_Lt),
-              Ghdl_Bool_Type));
+                            New_Obj_Value (Var_Cmp),
+                            New_Lit (Ghdl_Compare_Lt),
+                            Ghdl_Bool_Type));
          Start_If_Stmt
            (If_Blk2,
             New_Compare_Op (ON_Le,
-              New_Obj_Value (Var_Mid),
-              New_Obj_Value (Var_Lo),
-              Ghdl_Bool_Type));
+                            New_Obj_Value (Var_Mid),
+                            New_Obj_Value (Var_Lo),
+                            Ghdl_Bool_Type));
          if not Has_Others then
             Chap6.Gen_Program_Error (Stmt, Chap6.Prg_Err_Bad_Choice);
          else
@@ -1063,8 +1486,8 @@ package body Trans.Chap8 is
          New_Else_Stmt (If_Blk2);
          New_Assign_Stmt (New_Obj (Var_Hi),
                           New_Dyadic_Op (ON_Sub_Ov,
-                            New_Obj_Value (Var_Mid),
-                            New_Lit (Ghdl_Index_1)));
+                                         New_Obj_Value (Var_Mid),
+                                         New_Lit (Ghdl_Index_1)));
          Finish_If_Stmt (If_Blk2);
 
          New_Else_Stmt (If_Blk1);
@@ -1072,9 +1495,9 @@ package body Trans.Chap8 is
          Start_If_Stmt
            (If_Blk2,
             New_Compare_Op (ON_Ge,
-              New_Obj_Value (Var_Mid),
-              New_Obj_Value (Var_Hi),
-              Ghdl_Bool_Type));
+                            New_Obj_Value (Var_Mid),
+                            New_Obj_Value (Var_Hi),
+                            Ghdl_Bool_Type));
          if not Has_Others then
             Chap6.Gen_Program_Error (Stmt, Chap6.Prg_Err_No_Choice);
          else
@@ -1084,8 +1507,8 @@ package body Trans.Chap8 is
          New_Else_Stmt (If_Blk2);
          New_Assign_Stmt (New_Obj (Var_Lo),
                           New_Dyadic_Op (ON_Add_Ov,
-                            New_Obj_Value (Var_Mid),
-                            New_Lit (Ghdl_Index_1)));
+                                         New_Obj_Value (Var_Mid),
+                                         New_Lit (Ghdl_Index_1)));
          Finish_If_Stmt (If_Blk2);
 
          Finish_If_Stmt (If_Blk1);
@@ -1093,9 +1516,27 @@ package body Trans.Chap8 is
          Finish_Loop_Stmt (Label);
 
          Finish_Declare_Stmt;
+      end;
+
+      --  Generate:
+      --    case Idx is
+      --      when ch1
+      --         | ch2 => stmt_list1;
+      --      when ch3 => stmt_list2;
+      --      ...
+      --    end case;
+      declare
+         Case_Blk                : O_Case_Block;
+         Next_State : State_Type;
+         Choice_State  : State_Type;
+      begin
+         if Has_Suspend then
+            Next_State := State_Allocate;
+         end if;
 
          Start_Case_Stmt (Case_Blk, New_Obj_Value (Var_Idx));
 
+         Nbr_Assocs := 0;
          Choice := Choices_Chain;
          while Choice /= Null_Iir loop
             case Get_Kind (Choice) is
@@ -1103,21 +1544,32 @@ package body Trans.Chap8 is
                   Start_Choice (Case_Blk);
                   New_Expr_Choice (Case_Blk, Others_Lit);
                   Finish_Choice (Case_Blk);
-                  Translate_Statements_Chain
-                    (Get_Associated_Chain (Choice));
+                  if Has_Suspend then
+                     Choice_State := State_Allocate;
+                     State_Jump (Choice_State);
+                  else
+                     Translate_Statements_Chain
+                       (Get_Associated_Chain (Choice));
+                  end if;
                when Iir_Kind_Choice_By_Expression =>
                   if not Get_Same_Alternative_Flag (Choice) then
                      Start_Choice (Case_Blk);
                      New_Expr_Choice
                        (Case_Blk,
                         New_Unsigned_Literal
-                          (Ghdl_Index_Type,
-                           Unsigned_64 (Get_Info (Choice).Choice_Assoc)));
+                          (Ghdl_Index_Type, Unsigned_64 (Nbr_Assocs)));
                      Finish_Choice (Case_Blk);
-                     Translate_Statements_Chain
-                       (Get_Associated_Chain (Choice));
+                     if Has_Suspend then
+                        Choice_State := State_Allocate;
+                        State_Jump (Choice_State);
+                     else
+                        Translate_Statements_Chain
+                          (Get_Associated_Chain (Choice));
+                     end if;
+                     if not Get_Same_Alternative_Flag (Choice) then
+                        Nbr_Assocs := Nbr_Assocs + 1;
+                     end if;
                   end if;
-                  Free_Info (Choice);
                when others =>
                   raise Internal_Error;
             end case;
@@ -1130,6 +1582,11 @@ package body Trans.Chap8 is
          Chap6.Gen_Program_Error (Stmt, Chap6.Prg_Err_No_Choice);
 
          Finish_Case_Stmt (Case_Blk);
+         Close_Temp;
+
+         if Has_Suspend then
+            Translate_Case_Statement_State (Stmt, Next_State);
+         end if;
       end;
    end Translate_String_Case_Statement_Dichotomy;
 
@@ -1138,6 +1595,10 @@ package body Trans.Chap8 is
    procedure Translate_String_Case_Statement_Linear
      (Stmt : Iir_Case_Statement)
    is
+      Has_Suspend : constant Boolean := Get_Suspend_Flag (Stmt);
+      Next_State : State_Type;
+      Choice_State  : State_Type;
+
       Expr_Type : Iir;
       --  Node containing the address of the selector.
       Expr_Node : O_Dnode;
@@ -1172,10 +1633,15 @@ package body Trans.Chap8 is
                   Cond := Translate_Simple_String_Choice
                     (Expr_Node,
                      Chap7.Translate_Expression (Ch_Expr,
-                       Get_Type (Ch_Expr)),
+                                                 Get_Type (Ch_Expr)),
                      Val_Node, Tinfo, Func);
                when Iir_Kind_Choice_By_Others =>
-                  Translate_Statements_Chain (Stmt_Chain);
+                  if Has_Suspend then
+                     Choice_State := State_Allocate;
+                     State_Jump (Choice_State);
+                  else
+                     Translate_Statements_Chain (Stmt_Chain);
+                  end if;
                   return;
                when others =>
                   Error_Kind ("translate_string_choice", Ch);
@@ -1198,12 +1664,18 @@ package body Trans.Chap8 is
             Cond := New_Obj_Value (Cond_Var);
          end if;
          Start_If_Stmt (If_Blk, Cond);
-         Translate_Statements_Chain (Stmt_Chain);
+         if Has_Suspend then
+            Choice_State := State_Allocate;
+            State_Jump (Choice_State);
+         else
+            Translate_Statements_Chain (Stmt_Chain);
+         end if;
          New_Else_Stmt (If_Blk);
          Translate_String_Choice (Ch);
          Finish_If_Stmt (If_Blk);
       end Translate_String_Choice;
    begin
+      Open_Temp;
       Translate_String_Case_Statement_Common
         (Stmt, Expr_Type, Tinfo, Expr_Node, Val_Node);
 
@@ -1212,7 +1684,16 @@ package body Trans.Chap8 is
 
       Cond_Var := Create_Temp (Std_Boolean_Type_Node);
 
+      if Has_Suspend then
+         Next_State := State_Allocate;
+      end if;
+
       Translate_String_Choice (Get_Case_Statement_Alternative_Chain (Stmt));
+      Close_Temp;
+
+      if Has_Suspend then
+         Translate_Case_Statement_State (Stmt, Next_State);
+      end if;
    end Translate_String_Case_Statement_Linear;
 
    procedure Translate_Case_Choice
@@ -1245,19 +1726,16 @@ package body Trans.Chap8 is
 
    procedure Translate_Case_Statement (Stmt : Iir_Case_Statement)
    is
-      Expr       : Iir;
-      Expr_Type  : Iir;
-      Case_Blk   : O_Case_Block;
-      Choice     : Iir;
-      Stmt_Chain : Iir;
+      Expr : constant Iir := Get_Expression (Stmt);
+      Expr_Type : constant Iir := Get_Type (Expr);
    begin
-      Expr := Get_Expression (Stmt);
-      Expr_Type := Get_Type (Expr);
       if Get_Kind (Expr_Type) = Iir_Kind_Array_Subtype_Definition then
+         --  Expression is a one-dimensional array.
          declare
             Nbr_Choices : Natural := 0;
             Choice      : Iir;
          begin
+            --  Count number of choices.
             Choice := Get_Case_Statement_Alternative_Chain (Stmt);
             while Choice /= Null_Iir loop
                case Get_Kind (Choice) is
@@ -1272,30 +1750,53 @@ package body Trans.Chap8 is
                Choice := Get_Chain (Choice);
             end loop;
 
+            --  Select the strategy according to the number of choices.
             if Nbr_Choices < 3 then
                Translate_String_Case_Statement_Linear (Stmt);
             else
-               Translate_String_Case_Statement_Dichotomy (Stmt);
+               Translate_String_Case_Statement_Dichotomy (Stmt, Nbr_Choices);
+            end if;
+         end;
+      else
+         --  Normal case statement: expression is discrete.
+         declare
+            Has_Suspend : constant Boolean := Get_Suspend_Flag (Stmt);
+            Case_Blk   : O_Case_Block;
+            Choice     : Iir;
+            Stmt_Chain : Iir;
+            Next_State : State_Type;
+            Choice_State  : State_Type;
+         begin
+            Start_Case_Stmt (Case_Blk, Chap7.Translate_Expression (Expr));
+            Choice := Get_Case_Statement_Alternative_Chain (Stmt);
+            if Has_Suspend then
+               Next_State := State_Allocate;
+            end if;
+            while Choice /= Null_Iir loop
+               Start_Choice (Case_Blk);
+               Stmt_Chain := Get_Associated_Chain (Choice);
+               loop
+                  Translate_Case_Choice (Choice, Expr_Type, Case_Blk);
+                  Choice := Get_Chain (Choice);
+                  exit when Choice = Null_Iir;
+                  exit when not Get_Same_Alternative_Flag (Choice);
+                  pragma Assert (Get_Associated_Chain (Choice) = Null_Iir);
+               end loop;
+               Finish_Choice (Case_Blk);
+               if Has_Suspend then
+                  Choice_State := State_Allocate;
+                  State_Jump (Choice_State);
+               else
+                  Translate_Statements_Chain (Stmt_Chain);
+               end if;
+            end loop;
+            Finish_Case_Stmt (Case_Blk);
+
+            if Has_Suspend then
+               Translate_Case_Statement_State (Stmt, Next_State);
             end if;
          end;
-         return;
       end if;
-      Start_Case_Stmt (Case_Blk, Chap7.Translate_Expression (Expr));
-      Choice := Get_Case_Statement_Alternative_Chain (Stmt);
-      while Choice /= Null_Iir loop
-         Start_Choice (Case_Blk);
-         Stmt_Chain := Get_Associated_Chain (Choice);
-         loop
-            Translate_Case_Choice (Choice, Expr_Type, Case_Blk);
-            Choice := Get_Chain (Choice);
-            exit when Choice = Null_Iir;
-            exit when not Get_Same_Alternative_Flag (Choice);
-            pragma Assert (Get_Associated_Chain (Choice) = Null_Iir);
-         end loop;
-         Finish_Choice (Case_Blk);
-         Translate_Statements_Chain (Stmt_Chain);
-      end loop;
-      Finish_Case_Stmt (Case_Blk);
    end Translate_Case_Statement;
 
    procedure Translate_Write_Procedure_Call (Imp : Iir; Param_Chain : Iir)
@@ -1531,7 +2032,7 @@ package body Trans.Chap8 is
                New_Association
                  (Constr,
                   Chap7.Translate_Expression (Name_Param,
-                    String_Type_Definition));
+                                              String_Type_Definition));
                New_Procedure_Call (Constr);
             end;
 
@@ -1609,6 +2110,268 @@ package body Trans.Chap8 is
       end case;
    end Translate_Implicit_Procedure_Call;
 
+   function Get_Interface_Kind (Formal : Iir) return Object_Kind_Type is
+   begin
+      if Get_Kind (Formal) = Iir_Kind_Interface_Signal_Declaration then
+         return Mode_Signal;
+      else
+         return Mode_Value;
+      end if;
+   end Get_Interface_Kind;
+
+   procedure Translate_Procedure_Call_State (Call : Iir)
+   is
+      Imp : constant Iir := Get_Implementation (Call);
+      Info : constant Call_Info_Acc := Get_Info (Call);
+
+      Assoc : Iir;
+      Num : Natural;
+   begin
+      Push_Instance_Factory (Info.Call_State_Scope'Access);
+
+      --  Variable for the frame.
+      Info.Call_Frame_Var := Create_Var (Create_Var_Identifier ("FRAME"),
+                                         Get_Info (Imp).Subprg_Params_Type,
+                                         O_Storage_Local);
+      Info.Call_State_Mark := Create_Var (Create_Var_Identifier ("MARK"),
+                                          Ghdl_Ptr_Type, O_Storage_Local);
+
+      Assoc := Get_Parameter_Association_Chain (Call);
+      Num := 0;
+      while Assoc /= Null_Iir loop
+         declare
+            Formal : constant Iir := Strip_Denoting_Name (Get_Formal (Assoc));
+            Ftype : constant Iir := Get_Type (Formal);
+            Ftype_Info : constant Type_Info_Acc := Get_Info (Ftype);
+            Inter : constant Iir := Get_Association_Interface (Assoc);
+            Call_Assoc_Info : Call_Assoc_Info_Acc;
+            Actual : Iir;
+            Act_Type : Iir;
+            Atype_Info : Type_Info_Acc;
+            Has_Bounds_Field : Boolean;
+            Has_Fat_Pointer_Field : Boolean;
+            Has_Value_Field : Boolean;
+            Has_Ref_Field : Boolean;
+            Object_Kind : Object_Kind_Type;
+            Val_Type : O_Tnode;
+
+            --  For unconstrained interfaces:
+            --  * create a field for the fat pointer, unless
+            --    - the expression is locally static
+            function Need_Fat_Pointer_Field return Boolean is
+            begin
+               return not Is_Fully_Constrained_Type (Ftype)
+                 and then (Actual = Null_Iir
+                             or else Get_Expr_Staticness (Actual) /= Locally);
+            end Need_Fat_Pointer_Field;
+
+            --  For unconstrained interfaces:
+            --  * create a field for the bounds, unless
+            --    - the expression is locally static
+            --    - the expression/name type is locally static
+            --    - expression is a call to an unconstrained function
+            --    - expression is an object name that is not a slice
+            function Need_Bounds_Field return Boolean
+            is
+               Kind : Iir_Kind;
+            begin
+               if Is_Fully_Constrained_Type (Ftype) then
+                  return False;
+               end if;
+               if Act_Type /= Null_Iir
+                 and then Get_Type_Staticness (Act_Type) = Locally
+               then
+                  return False;
+               end if;
+               if Actual /= Null_Iir then
+                  if Get_Expr_Staticness (Actual) = Locally then
+                     return False;
+                  end if;
+                  Kind := Get_Kind (Actual);
+                  if (Kind = Iir_Kind_Function_Call
+                        or else Kind in Iir_Kinds_Dyadic_Operator
+                        or else Kind in Iir_Kinds_Monadic_Operator)
+                    and then Is_Fully_Constrained_Type (Get_Type (Actual))
+                  then
+                     return False;
+                  end if;
+                  if Is_Object_Name (Actual)
+                    and then Kind /= Iir_Kind_Slice_Name
+                  then
+                     return False;
+                  end if;
+               end if;
+               return True;
+            end Need_Bounds_Field;
+
+            --  Helper for Need_Value_Field.  Any expression whose result is
+            --  on stack2 doesn't need to be copied (again) on stack2.  This is
+            --  an optimization and the result can be conservative.
+            --  FIXME: also consider attributes (like 'image) and implicit
+            --   functions (like to_string).
+            function Is_Result_On_Stack2_Expression (Expr : Iir) return Boolean
+            is
+               Info : Ortho_Info_Acc;
+               Imp : Iir;
+            begin
+               case Get_Kind (Expr) is
+                  when Iir_Kind_Function_Call =>
+                     Imp := Get_Implementation (Expr);
+                     Info := Get_Info (Imp);
+                     --  Note: Implicit functions don't have info.  A few of
+                     --  them (like to_string) return the result on stack2.
+                     return Info /= null
+                       and then Info.Use_Stack2;
+                  when Iir_Kinds_Monadic_Operator
+                    | Iir_Kinds_Dyadic_Operator =>
+                     return False;
+                  when others =>
+                     return False;
+               end case;
+            end Is_Result_On_Stack2_Expression;
+
+            --  If the associated expression is not a name of an object (never
+            --  the case for a signal interface and variable interface):
+            --  * create a field for the value, unless
+            --    - expression is locally static
+            --    - expression is scalar
+            --    - expression is a call to an unconstrained function
+            --  If the actual is a name of an object, create a field for the
+            --  value only if the object is a signal and the interface is
+            --  a constant (we need to capture the value of the signal).
+            function Need_Value_Field return Boolean
+            is
+               pragma Assert (Actual /= Null_Iir);
+               Act_Obj : constant Iir := Name_To_Object (Actual);
+            begin
+               if Act_Obj /= Null_Iir then
+                  --  Actual is an object.
+                  if (Get_Kind (Formal)
+                        = Iir_Kind_Interface_Constant_Declaration)
+                    and then Is_Signal_Object (Act_Obj)
+                  then
+                     --  The value of the signal needs to be captured.
+                     return True;
+                  end if;
+                  return False;
+               end if;
+
+               if Get_Expr_Staticness (Actual) = Locally
+                 or else (Get_Kind (Act_Type)
+                            in Iir_Kinds_Scalar_Type_Definition)
+                 or else Get_Kind (Ftype) = Iir_Kind_File_Type_Definition
+                 or else Is_Result_On_Stack2_Expression (Actual)
+               then
+                  return False;
+               end if;
+               return True;
+            end Need_Value_Field;
+         begin
+            Call_Assoc_Info := null;
+            Has_Bounds_Field := False;
+            Has_Fat_Pointer_Field := False;
+            Has_Value_Field := False;
+            Has_Ref_Field := False;
+
+            case Iir_Kinds_Association_Element (Get_Kind (Assoc)) is
+               when Iir_Kind_Association_Element_By_Individual =>
+                  --  Create a field for the whole formal.
+                  Has_Value_Field := True;
+                  Actual := Null_Iir;
+                  Act_Type := Get_Actual_Type (Assoc);
+               when Iir_Kind_Association_Element_By_Expression =>
+                  Actual := Get_Actual (Assoc);
+                  Act_Type := Get_Type (Actual);
+               when Iir_Kind_Association_Element_Open =>
+                  Actual := Get_Default_Value (Inter);
+                  Act_Type := Get_Type (Actual);
+            end case;
+
+            --  For out or inout scalar variable, create a field for the
+            --  value.
+            if Actual /= Null_Iir
+              and then (Get_Kind (Inter)
+                          = Iir_Kind_Interface_Variable_Declaration)
+              and then Get_Mode (Inter) /= Iir_In_Mode
+              and then
+              (Formal /= Inter
+                 or else Ftype_Info.Type_Mode in Type_Mode_Call_By_Value)
+            then
+               Has_Ref_Field := True;
+            end if;
+
+            if Formal = Inter
+              and then Ftype_Info.Type_Mode not in Type_Mode_Thin
+            then
+               --  For whole association: create field according to the above
+               --  predicates.
+               --  For thin modes, there is no bounds, no fat pointers and the
+               --  value is directly passed in the parameters.
+               Has_Bounds_Field := Need_Bounds_Field;
+               Has_Fat_Pointer_Field := Need_Fat_Pointer_Field;
+               Has_Value_Field := Has_Value_Field or else Need_Value_Field;
+            end if;
+
+            if Has_Bounds_Field
+              or Has_Fat_Pointer_Field
+              or Has_Value_Field
+              or Has_Ref_Field
+            then
+               --  Create the info and the variables.
+               Call_Assoc_Info := Add_Info (Assoc, Kind_Call_Assoc);
+               Object_Kind := Get_Interface_Kind (Inter);
+               if Has_Ref_Field then
+                  --  Reference to the actual.  Therefore the type of the
+                  --  actual must be used (due to a possible conversion or
+                  --  function call).
+                  Atype_Info := Get_Info (Act_Type);
+                  Call_Assoc_Info.Call_Assoc_Ref := Create_Var
+                    (Create_Var_Identifier (Inter, "__REF", Num),
+                     Atype_Info.Ortho_Ptr_Type (Object_Kind),
+                     O_Storage_Local);
+               end if;
+               if Has_Value_Field then
+                  if Ftype_Info.Type_Mode = Type_Mode_Fat_Array then
+                     --  For unconstrained arrays/records:
+                     --   - the array (if the actual is constrained and not
+                     --                complex) - TODO
+                     --   - a pointer to the base.
+                     Val_Type := Ftype_Info.T.Base_Ptr_Type (Object_Kind);
+                  else
+                     --  For constrained arrays/records:
+                     --   - the base if not complex
+                     --   - a pointer to the base, if complex
+                     if Is_Complex_Type (Ftype_Info) then
+                        Val_Type := Ftype_Info.Ortho_Ptr_Type (Object_Kind);
+                     else
+                        Val_Type := Ftype_Info.Ortho_Type (Object_Kind);
+                     end if;
+                  end if;
+                  Call_Assoc_Info.Call_Assoc_Value := Create_Var
+                    (Create_Var_Identifier (Inter, "__VAL", Num),
+                     Val_Type, O_Storage_Local);
+               end if;
+               if Has_Bounds_Field then
+                  Call_Assoc_Info.Call_Assoc_Bounds := Create_Var
+                    (Create_Var_Identifier (Inter, "__BND", Num),
+                     Ftype_Info.T.Bounds_Type, O_Storage_Local);
+               end if;
+               if Has_Fat_Pointer_Field then
+                  Call_Assoc_Info.Call_Assoc_Fat := Create_Var
+                    (Create_Var_Identifier (Inter, "__FAT", Num),
+                     Ftype_Info.Ortho_Type (Object_Kind));
+               end if;
+               Num := Num + 1;
+            end if;
+         end;
+         Assoc := Get_Chain (Assoc);
+      end loop;
+
+      Pop_Instance_Factory (Info.Call_State_Scope'Access);
+      New_Type_Decl (Create_Identifier ("CALLERTYPE"),
+                     Get_Scope_Type (Info.Call_State_Scope));
+   end Translate_Procedure_Call_State;
+
    function Do_Conversion (Conv : Iir; Expr : Iir; Src : O_Enode)
                           return O_Enode is
    begin
@@ -1699,15 +2462,27 @@ package body Trans.Chap8 is
       return Res;
    end Translate_Individual_Association_Formal;
 
-   function Translate_Subprogram_Call (Imp : Iir; Assoc_Chain : Iir; Obj : Iir)
-                                      return O_Enode
+   function Translate_Subprogram_Call
+     (Call : Iir; Assoc_Chain : Iir; Obj : Iir) return O_Enode
    is
+      Imp : constant Iir := Get_Implementation (Call);
+
       Is_Procedure : constant Boolean :=
         Get_Kind (Imp) = Iir_Kind_Procedure_Declaration;
       Is_Function : constant Boolean := not Is_Procedure;
       Is_Foreign : constant Boolean := Get_Foreign_Flag (Imp);
       Info : constant Subprg_Info_Acc := Get_Info (Imp);
 
+      --  True if the callee is suspendable.
+      Does_Callee_Suspend : constant Boolean := Is_Procedure
+        and then Get_Suspend_Flag (Imp);
+
+      Call_Info : constant Ortho_Info_Acc := Get_Info (Call);
+
+      --  True if the caller is suspendable.  The callee can still be
+      --  suspendable, but cannot suspend.
+      Is_Suspendable : constant Boolean := Call_Info /= null;
+
       type Mnode_Array is array (Natural range <>) of Mnode;
       type O_Enode_Array is array (Natural range <>) of O_Enode;
       Nbr_Assoc : constant Natural :=
@@ -1724,29 +2499,17 @@ package body Trans.Chap8 is
       --  the copy of the scalar.
       Inout_Params : Mnode_Array (0 .. Nbr_Assoc - 1);
 
-      Params_Var : O_Dnode;
+      Params_Var : Var_Type;
       Res : Mnode;
       El : Iir;
       Pos : Natural;
       Constr : O_Assoc_List;
-      Act : Iir;
-      Actual_Type : Iir;
-      Formal : Iir;
-      Mode : Iir_Mode;
-      Base_Formal : Iir;
-      Formal_Type : Iir;
-      Ftype_Info : Type_Info_Acc;
-      Formal_Info : Ortho_Info_Acc;
-      Val : O_Enode;
-      Param : Mnode;
-      Param_Type : Iir;
       Last_Individual : Natural;
-      Ptr : O_Lnode;
-      In_Conv : Iir;
-      Out_Conv : Iir;
-      Out_Expr : Iir;
-      Formal_Object_Kind : Object_Kind_Type;
-      Bounds : Mnode;
+      Mark_Var : Var_Type;
+
+      Call_State : State_Type;
+      Next_State : State_Type;
+      If_Blk : O_If_Block;
    begin
       --  For functions returning an unconstrained object: save the mark.
       if Is_Function and then Info.Use_Stack2 then
@@ -1767,11 +2530,33 @@ package body Trans.Chap8 is
          end;
       end if;
 
-      --  Create the variable containing the parameters (only for procedures).
-      if Is_Procedure and then Info.Subprg_Params_Type /= O_Tnode_Null then
-         Params_Var := Create_Temp (Info.Subprg_Params_Type);
+      if Is_Function or else Info.Subprg_Params_Type = O_Tnode_Null then
+         --  Standard call, like a C function (no parameters struct).
+         pragma Assert (not Does_Callee_Suspend);
+         Params_Var := Null_Var;
+         Mark_Var := Null_Var;
       else
-         Params_Var := O_Dnode_Null;
+         --  Create the variable containing the parameters.
+         --  Save Stack2 mark.  Callee allocate its frame on stack2.
+         if Is_Suspendable then
+            --  The caller is suspendable.
+            Params_Var := Call_Info.Call_Frame_Var;
+            Mark_Var := Call_Info.Call_State_Mark;
+            --  There might be temporary variables created before the
+            --  suspension, eg for range checks.
+            --  Create a scope that will be closed just before the suspension.
+            Open_Temp;
+            Disable_Stack2_Release;
+         else
+            --  Caller does not suspend; create the frame variable.
+            Start_Declare_Stmt;
+            Mark_Var := Create_Var (Create_Var_Identifier ("CMARK"),
+                                    Ghdl_Ptr_Type, O_Storage_Local);
+            Params_Var := Create_Var (Create_Var_Identifier ("CPARAMS"),
+                                      Info.Subprg_Params_Type,
+                                      O_Storage_Local);
+         end if;
+         Set_Stack2_Mark (Get_Var (Mark_Var));
       end if;
 
       --  Evaluate in-out parameters and parameters passed by ref, since
@@ -1785,156 +2570,304 @@ package body Trans.Chap8 is
          E_Params (Pos) := O_Enode_Null;
          Inout_Params (Pos) := Mnode_Null;
 
-         Formal := Strip_Denoting_Name (Get_Formal (El));
-         Base_Formal := Get_Association_Interface (El);
-         Formal_Type := Get_Type (Formal);
-         Formal_Info := Get_Info (Base_Formal);
-         Ftype_Info := Get_Info (Formal_Type);
-
-         if Get_Kind (Base_Formal) = Iir_Kind_Interface_Signal_Declaration
-         then
-            Formal_Object_Kind := Mode_Signal;
-         else
-            Formal_Object_Kind := Mode_Value;
-         end if;
-
-         case Get_Kind (El) is
-            when Iir_Kind_Association_Element_Open =>
-               Act := Get_Default_Value (Formal);
-               In_Conv := Null_Iir;
-            when Iir_Kind_Association_Element_By_Expression =>
-               Act := Get_Actual (El);
-               In_Conv := Get_In_Conversion (El);
-            when Iir_Kind_Association_Element_By_Individual =>
-               Actual_Type := Get_Actual_Type (El);
-
-               if Ftype_Info.Type_Mode = Type_Mode_Fat_Array then
-                  --  Create the constraints and then the object.
-                  Chap3.Create_Array_Subtype (Actual_Type);
-                  Bounds := Chap3.Get_Array_Type_Bounds (Actual_Type);
-                  Param := Create_Temp (Ftype_Info, Formal_Object_Kind);
-                  Chap3.Translate_Object_Allocation
-                    (Param, Alloc_Stack, Formal_Type, Bounds);
-               else
-                  --  Create the object.
-                  Param := Create_Temp (Ftype_Info, Formal_Object_Kind);
-                  Chap4.Allocate_Complex_Object
-                    (Formal_Type, Alloc_Stack, Param);
-               end if;
+         declare
+            Assoc_Info : Call_Assoc_Info_Acc;
+            Base_Formal : constant Iir := Get_Association_Interface (El);
+            Formal : constant Iir := Strip_Denoting_Name (Get_Formal (El));
+            Formal_Type : constant Iir := Get_Type (Formal);
+            Ftype_Info : constant Type_Info_Acc := Get_Info (Formal_Type);
+            Formal_Info : constant Ortho_Info_Acc := Get_Info (Base_Formal);
+            Formal_Object_Kind : constant Object_Kind_Type :=
+              Get_Interface_Kind (Base_Formal);
+            Act : Iir;
+            Actual_Type : Iir;
+            In_Conv : Iir;
+            Param : Mnode;
+            Param_Type : Iir;
+            Val : O_Enode;
+            Mval : Mnode;
+            Mode : Iir_Mode;
+            Ptr : O_Lnode;
+            Bounds : Mnode;
+         begin
+            --  To translate user redefined operators,
+            --  translate_operator_function_call creates associations, that
+            --  have not corresponding infos.  Do not try to get assoc info
+            --  for non-suspendable procedures.
+            --  FIXME: either transform operator to a function call in canon,
+            --    or directly translate function call.
+            if Does_Callee_Suspend then
+               Assoc_Info := Get_Info (El);
+            else
+               Assoc_Info := null;
+            end if;
 
-               --  Save the object as it will be used by the following
-               --  associations.
-               Last_Individual := Pos;
-               Params (Pos) := Param;
+            case Get_Kind (El) is
+               when Iir_Kind_Association_Element_Open =>
+                  Act := Get_Default_Value (Formal);
+                  In_Conv := Null_Iir;
+               when Iir_Kind_Association_Element_By_Expression =>
+                  Act := Get_Actual (El);
+                  In_Conv := Get_In_Conversion (El);
+               when Iir_Kind_Association_Element_By_Individual =>
+                  Actual_Type := Get_Actual_Type (El);
+
+                  if Assoc_Info = null then
+                     Param := Create_Temp (Ftype_Info, Formal_Object_Kind);
+                  else
+                     declare
+                        Param_Var : Var_Type;
+                     begin
+                        if Ftype_Info.Type_Mode = Type_Mode_Fat_Array then
+                           Param_Var := Assoc_Info.Call_Assoc_Fat;
+                        else
+                           Param_Var := Assoc_Info.Call_Assoc_Value;
+                        end if;
+                        Param := Stabilize (Get_Var (Param_Var, Ftype_Info,
+                                                     Formal_Object_Kind));
+                     end;
+                  end if;
 
-               if Formal_Info.Interface_Field /= O_Fnode_Null then
-                  --  Set the PARAMS field.
-                  Ptr := New_Selected_Element
-                    (New_Obj (Params_Var), Formal_Info.Interface_Field);
-                  New_Assign_Stmt (Ptr, M2E (Param));
-               end if;
+                  declare
+                     Alloc : Allocation_Kind;
+                  begin
+                     if Does_Callee_Suspend then
+                        Alloc := Alloc_Return;
+                     else
+                        Alloc := Alloc_Stack;
+                     end if;
+
+                     if Ftype_Info.Type_Mode = Type_Mode_Fat_Array then
+                        --  Create the constraints and then the object.
+                        --  FIXME: do not allocate bounds.
+                        Chap3.Create_Array_Subtype (Actual_Type);
+                        Bounds := Chap3.Get_Array_Type_Bounds (Actual_Type);
+                        Chap3.Translate_Object_Allocation
+                          (Param, Alloc, Formal_Type, Bounds);
+                     else
+                        --  Create the object.
+                        Chap4.Allocate_Complex_Object
+                          (Formal_Type, Alloc, Param);
+                     end if;
+                  end;
+
+                  --  Save the object as it will be used by the following
+                  --  associations.
+                  Last_Individual := Pos;
+                  Params (Pos) := Param;
+
+                  if Formal_Info.Interface_Field /= O_Fnode_Null then
+                     --  Set the PARAMS field.
+                     Ptr := New_Selected_Element
+                       (Get_Var (Params_Var), Formal_Info.Interface_Field);
+                     New_Assign_Stmt (Ptr, M2E (Param));
+                  end if;
 
-               goto Continue;
-            when others =>
-               Error_Kind ("translate_procedure_call", El);
-         end case;
-         Actual_Type := Get_Type (Act);
-
-         --  Evaluate the actual.
-         Param_Type := Actual_Type;
-         case Get_Kind (Base_Formal) is
-            when Iir_Kind_Interface_Constant_Declaration
-              | Iir_Kind_Interface_File_Declaration =>
-               --  No conversion here.
-               pragma Assert (In_Conv = Null_Iir);
-               Val := Chap7.Translate_Expression (Act, Formal_Type);
-               Param_Type := Formal_Type;
-            when Iir_Kind_Interface_Signal_Declaration =>
-               --  No conversion.
-               Param := Chap6.Translate_Name (Act);
-               Val := M2E (Param);
-            when Iir_Kind_Interface_Variable_Declaration =>
-               Mode := Get_Mode (Base_Formal);
-               if Mode = Iir_In_Mode then
-                  Val := Chap7.Translate_Expression (Act);
-               else
+                  goto Continue;
+               when others =>
+                  Error_Kind ("translate_procedure_call", El);
+            end case;
+            Actual_Type := Get_Type (Act);
+
+            --  Evaluate the actual.
+            Param_Type := Actual_Type;
+            case Get_Kind (Base_Formal) is
+               when Iir_Kind_Interface_Constant_Declaration
+                 | Iir_Kind_Interface_File_Declaration =>
+                  --  No conversion here.
+                  pragma Assert (In_Conv = Null_Iir);
+                  Val := Chap7.Translate_Expression (Act, Formal_Type);
+                  Param_Type := Formal_Type;
+               when Iir_Kind_Interface_Signal_Declaration =>
+                  --  No conversion.
                   Param := Chap6.Translate_Name (Act);
-                  if Base_Formal /= Formal
-                    or else Ftype_Info.Type_Mode in Type_Mode_Pass_By_Copy
-                  then
-                     --  For out/inout, we need to keep the reference for the
-                     --  copy-out.
-                     Stabilize (Param);
-                     Params (Pos) := Param;
-                  end if;
-                  if In_Conv = Null_Iir
-                    and then Mode = Iir_Out_Mode
-                    and then Ftype_Info.Type_Mode in Type_Mode_Thin
-                    and then Ftype_Info.Type_Mode /= Type_Mode_File
-                  then
-                     --  Scalar OUT interface.  Just give an initial value.
-                     --  FIXME: individual association ??
-                     Val := Chap4.Get_Scalar_Initial_Value (Formal_Type);
-                     Param_Type := Formal_Type;
+                  Val := M2E (Param);
+               when Iir_Kind_Interface_Variable_Declaration =>
+                  Mode := Get_Mode (Base_Formal);
+                  if Mode = Iir_In_Mode then
+                     Val := Chap7.Translate_Expression (Act);
                   else
-                     Val := M2E (Param);
+                     Param := Chap6.Translate_Name (Act);
+                     if Base_Formal /= Formal
+                       or else Ftype_Info.Type_Mode in Type_Mode_Call_By_Value
+                     then
+                        --  For out/inout, we need to keep the reference
+                        --  for the copy-out.
+                        Stabilize (Param);
+                        Params (Pos) := Param;
+
+                        if Assoc_Info /= null then
+                           --  Save reference in local frame.
+                           New_Assign_Stmt
+                             (Get_Var (Assoc_Info.Call_Assoc_Ref),
+                              M2Addr (Param));
+                        end if;
+                     end if;
+                     if In_Conv = Null_Iir
+                       and then Mode = Iir_Out_Mode
+                       and then Ftype_Info.Type_Mode in Type_Mode_Thin
+                       and then Ftype_Info.Type_Mode /= Type_Mode_File
+                     then
+                        --  Scalar OUT interface.  Just give an initial value.
+                        --  FIXME: individual association ??
+                        Val := Chap4.Get_Scalar_Initial_Value (Formal_Type);
+                        Param_Type := Formal_Type;
+                     else
+                        Val := M2E (Param);
+                     end if;
+                     if Is_Foreign
+                       and then Ftype_Info.Type_Mode in Type_Mode_Pass_By_Copy
+                     then
+                        --  Scalar parameters of foreign procedures (of mode
+                        --  out or inout) are passed by address, create a copy
+                        --  of the value.
+                        Inout_Params (Pos) :=
+                          Create_Temp (Ftype_Info, Mode_Value);
+                     end if;
                   end if;
-
-                  if Is_Foreign
-                    and then Ftype_Info.Type_Mode in Type_Mode_Pass_By_Copy
-                  then
-                     --  Scalar parameters of foreign procedures (of mode out
-                     --  or inout) are passed by address, create a copy of the
-                     --  value.
-                     Inout_Params (Pos) :=
-                       Create_Temp (Ftype_Info, Mode_Value);
+                  if In_Conv /= Null_Iir then
+                     Val := Do_Conversion (In_Conv, Act, Val);
+                     Act := In_Conv;
+                     Param_Type := Get_Type (In_Conv);
                   end if;
+               when others =>
+                  Error_Kind ("translate_procedure_call(2)", Formal);
+            end case;
+
+            --  Implicit conversion to formal type.
+            if Param_Type /= Formal_Type then
+               --  Implicit array conversion or subtype check.
+               Val := Chap7.Translate_Implicit_Conv
+                 (Val, Param_Type, Formal_Type, Formal_Object_Kind, Act);
+            end if;
+            if Get_Kind (Base_Formal) /= Iir_Kind_Interface_Signal_Declaration
+            then
+               Val := Chap3.Maybe_Insert_Scalar_Check (Val, Act, Formal_Type);
+            end if;
+
+            --  Assign actual, if needed.
+            if Base_Formal /= Formal then
+               --  Individual association: assign the individual actual to
+               --  the whole actual.
+               Param := Translate_Individual_Association_Formal
+                 (Formal, Formal_Info, Params (Last_Individual));
+               Chap7.Translate_Assign
+                 (Param, Val, Act, Formal_Type, El);
+
+            elsif Assoc_Info /= null then
+               --  Only for whole association.
+               pragma Assert (Base_Formal = Formal);
+
+               Mval := Stabilize
+                 (E2M (Val, Ftype_Info, Formal_Object_Kind), True);
+
+               if Assoc_Info.Call_Assoc_Fat /= Null_Var then
+                  --  Fat pointer.  VAL is a pointer to a fat pointer, so copy
+                  --  the fat pointer to the FAT field, and set the PARAM
+                  --  field to FAT field.
+                  declare
+                     Fat : Mnode;
+                  begin
+                     Fat := Stabilize
+                       (Get_Var (Assoc_Info.Call_Assoc_Fat,
+                                 Ftype_Info, Formal_Object_Kind));
+                     Copy_Fat_Pointer (Fat, Mval);
+
+                     --  Set PARAM field to the address of the FAT field.
+                     pragma Assert
+                       (Formal_Info.Interface_Field /= O_Fnode_Null);
+                     New_Assign_Stmt
+                       (New_Selected_Element (Get_Var (Params_Var),
+                                              Formal_Info.Interface_Field),
+                        M2E (Fat));
+                  end;
                end if;
-               if In_Conv /= Null_Iir then
-                  Val := Do_Conversion (In_Conv, Act, Val);
-                  Act := In_Conv;
-                  Param_Type := Get_Type (In_Conv);
+
+               if Assoc_Info.Call_Assoc_Bounds /= Null_Var then
+                  --  Copy the bounds.
+                  pragma Assert (Assoc_Info.Call_Assoc_Fat /= Null_Var);
+                  Chap3.Copy_Bounds
+                    (New_Address (Get_Var (Assoc_Info.Call_Assoc_Bounds),
+                                  Ftype_Info.T.Bounds_Ptr_Type),
+                     M2Addr (Chap3.Get_Array_Bounds (Mval)),
+                     Formal_Type);
                end if;
-            when others =>
-               Error_Kind ("translate_procedure_call(2)", Formal);
-         end case;
 
-         --  Implicit conversion to formal type.
-         if Param_Type /= Formal_Type then
-            --  Implicit array conversion or subtype check.
-            Val := Chap7.Translate_Implicit_Conv
-              (Val, Param_Type, Formal_Type, Formal_Object_Kind, Act);
-         end if;
-         if Get_Kind (Base_Formal) /= Iir_Kind_Interface_Signal_Declaration
-         then
-            Val := Chap3.Maybe_Insert_Scalar_Check (Val, Act, Formal_Type);
-         end if;
+               if Assoc_Info.Call_Assoc_Value /= Null_Var then
+                  if Ftype_Info.Type_Mode = Type_Mode_Fat_Array then
+                     pragma Assert (Assoc_Info.Call_Assoc_Fat /= Null_Var);
+                     --  Allocate array base
+                     Param := Stabilize
+                       (Get_Var (Assoc_Info.Call_Assoc_Fat,
+                                 Ftype_Info, Formal_Object_Kind));
+                     Chap3.Allocate_Fat_Array_Base
+                       (Alloc_Return, Param, Formal_Type);
+                     --  NOTE: Call_Assoc_Value is not used, the base is
+                     --  directly allocated in the fat pointer.
+                  else
+                     Param := Get_Var (Assoc_Info.Call_Assoc_Value,
+                                       Ftype_Info, Formal_Object_Kind);
+                     Stabilize (Param);
+                     Chap4.Allocate_Complex_Object
+                       (Formal_Type, Alloc_Return, Param);
+                     New_Assign_Stmt
+                       (New_Selected_Element
+                          (Get_Var (Params_Var), Formal_Info.Interface_Field),
+                        M2Addr (Param));
+                  end if;
+                  Chap3.Translate_Object_Copy
+                    (Param, M2E (Mval), Formal_Type);
+               end if;
 
-         --  Assign actual, if needed.
-         if Base_Formal /= Formal then
-            --  Individual association: assign the individual actual to the
-            --  whole actual.
-            Param := Translate_Individual_Association_Formal
-              (Formal, Formal_Info, Params (Last_Individual));
-            Chap7.Translate_Assign
-              (Param, Val, Act, Formal_Type, El);
-         elsif Formal_Info.Interface_Field /= O_Fnode_Null then
-            --  Set the PARAMS field.
-            Ptr := New_Selected_Element
-              (New_Obj (Params_Var), Formal_Info.Interface_Field);
-            New_Assign_Stmt (Ptr, Val);
-         elsif Inout_Params (Pos) /= Mnode_Null then
-            Chap3.Translate_Object_Copy (Inout_Params (Pos), Val, Formal_Type);
-         else
-            E_Params (Pos) := Val;
-         end if;
+               if Assoc_Info.Call_Assoc_Value = Null_Var
+                 and then Assoc_Info.Call_Assoc_Fat = Null_Var
+               then
+                  --  Set the PARAMS field.
+                  New_Assign_Stmt
+                    (New_Selected_Element
+                       (Get_Var (Params_Var), Formal_Info.Interface_Field),
+                     M2E (Mval));
+               end if;
+            elsif Formal_Info.Interface_Field /= O_Fnode_Null then
+               --  Set the PARAMS field.
+               Ptr := New_Selected_Element
+                 (Get_Var (Params_Var), Formal_Info.Interface_Field);
+               New_Assign_Stmt (Ptr, Val);
+            elsif Inout_Params (Pos) /= Mnode_Null then
+               Chap3.Translate_Object_Copy
+                 (Inout_Params (Pos), Val, Formal_Type);
+               E_Params (Pos) := M2Addr (Inout_Params (Pos));
+            else
+               E_Params (Pos) := Val;
+            end if;
+
+            << Continue >> null;
+         end;
 
-         << Continue >> null;
          El := Get_Chain (El);
          Pos := Pos + 1;
       end loop;
 
       --  Second stage:  really perform the call.
+      if Does_Callee_Suspend then
+         --  Set initial state.
+         New_Assign_Stmt
+           (New_Selected_Element (Get_Var (Params_Var),
+                                  Info.Subprg_State_Field),
+            New_Lit (Ghdl_Index_0));
+      end if;
+      if Is_Suspendable then
+         --  Close the scope created at the beginning.
+         Close_Temp;
+
+         Call_State := State_Allocate;
+         Next_State := State_Allocate;
+
+         --  Call state.
+         State_Jump (Call_State);
+         State_Start (Call_State);
+      end if;
+
       Start_Association (Constr, Info.Ortho_Func);
 
       if Is_Function and then Info.Res_Interface /= O_Dnode_Null then
@@ -1942,10 +2875,11 @@ package body Trans.Chap8 is
          New_Association (Constr, M2E (Res));
       end if;
 
-      if Params_Var /= O_Dnode_Null then
+      if Params_Var /= Null_Var then
          --  Parameters record (for procedures).
-         New_Association (Constr, New_Address (New_Obj (Params_Var),
-                                               Info.Subprg_Params_Ptr));
+         New_Association
+           (Constr, New_Address (Get_Var (Params_Var),
+                                 Info.Subprg_Params_Ptr));
       end if;
 
       if Obj /= Null_Iir then
@@ -1960,30 +2894,28 @@ package body Trans.Chap8 is
       El := Assoc_Chain;
       Pos := 0;
       while El /= Null_Iir loop
-         Formal := Strip_Denoting_Name (Get_Formal (El));
-         Base_Formal := Get_Association_Interface (El);
-         Formal_Info := Get_Info (Base_Formal);
-
-         if Formal_Info.Interface_Field = O_Fnode_Null then
-            --  Not a PARAMS field.
-            if Get_Kind (El) = Iir_Kind_Association_Element_By_Individual then
-               --  Pass the whole data for an individual association.
-               New_Association (Constr, M2E (Params (Pos)));
-            elsif Base_Formal = Formal then
-               --  Whole association.
-               if Inout_Params (Pos) /= Mnode_Null then
-                  Val := M2Addr (Inout_Params (Pos));
-               else
-                  Val := E_Params (Pos);
+         declare
+            Formal : constant Iir := Strip_Denoting_Name (Get_Formal (El));
+            Base_Formal : constant Iir := Get_Association_Interface (El);
+            Formal_Info : constant Ortho_Info_Acc := Get_Info (Base_Formal);
+         begin
+            if Formal_Info.Interface_Field = O_Fnode_Null then
+               --  Not a PARAMS field.
+               if Get_Kind (El) = Iir_Kind_Association_Element_By_Individual
+               then
+                  --  Pass the whole data for an individual association.
+                  New_Association (Constr, M2E (Params (Pos)));
+               elsif Base_Formal = Formal then
+                  --  Whole association.
+                  New_Association (Constr, E_Params (Pos));
                end if;
-               New_Association (Constr, Val);
             end if;
-         end if;
 
-         if Get_Kind (El) = Iir_Kind_Association_Element_Open then
-            --  Do not share nodes for default values: clean them.
-            Chap9.Destroy_Types (Get_Default_Value (Base_Formal));
-         end if;
+            if Get_Kind (El) = Iir_Kind_Association_Element_Open then
+               --  Do not share nodes for default values: clean them.
+               Chap9.Destroy_Types (Get_Default_Value (Base_Formal));
+            end if;
+         end;
 
          El := Get_Chain (El);
          Pos := Pos + 1;
@@ -2002,65 +2934,144 @@ package body Trans.Chap8 is
          end if;
       end if;
 
+      if Is_Suspendable then
+         Start_If_Stmt
+           (If_Blk,
+            New_Compare_Op (ON_Neq,
+                            New_Value (New_Selected_Element
+                                         (Get_Var (Params_Var),
+                                          Info.Subprg_State_Field)),
+                            New_Lit (Ghdl_Index_1),
+                            Ghdl_Bool_Type));
+         State_Suspend (Call_State);
+         New_Else_Stmt (If_Blk);
+         --  Return state.
+         Open_Temp;
+      end if;
+
       --  Copy-out non-composite parameters.
       El := Assoc_Chain;
       Pos := 0;
       while El /= Null_Iir loop
          if Get_Kind (El) = Iir_Kind_Association_Element_By_Individual then
             Last_Individual := Pos;
+            declare
+               Assoc_Info : constant Call_Assoc_Info_Acc := Get_Info (El);
+               Formal_Type : Iir;
+               Base_Formal : Iir;
+               Ftype_Info : Type_Info_Acc;
+               Formal_Object_Kind : Object_Kind_Type;
+            begin
+               if Assoc_Info /= null then
+                  Formal_Type := Get_Type (Get_Formal (El));
+                  Ftype_Info := Get_Info (Formal_Type);
+                  Base_Formal := Get_Association_Interface (El);
+                  Formal_Object_Kind := Get_Interface_Kind (Base_Formal);
+                  declare
+                     Param_Var : Var_Type;
+                  begin
+                     if Ftype_Info.Type_Mode = Type_Mode_Fat_Array then
+                        Param_Var := Assoc_Info.Call_Assoc_Fat;
+                     else
+                        Param_Var := Assoc_Info.Call_Assoc_Value;
+                     end if;
+                     Params (Pos) := Stabilize
+                       (Get_Var (Param_Var, Ftype_Info, Formal_Object_Kind));
+                  end;
+               end if;
+            end;
          elsif Params (Pos) /= Mnode_Null then
-            Formal := Strip_Denoting_Name (Get_Formal (El));
-            Base_Formal := Get_Association_Interface (El);
-
-            pragma Assert (Get_Kind (Base_Formal)
-                             = Iir_Kind_Interface_Variable_Declaration);
-            pragma Assert (Get_Mode (Base_Formal) in Iir_Out_Modes);
-
-            Formal_Type := Get_Type (Formal);
-            Ftype_Info := Get_Info (Formal_Type);
-            Formal_Info := Get_Info (Base_Formal);
-
-            --  Extract the value
-            if Base_Formal /= Formal then
-               --  By individual, copy back.
-               Param := Translate_Individual_Association_Formal
-                 (Formal, Formal_Info, Params (Last_Individual));
-            elsif Inout_Params (Pos) /= Mnode_Null then
-               Param := Inout_Params (Pos);
-            else
-               pragma Assert (Formal_Info.Interface_Field /= O_Fnode_Null);
-               Ptr := New_Selected_Element
-                 (New_Obj (Params_Var), Formal_Info.Interface_Field);
-               Param := Lv2M (Ptr, Ftype_Info, Mode_Value);
-            end if;
+            declare
+               Assoc_Info : constant Call_Assoc_Info_Acc := Get_Info (El);
+               Formal : constant Iir := Strip_Denoting_Name (Get_Formal (El));
+               Base_Formal : constant Iir := Get_Association_Interface (El);
+               Formal_Type : constant Iir := Get_Type (Formal);
+               Ftype_Info : constant Type_Info_Acc := Get_Info (Formal_Type);
+               Formal_Info : constant Ortho_Info_Acc := Get_Info (Base_Formal);
+               Act : Iir;
+               Actual_Type : Iir;
+               Param : Mnode;
+               Val : O_Enode;
+               Ptr : O_Lnode;
+               Out_Conv : Iir;
+               Out_Expr : Iir;
+            begin
+               pragma Assert (Get_Kind (Base_Formal)
+                                = Iir_Kind_Interface_Variable_Declaration);
+               pragma Assert (Get_Mode (Base_Formal) in Iir_Out_Modes);
+
+               --  Extract the value
+               if Base_Formal /= Formal then
+                  --  By individual, copy back.
+                  Param := Translate_Individual_Association_Formal
+                    (Formal, Formal_Info, Params (Last_Individual));
+               elsif Inout_Params (Pos) /= Mnode_Null then
+                  Param := Inout_Params (Pos);
+               else
+                  pragma Assert (Formal_Info.Interface_Field /= O_Fnode_Null);
+                  Ptr := New_Selected_Element
+                    (Get_Var (Params_Var), Formal_Info.Interface_Field);
+                  case Type_Mode_Valid (Ftype_Info.Type_Mode) is
+                     when Type_Mode_Pass_By_Copy =>
+                        Param := Lv2M (Ptr, Ftype_Info, Mode_Value);
+                     when Type_Mode_Pass_By_Address =>
+                        Param := Lp2M (Ptr, Ftype_Info, Mode_Value);
+                  end case;
+               end if;
 
-            Out_Conv := Get_Out_Conversion (El);
-            if Out_Conv = Null_Iir then
-               Out_Expr := Formal;
-               Val := M2E (Param);
-            else
-               Out_Expr := Out_Conv;
-               Val := Do_Conversion (Out_Conv, Formal, M2E (Param));
-            end if;
+               Out_Conv := Get_Out_Conversion (El);
+               if Out_Conv = Null_Iir then
+                  Out_Expr := Formal;
+                  Val := M2E (Param);
+               else
+                  Out_Expr := Out_Conv;
+                  Val := Do_Conversion (Out_Conv, Formal, M2E (Param));
+               end if;
 
-            Chap7.Translate_Assign
-              (Params (Pos), Val, Out_Expr, Get_Type (Get_Actual (El)), El);
+               Act := Get_Actual (El);
+               Actual_Type := Get_Type (Act);
+               if Assoc_Info = null then
+                  Param := Params (Pos);
+               else
+                  Param := Lp2M (Get_Var (Assoc_Info.Call_Assoc_Ref),
+                                 Get_Info (Actual_Type), Mode_Value);
+               end if;
+               Chap7.Translate_Assign (Param, Val, Out_Expr, Actual_Type, El);
+            end;
          end if;
          El := Get_Chain (El);
          Pos := Pos + 1;
       end loop;
 
+      if Is_Function or else Info.Subprg_Params_Type = O_Tnode_Null then
+         null;
+      else
+         if Is_Suspendable then
+            Close_Temp;
+
+            --  Release stack2 memory.
+            Release_Stack2 (Get_Var (Call_Info.Call_State_Mark));
+
+            --  End of call.
+            State_Jump (Next_State);
+            Finish_If_Stmt (If_Blk);
+            State_Start (Next_State);
+         else
+            Release_Stack2 (Get_Var (Mark_Var));
+            Finish_Declare_Stmt;
+         end if;
+      end if;
+
       return O_Enode_Null;
    end Translate_Subprogram_Call;
 
    procedure Translate_Procedure_Call (Stmt : Iir_Procedure_Call)
    is
       Assoc_Chain : constant Iir := Get_Parameter_Association_Chain (Stmt);
-      Imp : constant Iir := Get_Implementation (Stmt);
       Obj : constant Iir := Get_Method_Object (Stmt);
       Res : O_Enode;
    begin
-      Res := Translate_Subprogram_Call (Imp, Assoc_Chain, Obj);
+      Res := Translate_Subprogram_Call (Stmt, Assoc_Chain, Obj);
       pragma Assert (Res = O_Enode_Null);
    end Translate_Procedure_Call;
 
@@ -2070,16 +3081,21 @@ package body Trans.Chap8 is
       Timeout     : constant Iir := Get_Timeout_Clause (Stmt);
       Sensitivity : Iir_List;
       Constr      : O_Assoc_List;
+      Resume_State : State_Type;
    begin
       Sensitivity := Get_Sensitivity_List (Stmt);
-
       if Sensitivity = Null_Iir_List and Cond /= Null_Iir then
-         --  Extract sensitivity list.
+         --  Extract sensitivity from condition.
          Sensitivity := Create_Iir_List;
          Canon.Canon_Extract_Sensitivity (Cond, Sensitivity);
          Set_Sensitivity_List (Stmt, Sensitivity);
       end if;
 
+      --  The wait statement must be within a suspendable process/subprogram.
+      pragma Assert (State_Enabled);
+
+      Resume_State := State_Allocate;
+
       --  Check for simple cases.
       if Sensitivity = Null_Iir_List
         and then Cond = Null_Iir
@@ -2090,11 +3106,26 @@ package body Trans.Chap8 is
             New_Procedure_Call (Constr);
          else
             --  Wait for a timeout.
+            Open_Temp;
             Start_Association (Constr, Ghdl_Process_Wait_Timeout);
             New_Association (Constr, Chap7.Translate_Expression
                              (Timeout, Time_Type_Definition));
             New_Procedure_Call (Constr);
+            Close_Temp;
+         end if;
+
+         --  Suspend.
+         State_Suspend (Resume_State);
+
+         --  Resume point.
+         State_Start (Resume_State);
+
+         if State_Debug and then Timeout = Null_Iir then
+            --  A process exit must not resume!
+            Chap6.Gen_Program_Error (Stmt, Chap6.Prg_Err_Unreach_State);
          end if;
+
+         --  End of simple cases.
          return;
       end if;
 
@@ -2113,49 +3144,57 @@ package body Trans.Chap8 is
          Chap9.Destroy_Types_In_List (Sensitivity);
       end if;
 
+      --  suspend ();
+      --  FIXME: this just sets the state, could be done in Add_Sensitivity
+      --  or Set_Timeout.
+      Start_Association (Constr, Ghdl_Process_Wait_Suspend);
+      New_Procedure_Call (Constr);
+
       if Cond = Null_Iir then
-         declare
-            V : O_Dnode;
-         begin
-            --  declare
-            --     v : __ghdl_bool_type_node;
-            --  begin
-            --     v := suspend ();
-            --  end;
-            Open_Temp;
-            V := Create_Temp (Ghdl_Bool_Type);
-            Start_Association (Constr, Ghdl_Process_Wait_Suspend);
-            New_Assign_Stmt (New_Obj (V), New_Function_Call (Constr));
-            Close_Temp;
-         end;
+         State_Suspend (Resume_State);
       else
          declare
-            Label : O_Snode;
+            Eval_State : State_Type;
+            If_Blk1, If_Blk2 : O_If_Block;
          begin
-            --  start loop
-            Start_Loop_Stmt (Label);
-
-            --    if suspend() then        --  return true if timeout.
-            --      exit;
-            --    end if;
-            Start_Association (Constr, Ghdl_Process_Wait_Suspend);
-            Gen_Exit_When (Label, New_Function_Call (Constr));
-
-            --    if condition then
-            --      exit;
-            --    end if;
+            Eval_State := State_Allocate;
+
+            State_Suspend (Eval_State);
+
+            --  EVAL_STATE:
+            State_Start (Eval_State);
+
+            --    if timed_out() then
+            --      GOTO RESUME_STATE;
+            --    else
+            Start_Association (Constr, Ghdl_Process_Wait_Timed_Out);
+            Start_If_Stmt (If_Blk1, New_Function_Call (Constr));
+            State_Jump (Resume_State);
+            New_Else_Stmt (If_Blk1);
+
+            --      if condition then
+            --        GOTO RESUME_STATE;
+            --      else
+            --        SUSPEND EVAL_STATE;
+            --      end if;
             Open_Temp;
-            Gen_Exit_When
-              (Label,
+            Start_If_Stmt
+              (If_Blk2,
                Chap7.Translate_Expression (Cond, Boolean_Type_Definition));
+            State_Jump (Resume_State);
+            New_Else_Stmt (If_Blk2);
+            State_Suspend (Eval_State);
+            Finish_If_Stmt (If_Blk2);
             Close_Temp;
 
-            --  end loop;
-            Finish_Loop_Stmt (Label);
+            --    end if;
+            Finish_If_Stmt (If_Blk1);
          end;
       end if;
 
-      --  wait_close;
+      --  RESUME_STATE:
+      --    wait_close;
+      State_Start (Resume_State);
       Start_Association (Constr, Ghdl_Process_Wait_Close);
       New_Procedure_Call (Constr);
    end Translate_Wait_Statement;
@@ -2979,7 +4018,12 @@ package body Trans.Chap8 is
                Call : constant Iir := Get_Procedure_Call (Stmt);
                Imp  : constant Iir := Get_Implementation (Call);
             begin
-               Canon.Canon_Subprogram_Call (Call);
+               if not Get_Suspend_Flag (Stmt) then
+                  --  Suspendable calls were already canonicalized.
+                  Canon.Canon_Subprogram_Call (Call);
+                  Trans.Update_Node_Infos;
+               end if;
+
                if Is_Implicit_Subprogram (Imp) then
                   Translate_Implicit_Procedure_Call (Call);
                else
diff --git a/src/vhdl/translate/trans-chap8.ads b/src/vhdl/translate/trans-chap8.ads
index 27ddfe805..94755d315 100644
--- a/src/vhdl/translate/trans-chap8.ads
+++ b/src/vhdl/translate/trans-chap8.ads
@@ -17,11 +17,49 @@
 --  02111-1307, USA.
 
 package Trans.Chap8 is
+   --  If TRUE, generate extra-code to catch at run-time incoherent state
+   --  issues.
+   State_Debug : constant Boolean := True;
+
+   --  The initial state.  Used in process to loop.
+   State_Init : constant State_Type := 0;
+
+   --  The state for 'return' in a subprogram.
+   State_Return : constant State_Type := 1;
+
+   --  Called at the entry of the generated procedure to setup the state
+   --  machinery: set the local state variable, create the state machine
+   --  (loop, case, first choice).  The current position in the graph is
+   --  vertex 0 (initial state): there is an implicit State_Allocate and a
+   --  State_Start.  This is not reentrant (does not nest).
+   procedure State_Entry (Info : Ortho_Info_Acc);
+
+   --  Last action of the generated procedure: close the case and the loop.
+   --  Destroy the state machinery.
+   procedure State_Leave (Parent : Iir);
+
+   --  True if the current process or subprogram is state based.
+   function State_Enabled return Boolean;
+
+   --  Create a new state.
+   function State_Allocate return State_Type;
+
+   --  Start statements for STATE.
+   procedure State_Start (State : State_Type);
+
+   --  Jump to state NEXT_STATE.  Note: this doesn't modify the control flow,
+   --  so there must be no statements after State_Jump until the next
+   --  State_Start.
+   procedure State_Jump (Next_State : State_Type);
+
+   --  Suspend the current process or subprogram.  It will resume to
+   --  NEXT_STATE.
+   procedure State_Suspend (Next_State : State_Type);
+
    procedure Translate_Statements_Chain (First : Iir);
 
    --  Return true if there is a return statement in the chain.
-   function Translate_Statements_Chain_Has_Return (First : Iir)
-                                                      return Boolean;
+   function Translate_Statements_Chain_Has_Return (First : Iir) return Boolean;
 
    --  Create a case branch for CHOICE.
    --  Used by case statement and aggregates.
@@ -35,8 +73,14 @@ package Trans.Chap8 is
                                   Val      : Unsigned_64;
                                   Itype    : Iir);
 
+   --  Create declarations for a for-loop statement.
+   procedure Translate_For_Loop_Statement_Declaration (Stmt : Iir);
+
    procedure Translate_Report (Stmt : Iir; Subprg : O_Dnode; Level : Iir);
 
-   function Translate_Subprogram_Call (Imp : Iir; Assoc_Chain : Iir; Obj : Iir)
-                                      return O_Enode;
+   --  Create the state record for the CALL procedure call.
+   procedure Translate_Procedure_Call_State (Call : Iir);
+
+   function Translate_Subprogram_Call
+     (Call : Iir; Assoc_Chain : Iir; Obj : Iir) return O_Enode;
 end Trans.Chap8;
diff --git a/src/vhdl/translate/trans-chap9.adb b/src/vhdl/translate/trans-chap9.adb
index d96ad6fc3..0736c6dcd 100644
--- a/src/vhdl/translate/trans-chap9.adb
+++ b/src/vhdl/translate/trans-chap9.adb
@@ -97,7 +97,10 @@ package body Trans.Chap9 is
 
    procedure Translate_Process_Statement (Proc : Iir; Base : Block_Info_Acc)
    is
+      use Trans.Chap8;
       Info       : constant Proc_Info_Acc := Get_Info (Proc);
+      Is_Non_Sensitized : constant Boolean :=
+        Get_Kind (Proc) = Iir_Kind_Process_Statement;
       Inter_List : O_Inter_List;
       Instance   : O_Dnode;
    begin
@@ -112,9 +115,18 @@ package body Trans.Chap9 is
       --  Push scope for architecture declarations.
       Set_Scope_Via_Param_Ptr (Base.Block_Scope, Instance);
 
+      if Is_Non_Sensitized then
+         Chap8.State_Entry (Info);
+      end if;
+
       Chap8.Translate_Statements_Chain
         (Get_Sequential_Statement_Chain (Proc));
 
+      if Is_Non_Sensitized then
+         Chap8.State_Jump (State_Init);
+         Chap8.State_Leave (Proc);
+      end if;
+
       Clear_Scope (Base.Block_Scope);
       Pop_Local_Factory;
       Finish_Subprogram_Body;
@@ -232,6 +244,19 @@ package body Trans.Chap9 is
       Push_Instance_Factory (Info.Process_Scope'Access);
       Chap4.Translate_Declaration_Chain (Proc);
 
+      if Get_Kind (Proc) = Iir_Kind_Process_Statement then
+         --  The state variable.
+         Info.Process_State := Create_Var (Create_Var_Identifier ("STATE"),
+                                           Ghdl_Index_Type, O_Storage_Local);
+
+         --  Add declarations for statements (iterator, call) and state.
+         Chap4.Translate_Statements_Chain_State_Declaration
+           (Get_Sequential_Statement_Chain (Proc),
+            Info.Process_Locvar_Scope'Access);
+
+         Add_Scope_Field (Wki_Locvars, Info.Process_Locvar_Scope);
+      end if;
+
       if Flag_Direct_Drivers then
          --  Create direct drivers.
          Drivers := Trans_Analyzes.Extract_Drivers (Proc);
@@ -1311,6 +1336,10 @@ package body Trans.Chap9 is
          if List_Orig = Iir_List_All then
             Destroy_Iir_List (List);
          end if;
+      else
+         --  Initialize state.
+         New_Assign_Stmt
+           (Get_Var (Info.Process_State), New_Lit (Ghdl_Index_0));
       end if;
    end Elab_Process;
 
diff --git a/src/vhdl/translate/trans-helpers2.adb b/src/vhdl/translate/trans-helpers2.adb
index 9a4b28552..6b8b28b49 100644
--- a/src/vhdl/translate/trans-helpers2.adb
+++ b/src/vhdl/translate/trans-helpers2.adb
@@ -26,8 +26,7 @@ with Trans.Foreach_Non_Composite;
 package body Trans.Helpers2 is
    use Trans.Helpers;
 
-   procedure Copy_Fat_Pointer (D : Mnode; S: Mnode)
-   is
+   procedure Copy_Fat_Pointer (D : Mnode; S: Mnode) is
    begin
       New_Assign_Stmt (M2Lp (Chap3.Get_Array_Base (D)),
                        M2Addr (Chap3.Get_Array_Base (S)));
diff --git a/src/vhdl/translate/trans.adb b/src/vhdl/translate/trans.adb
index e8ba4a06c..c6cbd50c2 100644
--- a/src/vhdl/translate/trans.adb
+++ b/src/vhdl/translate/trans.adb
@@ -349,6 +349,14 @@ package body Trans is
          Pop_Build_Instance;
       end Pop_Local_Factory;
 
+      procedure Create_Union_Scope
+        (Scope : out Var_Scope_Type; Stype : O_Tnode) is
+      begin
+         pragma Assert (Scope.Scope_Type = O_Tnode_Null);
+         pragma Assert (Scope.Kind = Var_Scope_None);
+         Scope.Scope_Type := Stype;
+      end Create_Union_Scope;
+
       procedure Set_Scope_Via_Field
         (Scope       : in out Var_Scope_Type;
          Scope_Field : O_Fnode; Scope_Parent : Var_Scope_Acc) is
@@ -1748,6 +1756,23 @@ package body Trans is
          Finish_If_Stmt (If_Blk);
       end Gen_Exit_When;
 
+      procedure Set_Stack2_Mark (Var : O_Lnode)
+      is
+         Constr : O_Assoc_List;
+      begin
+         Start_Association (Constr, Ghdl_Stack2_Mark);
+         New_Assign_Stmt (Var, New_Function_Call (Constr));
+      end Set_Stack2_Mark;
+
+      procedure Release_Stack2 (Var : O_Lnode)
+      is
+         Constr : O_Assoc_List;
+      begin
+         Start_Association (Constr, Ghdl_Stack2_Release);
+         New_Association (Constr, New_Value (Var));
+         New_Procedure_Call (Constr);
+      end Release_Stack2;
+
       --  Create a temporary variable.
       type Temp_Level_Type;
       type Temp_Level_Acc is access Temp_Level_Type;
@@ -1765,6 +1790,9 @@ package body Trans is
          --  first use.
          Emitted         : Boolean;
 
+         --  If true, do not mark/release stack2.
+         No_Stack2_Mark : Boolean;
+
          --  Declaration of the variable for the stack2 mark.  The stack2 will
          --  be released at the end of the scope (if used).
          Stack2_Mark     : O_Dnode;
@@ -1783,27 +1811,39 @@ package body Trans is
       is
          L : Temp_Level_Acc;
       begin
+         --  Allocate a new record.
          if Old_Level /= null then
+            --  From unused ones.
             L := Old_Level;
             Old_Level := L.Prev;
          else
+            --  No unused, create a new one.
             L := new Temp_Level_Type;
          end if;
+
          L.all := (Prev => Temp_Level,
                    Level => 0,
                    Id => 0,
                    Emitted => False,
+                   No_Stack2_Mark => False,
                    Stack2_Mark => O_Dnode_Null);
          if Temp_Level /= null then
             L.Level := Temp_Level.Level + 1;
          end if;
          Temp_Level := L;
+
          if Flag_Debug_Temp then
             New_Debug_Comment_Stmt
               ("Open_Temp level " & Natural'Image (L.Level));
          end if;
       end Open_Temp;
 
+      procedure Disable_Stack2_Release is
+      begin
+         pragma Assert (not Temp_Level.No_Stack2_Mark);
+         Temp_Level.No_Stack2_Mark := True;
+      end Disable_Stack2_Release;
+
       procedure Open_Local_Temp is
       begin
          Open_Temp;
@@ -1815,15 +1855,10 @@ package body Trans is
          return Temp_Level.Stack2_Mark /= O_Dnode_Null;
       end Has_Stack2_Mark;
 
-      procedure Stack2_Release
-      is
-         Constr : O_Assoc_List;
+      procedure Stack2_Release is
       begin
          if Temp_Level.Stack2_Mark /= O_Dnode_Null then
-            Start_Association (Constr, Ghdl_Stack2_Release);
-            New_Association (Constr,
-                             New_Value (New_Obj (Temp_Level.Stack2_Mark)));
-            New_Procedure_Call (Constr);
+            Release_Stack2 (New_Obj (Temp_Level.Stack2_Mark));
             Temp_Level.Stack2_Mark := O_Dnode_Null;
          end if;
       end Stack2_Release;
@@ -1832,10 +1867,9 @@ package body Trans is
       is
          L : Temp_Level_Acc;
       begin
-         if Temp_Level = null then
-            --  OPEN_TEMP was not called.
-            raise Internal_Error;
-         end if;
+         --  Check that OPEN_TEMP was called.
+         pragma Assert (Temp_Level /= null);
+
          if Flag_Debug_Temp then
             New_Debug_Comment_Stmt
               ("Close_Temp level " & Natural'Image (Temp_Level.Level));
@@ -1879,9 +1913,7 @@ package body Trans is
          end loop;
       end Free_Old_Temp;
 
-      procedure Create_Temp_Stack2_Mark
-      is
-         Constr : O_Assoc_List;
+      procedure Create_Temp_Stack2_Mark is
       begin
          if Temp_Level.Stack2_Mark /= O_Dnode_Null then
             --  Only the first mark in a region is registred.
@@ -1889,10 +1921,14 @@ package body Trans is
             --  first mark.
             return;
          end if;
+
+         if Temp_Level.No_Stack2_Mark then
+            --  Stack2 mark and release was explicitely disabled.
+            return;
+         end if;
+
          Temp_Level.Stack2_Mark := Create_Temp (Ghdl_Ptr_Type);
-         Start_Association (Constr, Ghdl_Stack2_Mark);
-         New_Assign_Stmt (New_Obj (Temp_Level.Stack2_Mark),
-                          New_Function_Call (Constr));
+         Set_Stack2_Mark (New_Obj (Temp_Level.Stack2_Mark));
       end Create_Temp_Stack2_Mark;
 
       function Create_Temp (Atype : O_Tnode) return O_Dnode
diff --git a/src/vhdl/translate/trans.ads b/src/vhdl/translate/trans.ads
index 47c050b3b..e9a66c177 100644
--- a/src/vhdl/translate/trans.ads
+++ b/src/vhdl/translate/trans.ads
@@ -159,6 +159,7 @@ package Trans is
    Wki_R_Len         : O_Ident;
    Wki_Base          : O_Ident;
    Wki_Bounds        : O_Ident;
+   Wki_Locvars       : O_Ident;
 
    --  ALLOCATION_KIND defines the type of memory storage.
    --  ALLOC_STACK means the object is allocated on the local stack and
@@ -270,9 +271,14 @@ package Trans is
       --  Destroy a local scope.
       procedure Pop_Local_Factory;
 
+      --  Create a special scope for declarations in statements.  The scope
+      --  structure is opaque (typically a union).
+      procedure Create_Union_Scope
+        (Scope : out Var_Scope_Type; Stype : O_Tnode);
+
       --  Set_Scope defines how to access to variables of SCOPE.
       --  Variables defined in SCOPE can be accessed via field SCOPE_FIELD
-      --  in scope SCOPE_PARENT.
+      --  of scope SCOPE_PARENT.
       procedure Set_Scope_Via_Field
         (Scope       : in out Var_Scope_Type;
          Scope_Field : O_Fnode; Scope_Parent : Var_Scope_Acc);
@@ -642,6 +648,8 @@ package Trans is
       Kind_Index,
       Kind_Expr,
       Kind_Subprg,
+      Kind_Call,
+      Kind_Call_Assoc,
       Kind_Object,
       Kind_Signal,
       Kind_Alias,
@@ -651,6 +659,8 @@ package Trans is
       Kind_Process,
       Kind_Psl_Directive,
       Kind_Loop,
+      Kind_Loop_State,
+      Kind_Locvar_State,
       Kind_Block,
       Kind_Generate,
       Kind_Component,
@@ -659,7 +669,6 @@ package Trans is
       Kind_Package_Instance,
       Kind_Config,
       Kind_Assoc,
-      Kind_Str_Choice,
       Kind_Design_File,
       Kind_Library
      );
@@ -915,6 +924,12 @@ package Trans is
    end record;
    type Subprg_Resolv_Info_Acc is access Subprg_Resolv_Info;
 
+   --  In order to support resume feature of non-sensitized processes and
+   --  procedure, a state variable is added to encode vertices of the control
+   --  flow graph (only suspendable vertices are considered: an inner loop
+   --  that doesn't suspend is not decomposed by this mechanism).
+   type State_Type is new Nat32;
+
    --  Complex types.
    --
    --  A complex type is not a VHDL notion, but a translation notion.
@@ -1151,6 +1166,15 @@ package Trans is
             Subprg_Params_Type : O_Tnode := O_Tnode_Null;
             Subprg_Params_Ptr  : O_Tnode := O_Tnode_Null;
 
+            --  Field in the parameter struct for the suspend state. Also the
+            --  suspend state is not a parameter, it is initialized by the
+            --  caller.
+            Subprg_State_Field : O_Fnode := O_Fnode_Null;
+
+            --  Field in the parameter struct for local variables.
+            Subprg_Locvars_Field : O_Fnode := O_Fnode_Null;
+            Subprg_Locvars_Scope : aliased Var_Scope_Type;
+
             --  Access to the declarations within this subprogram.
             Subprg_Frame_Scope : aliased Var_Scope_Type;
 
@@ -1169,6 +1193,21 @@ package Trans is
             Subprg_Exit   : O_Snode := O_Snode_Null;
             Subprg_Result : O_Dnode := O_Dnode_Null;
 
+         when Kind_Call =>
+            Call_State_Scope : aliased Var_Scope_Type;
+            Call_State_Mark : Var_Type := Null_Var;
+            Call_Frame_Var : Var_Type := Null_Var;
+
+         when Kind_Call_Assoc =>
+            --  Variable containing a reference to the actual, for scalar
+            --  copyout.  The value is passed in the parameter.
+            Call_Assoc_Ref : Var_Type := Null_Var;
+
+            --  Variable containing the value, the bounds and the fat vector.
+            Call_Assoc_Value : Var_Type := Null_Var;
+            Call_Assoc_Bounds : Var_Type := Null_Var;
+            Call_Assoc_Fat : Var_Type := Null_Var;
+
          when Kind_Object =>
             --  For constants: set when the object is defined as a constant.
             Object_Static   : Boolean;
@@ -1195,7 +1234,14 @@ package Trans is
             Alias_Kind : Object_Kind_Type;
 
          when Kind_Iterator =>
+            --  Iterator variable.
             Iterator_Var : Var_Type;
+            --  Iterator right bound (used only if the iterator is a range
+            --  expression).
+            Iterator_Right : Var_Type;
+            --  Iterator range pointer (used only if the iterator is not a
+            --  range expression).
+            Iterator_Range : Var_Type;
 
          when Kind_Interface =>
             --  Ortho declaration for the interface. If not null, there is
@@ -1226,6 +1272,13 @@ package Trans is
             --  Subprogram for the process.
             Process_Subprg : O_Dnode;
 
+            --  Variable (in the frame) containing the current state (a
+            --  number) used to resume the process.
+            Process_State : Var_Type := Null_Var;
+
+            --  Union containing local declarations for statements.
+            Process_Locvar_Scope : aliased Var_Scope_Type;
+
             --  List of drivers if Flag_Direct_Drivers.
             Process_Drivers : Direct_Drivers_Acc := null;
 
@@ -1262,6 +1315,22 @@ package Trans is
             --  Used to next from for-loop, with an exit statment.
             Label_Next : O_Snode;
 
+         when Kind_Loop_State =>
+            --  Likewise but for a suspendable loop.
+            --  State next: evaluate condition for a while-loop, update
+            --  iterator for a for-loop.
+            Loop_State_Next : State_Type;
+            --  Body of a for-loop, not used for a while-loop.
+            Loop_State_Body: State_Type;
+            --  State after the loop.
+            Loop_State_Exit  : State_Type;
+            --  Access to declarations of the iterator.
+            Loop_State_Scope : aliased Var_Scope_Type;
+            Loop_Locvar_Scope : aliased Var_Scope_Type;
+
+         when Kind_Locvar_State =>
+            Locvar_Scope : aliased Var_Scope_Type;
+
          when Kind_Block =>
             --  Access to declarations of this block.
             Block_Scope : aliased Var_Scope_Type;
@@ -1400,16 +1469,6 @@ package Trans is
             Assoc_In  : Assoc_Conv_Info;
             Assoc_Out : Assoc_Conv_Info;
 
-         when Kind_Str_Choice =>
-            --  List of choices, used to sort them.
-            Choice_Chain  : Ortho_Info_Acc;
-            --  Association index.
-            Choice_Assoc  : Natural;
-            --  Corresponding choice simple expression.
-            Choice_Expr   : Iir;
-            --  Corresponding choice.
-            Choice_Parent : Iir;
-
          when Kind_Design_File =>
             Design_Filename : O_Dnode;
 
@@ -1425,12 +1484,15 @@ package Trans is
    subtype Incomplete_Type_Info_Acc is Ortho_Info_Acc (Kind_Incomplete_Type);
    subtype Index_Info_Acc is Ortho_Info_Acc (Kind_Index);
    subtype Subprg_Info_Acc is Ortho_Info_Acc (Kind_Subprg);
+   subtype Call_Info_Acc is Ortho_Info_Acc (Kind_Call);
+   subtype Call_Assoc_Info_Acc is Ortho_Info_Acc (Kind_Call_Assoc);
    subtype Object_Info_Acc is Ortho_Info_Acc (Kind_Object);
    subtype Signal_Info_Acc is Ortho_Info_Acc (Kind_Signal);
    subtype Alias_Info_Acc is Ortho_Info_Acc (Kind_Alias);
    subtype Proc_Info_Acc is Ortho_Info_Acc (Kind_Process);
    subtype Psl_Info_Acc is Ortho_Info_Acc (Kind_Psl_Directive);
    subtype Loop_Info_Acc is Ortho_Info_Acc (Kind_Loop);
+   subtype Loop_State_Info_Acc is Ortho_Info_Acc (Kind_Loop_State);
    subtype Block_Info_Acc is Ortho_Info_Acc (Kind_Block);
    subtype Generate_Info_Acc is Ortho_Info_Acc (Kind_Generate);
    subtype Comp_Info_Acc is Ortho_Info_Acc (Kind_Component);
@@ -1692,6 +1754,10 @@ package Trans is
       --  Generate code to exit from loop LABEL iff COND is true.
       procedure Gen_Exit_When (Label : O_Snode; Cond : O_Enode);
 
+      --  Low-level stack2 mark and release.
+      procedure Set_Stack2_Mark (Var : O_Lnode);
+      procedure Release_Stack2 (Var : O_Lnode);
+
       --  Create a region for temporary variables.  The region is only created
       --  on demand (at the first Create_Temp*), so you must be careful not
       --  to nest with control statement.  For example, the following
@@ -1735,6 +1801,11 @@ package Trans is
       --  Manually release stack2.  Used for fine-tuning only.
       procedure Stack2_Release;
 
+      --  Used only in procedure calls to disable the release of stack2, as
+      --  it might be part of the state of the call.  Must be called just after
+      --  Open_Temp.
+      procedure Disable_Stack2_Release;
+
       --  Free all old temp.
       --  Used only to free memory.
       procedure Free_Old_Temp;
diff --git a/src/vhdl/translate/trans_decls.ads b/src/vhdl/translate/trans_decls.ads
index e2c87f042..270442e75 100644
--- a/src/vhdl/translate/trans_decls.ads
+++ b/src/vhdl/translate/trans_decls.ads
@@ -44,6 +44,7 @@ package Trans_Decls is
    Ghdl_Process_Wait_Set_Timeout : O_Dnode;
    Ghdl_Process_Wait_Add_Sensitivity : O_Dnode;
    Ghdl_Process_Wait_Suspend : O_Dnode;
+   Ghdl_Process_Wait_Timed_Out : O_Dnode;
    Ghdl_Process_Wait_Close : O_Dnode;
 
    --  Register a sensitivity for a process.
diff --git a/src/vhdl/translate/translation.adb b/src/vhdl/translate/translation.adb
index a3d2375a7..d83758418 100644
--- a/src/vhdl/translate/translation.adb
+++ b/src/vhdl/translate/translation.adb
@@ -392,6 +392,7 @@ package body Translation is
       Wki_R_Len := Get_Identifier ("r_len");
       Wki_Base := Get_Identifier ("BASE");
       Wki_Bounds := Get_Identifier ("BOUNDS");
+      Wki_Locvars := Get_Identifier ("LOCVARS");
 
       Sizetype := New_Unsigned_Type (32);
       New_Type_Decl (Get_Identifier ("__ghdl_size_type"), Sizetype);
@@ -1676,12 +1677,18 @@ package body Translation is
       New_Interface_Decl (Interfaces, Param, Wki_Sig, Ghdl_Signal_Ptr);
       Finish_Subprogram_Decl (Interfaces, Ghdl_Process_Wait_Add_Sensitivity);
 
-      --  function __ghdl_process_wait_suspend return __ghdl_bool_type;
-      Start_Function_Decl
+      --  procedure __ghdl_process_wait_suspend (void);
+      Start_Procedure_Decl
         (Interfaces, Get_Identifier ("__ghdl_process_wait_suspend"),
-         O_Storage_External, Ghdl_Bool_Type);
+         O_Storage_External);
       Finish_Subprogram_Decl (Interfaces, Ghdl_Process_Wait_Suspend);
 
+      --  function __ghdl_process_wait_timed_out return __ghdl_bool_type;
+      Start_Function_Decl
+        (Interfaces, Get_Identifier ("__ghdl_process_wait_timed_out"),
+         O_Storage_External, Ghdl_Bool_Type);
+      Finish_Subprogram_Decl (Interfaces, Ghdl_Process_Wait_Timed_Out);
+
       --  void __ghdl_process_wait_close (void);
       Start_Procedure_Decl
         (Interfaces, Get_Identifier ("__ghdl_process_wait_close"),