handle universal real div integer evaluation,

more optimizations added,
multi-thread ready grt,
bug fixes

18 files changed, 859 insertions, 406 deletions

diff --git a/translate/gcc/dist.sh b/translate/gcc/dist.sh
index e16475a..dab7afb 100755
--- a/translate/gcc/dist.sh
+++ b/translate/gcc/dist.sh
@@ -346,6 +346,9 @@ grt-waves.ads
 grt-waves.adb
 grt-avls.ads
 grt-avls.adb
+grt-unithread.ads
+grt-unithread.adb
+grt-threads.ads
 grt.ads
 main.adb
 main.ads
@@ -610,7 +613,7 @@ put manual.html
 put more.html
 put links.html
 put bug.html
-put waveform.html
+put waveviewer.html
 put gtkwave-patch.tgz
 put favicon.ico
 lcd ghdl
diff --git a/translate/grt/Makefile b/translate/grt/Makefile
index 5e0a7cd..ff68bc7 100644
--- a/translate/grt/Makefile
+++ b/translate/grt/Makefile
@@ -15,7 +15,8 @@
 #  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.
-GRT_FLAGS=-g
+GRT_FLAGS=-g -O
+GRT_ADAFLAGS=-gnatn
 
 ADAC=gnatgcc
 GNATFLAGS=$(CFLAGS) -gnatf -gnaty3befhkmr -gnatwlu
diff --git a/translate/grt/Makefile.inc b/translate/grt/Makefile.inc
index 4e4388a..02fa8d9 100644
--- a/translate/grt/Makefile.inc
+++ b/translate/grt/Makefile.inc
@@ -26,7 +26,8 @@
 # grt_libdir: the place to put grt.
 # GRTSRCDIR: the source directory of grt.
 # target: GCC target
-# GRT_FLAGS: compilation flags.
+# GRT_FLAGS: common (Ada + C + asm) compilation flags.
+# GRT_ADAFLAGS: compilation flags for Ada
 
 # Convert the target variable into a space separated list of architecture,
 # manufacturer, and operating system and assign each of those to its own
@@ -92,7 +93,7 @@ libgrt.a: $(GRT_ADD_OBJS) run-bind.o main.o grt-files
 
 run-bind.adb: grt-force
 	gnatmake -c $(GNATFLAGS) -aI$(GRTSRCDIR) $(GRT_PRAGMA_FLAG) ghdl_main \
-	  -cargs $(GRT_FLAGS)
+	  $(GRT_ADAFLAGS) -cargs $(GRT_FLAGS)
 	gnatbind -Lgrt_ -o run-bind.adb -n ghdl_main.ali
 
 run-bind.o: run-bind.adb
@@ -137,6 +138,9 @@ grt-cbinding.o: $(GRTSRCDIR)/grt-cbinding.c
 grt-cvpi.o: $(GRTSRCDIR)/grt-cvpi.c
 	$(CC) -c $(GRT_FLAGS) -o $@ $<
 
+grt-cthreads.o: $(GRTSRCDIR)/grt-cthreads.c
+	$(CC) -c $(GRT_FLAGS) -o $@ $<
+
 grt-files: run-bind.adb
 	sed -e "1,/-- *BEGIN/d" -e "/-- *END/,\$$d" \
 	  -e "s/   --   //" < $< > $@
diff --git a/translate/grt/config/ia64.S b/translate/grt/config/ia64.S
index cd77d49..d7fb2d1 100644
--- a/translate/grt/config/ia64.S
+++ b/translate/grt/config/ia64.S
@@ -13,6 +13,8 @@ grt_stack_loop:
 	;;
 	br 1b
 	.endp
+
+	frame_size = 480
 	
 	.global grt_stack_switch#
 	.proc grt_stack_switch#
@@ -23,118 +25,209 @@ grt_stack_loop:
 	//  f2-f5, f16-f31                         [20]
 	//  p1-p5, p16-p63                         [1] ???
 	//  b1-b5                                  [5]
+	//  f2-f5, f16-f31			   [20*16]
 grt_stack_switch:
 	.prologue 2, 2
 	.vframe r2
+	{
 	alloc r31=ar.pfs, 2, 0, 0, 0
-	adds r12 = -160, r12
+	mov r14 = ar.rsc
+	adds r12 = -(frame_size + 16), r12
 	.body
 	;;
+	}
 	// Save ar.rsc, ar.bsp, ar.pfs
 	{
-	mov r14 = ar.rsc
+	st8 [r12] = r14      		// sp + 0  <- ar.rsc
 	mov r15 = ar.bsp
 	adds r22 = (5*8), r12
-	}
 	;;
+	}
 	{
-	st8 [r12] = r14      		// sp + 0  <- ar.rsc
 	st8.spill [r22] = r1, 8		// sp + 40 <- r1
+	;; 
+	st8.spill [r22] = r4, 8		// sp + 48 <- r4
 	adds r20 = 8, r12
-	}
 	;;
+	}
 	st8 [r20] = r15, 8		// sp + 8  <- ar.bsp
-	st8.spill [r22] = r4, 8		// sp + 48 <- r4
-	;;
-	mov r15 = ar.lc
-	st8 [r20] = r31, 8		// sp + 16 <- ar.pfs
 	st8.spill [r22] = r5, 8		// sp + 56 <- r5
+	mov r15 = ar.lc
 	;;
-	mov r14 = b0
-	st8 [r20] = r15, 8		// sp + 24 <- ar.lc
+	{
+	st8 [r20] = r31, 8		// sp + 16 <- ar.pfs
 	//  Flush dirty registers to the backing store
 	flushrs
+	mov r14 = b0
 	;;
+	}
+	{
+	st8 [r20] = r15, 8		// sp + 24 <- ar.lc
 	//  Set the RSE in enforced lazy mode.
 	mov ar.rsc = 0
-	;; 
-	mov r15 = ar.rnat	
-	st8.spill [r22] = r6, 8		// sp + 64 <- r6
 	;;
+	}
+	{
+	//  Save sp.
+	st8 [r33] = r12
+	mov r15 = ar.rnat
 	mov r16 = b1
-	st8.spill [r22] = r7, 16	// sp + 72 <- r7
+	;;
+	}
+	{
+	st8.spill [r22] = r6, 8		// sp + 64 <- r6
 	st8 [r20] = r15, 64		// sp + 32 <- ar.rnat
 	;;
+	}
+	{
+	st8.spill [r22] = r7, 16	// sp + 72 <- r7
+	st8 [r20] = r14, 8		// sp + 96 <- b0
 	mov r15 = b2
+	;;
+	}
+	{
 	mov r17 = ar.unat
-	st8 [r20] = r14, 8		// sp + 96 <- b0
 	;;
-	mov r14 = b3
 	st8 [r22] = r17, 24		// sp + 88 <- ar.unat
+	mov r14 = b3
+	;; 
+	}
+	{
 	st8 [r20] = r16, 16		// sp + 104 <- b1
-	;;
 	st8 [r22] = r15, 16		// sp + 112 <- b2
-	st8 [r20] = r14, 16		// sp + 120 <- b3
-	mov r16 = b4
+	mov r17 = b4
 	;;
-	st8 [r22] = r16, 16		// sp + 128 <- b4
+	}
+	{
+	st8 [r20] = r14, 16		// sp + 120 <- b3
+	st8 [r22] = r17, 16		// sp + 128 <- b4
+	mov r15 = b5
+	;; 
+	}
+	{
 	//  Read new sp.
 	ld8 r21 = [r32]
-	mov r15 = b5
 	;; 
+	st8 [r20] = r15, 24		// sp + 136 <- b5
 	mov r14 = pr
-	st8 [r20] = r15			// sp + 136 <- b5
+	;; 
+	}
 	;;
-	st8 [r22] = r14			// sp + 144 <- pr
-	adds r20 = 8, r21
+	st8 [r22] = r14, 32		// sp + 144 <- pr
+	stf.spill [r20] = f2, 32	// sp + 160 <- f2
+	;;
+	stf.spill [r22] = f3, 32	// sp + 176 <- f3
+	stf.spill [r20] = f4, 32	// sp + 192 <- f4
+	;;
+	stf.spill [r22] = f5, 32	// sp + 208 <- f5
+	stf.spill [r20] = f16, 32	// sp + 224 <- f16
+	;;
+	stf.spill [r22] = f17, 32	// sp + 240 <- f17
+	stf.spill [r20] = f18, 32	// sp + 256 <- f18
 	;;
+	stf.spill [r22] = f19, 32	// sp + 272 <- f19
+	stf.spill [r20] = f20, 32	// sp + 288 <- f20
+	;;
+	stf.spill [r22] = f21, 32	// sp + 304 <- f21
+	stf.spill [r20] = f22, 32	// sp + 320 <- f22
+	;;
+	stf.spill [r22] = f23, 32	// sp + 336 <- f23
+	stf.spill [r20] = f24, 32	// sp + 352 <- f24
+	;;
+	stf.spill [r22] = f25, 32	// sp + 368 <- f25
+	stf.spill [r20] = f26, 32	// sp + 384 <- f26
+	;;
+	stf.spill [r22] = f27, 32	// sp + 400 <- f27
+	stf.spill [r20] = f28, 32	// sp + 416 <- f28
+	;;
+	stf.spill [r22] = f29, 32	// sp + 432 <- f29
+	stf.spill [r20] = f30, 32	// sp + 448 <- f30
+	;;
+	{
+	stf.spill [r22] = f31, 32	// sp + 464 <- f31
 	invala	
-	//  Save sp.
-	st8 [r33] = r12
+	adds r20 = 8, r21
+	;;
+	}
 	ld8 r14 = [r21], 88		// sp + 0 (ar.rsc)
+	ld8 r16 = [r20], 8		// sp + 8 (ar.bsp)
 	;; 
 	ld8 r15 = [r21], -56		// sp + 88 (ar.unat)
-	ld8 r16 = [r20], 8		// sp + 8 (ar.bsp)
-	;;
-	ld8 r17 = [r21], 8		// sp + 32 (ar.rnat)
+	;; 
 	ld8 r18 = [r20], 8		// sp + 16 (ar.pfs)
 	mov ar.unat = r15
+	ld8 r17 = [r21], 8		// sp + 32 (ar.rnat)
 	;;
 	ld8 r15 = [r20], 72		// sp + 24 (ar.lc)
 	ld8.fill r1 = [r21], 8		// sp + 40 (r1)
 	mov ar.bspstore = r16
 	;; 
-	mov ar.rnat = r17
-	mov ar.pfs = r18
 	ld8.fill r4 = [r21], 8		// sp + 48 (r4)
+	mov ar.pfs = r18
+	mov ar.rnat = r17
 	;;
 	mov ar.rsc = r14
 	mov ar.lc = r15
 	ld8 r17 = [r20], 8		// sp + 96 (b0)
 	;;
-	mov b0 = r17
+	{
 	ld8.fill r5 = [r21], 8		// sp + 56 (r5)
 	ld8 r14 = [r20], 8		// sp + 104 (b1)
+	mov b0 = r17
 	;;
-	mov b1 = r14
+	}
+	{
 	ld8.fill r6 = [r21], 8		// sp + 64 (r6)
 	ld8 r15 = [r20], 8		// sp + 112 (b2)
+	mov b1 = r14
 	;;
-	mov b2 = r15
-	ld8.fill r7 = [r21], 8		// sp + 72 (r7)
+	}
+	ld8.fill r7 = [r21], 64		// sp + 72 (r7)
 	ld8 r14 = [r20], 8		// sp + 120 (b3)
+	mov b2 = r15
 	;;
+	ld8 r15 = [r20], 16		// sp + 128 (b4)
+	ld8 r16 = [r21], 40		// sp + 136 (b5)
 	mov b3 = r14
-	ld8 r15 = [r20], 8		// sp + 128 (b4)
 	;;
+	{
+	ld8 r14 = [r20], 16		// sp + 144 (pr)
+	;;
+	ldf.fill f2 = [r20], 32		// sp + 160 (f2)
 	mov b4 = r15
-	ld8 r14 = [r20], 8		// sp + 136 (b5)
 	;;
-	mov b5 = r14
-	ld8 r15 = [r20], 8		// sp + 144 (pr)
-	mov r12 = r21
+	}
+	ldf.fill f3 = [r21], 32		// sp + 176 (f3)
+	ldf.fill f4 = [r20], 32		// sp + 192 (f4)
+	mov b5 = r16
+	;;
+	ldf.fill f5 = [r21], 32		// sp + 208 (f5)
+	ldf.fill f16 = [r20], 32	// sp + 224 (f16)
+	mov pr = r14, -1
+	;;
+	ldf.fill f17 = [r21], 32	// sp + 240 (f17)
+	ldf.fill f18 = [r20], 32	// sp + 256 (f18)
 	;;
-	mov pr = r15, -1
+	ldf.fill f19 = [r21], 32	// sp + 272 (f19)
+	ldf.fill f20 = [r20], 32	// sp + 288 (f20)
+	;;
+	ldf.fill f21 = [r21], 32	// sp + 304 (f21)
+	ldf.fill f22 = [r20], 32	// sp + 320 (f22)
+	;;
+	ldf.fill f23 = [r21], 32	// sp + 336 (f23)
+	ldf.fill f24 = [r20], 32	// sp + 352 (f24)
+	;;
+	ldf.fill f25 = [r21], 32	// sp + 368 (f25)
+	ldf.fill f26 = [r20], 32	// sp + 384 (f26)
+	;;
+	ldf.fill f27 = [r21], 32	// sp + 400 (f27)
+	ldf.fill f28 = [r20], 32	// sp + 416 (f28)
+	;;
+	ldf.fill f29 = [r21], 32	// sp + 432 (f29)
+	ldf.fill f30 = [r20], 32	// sp + 448 (f30)
+	;;
+	ldf.fill f31 = [r21], 32	// sp + 464 (f31)
+	adds r12 = 16, r20
 	br.ret.sptk.many b0
 	;;
 	.endp grt_stack_switch#
@@ -146,48 +239,68 @@ grt_stack_switch:
 grt_stack_create:
 	.prologue 14, 34
 	.save ar.pfs, r35
-	alloc r35 = ar.pfs, 2, 4, 0, 0
+	alloc r35 = ar.pfs, 2, 3, 0, 0
 	.save rp, r34
-	mov r34 = b0
+	//  Compute backing store.
+	movl r14 = stack_max_size
 	;; 
 	.body
+	{
+	ld4 r36 = [r14]		// r14: bsp
+	mov r34 = b0
 	br.call.sptk.many b0 = grt_stack_allocate#
 	;;
-	//  Compute backing store.
-	movl r14=stack_max_size
+	}
+	{
 	ld8 r22 = [r32], 8	// read ip (-> b1)
-	adds r20 = -(160 + 16), r8
-	adds r21 = -(160 + 16) + 32, r8
 	;;
-	mov r18 = 0x0f		// ar.rsc: LE, PL=3, Eager
-	ld4 r14 = [r14]		// r16: bsp
-	st8 [r21] = r0, 8	// sp + 32 (ar.rnat = 0)
 	ld8 r23 = [r32]		// read r1 from func
-	st8 [r8] = r20		// Save cur_sp
+	adds r21 = -(frame_size + 16) + 32, r8
+	;;
+	}
+	{
+	st8 [r21] = r0, -32	// sp + 32 (ar.rnat = 0)
+	;; 
+	st8 [r8] = r21		// Save cur_sp
+	mov r18 = 0x0f		// ar.rsc: LE, PL=3, Eager
+	;;
+	}
+	{
+	st8 [r21] = r18, 40	// sp + 0 (ar.rsc)
 	;;
-	st8 [r20] = r18, 8	// sp + 0 (ar.rsc)
 	st8 [r21] = r23, 64	// sp + 40 (r1 = func.r1)
-	sub r14 = r8, r14	// Backing store base
+	mov b0 = r34
 	;;
-	adds r14 = 16, r14	// Add sizeof (stack_context)
-	st8 [r21] = r22, -8	// sp + 104 (b1 = func.ip)
-	;; 
+	}
+	{
+	st8 [r21] = r22, -96	// sp + 104 (b1 = func.ip)
 	movl r15 = grt_stack_loop
-	mov r16 = (0 << 7) | 1	// CFM:	sol=0, sof=1
-	st8 [r20] = r14, 8	// sp + 8 (ar.bsp)
 	;; 
-	st8 [r21] = r15, -48	// sp + 96 (b0 = grt_stack_loop)
-	st8 [r20] = r16, 8	// sp + 16 (ar.pfs)
+	}	
+	sub r14 = r8, r36	// Backing store base
 	;;
-	st8 [r20] = r0, 8	// sp + 24 (ar.lc)
-	st8 [r21] = r33		// sp + 48 (r4 = arg)
+	adds r14 = 16, r14	// Add sizeof (stack_context)
+	adds r20 = 40, r21
 	;;
-	st8 [r20] = r0, 8	// sp + 32 (ar.rnat)
+	{
+	st8 [r21] = r14, 88	// sp + 8 (ar.bsp)
 	;; 
-	
+	st8 [r21] = r15, -80	// sp + 96 (b0 = grt_stack_loop)
+	mov r16 = (0 << 7) | 1	// CFM:	sol=0, sof=1
+	;;
+	}
+	{
+	st8 [r21] = r16, 8	// sp + 16 (ar.pfs)
+	;; 
+	st8 [r21] = r0, 24	// sp + 24 (ar.lc)
 	mov ar.pfs = r35
-	mov b0 = r34
+	;;
+	}
+	{
+	st8 [r20] = r0, 8	// sp + 32 (ar.rnat)
+	st8 [r21] = r33		// sp + 48 (r4 = arg)
 	br.ret.sptk.many b0
 	;;
+	}
 	.endp grt_stack_create#
 	.ident	"GCC: (GNU) 4.0.2"
diff --git a/translate/grt/config/linux.c b/translate/grt/config/linux.c
index 3159cd6..38641b6 100644
--- a/translate/grt/config/linux.c
+++ b/translate/grt/config/linux.c
@@ -65,7 +65,7 @@ struct stack_context
 /* Context for the main stack.  */
 static struct stack_context main_stack_context;
 
-extern struct stack_context *grt_stack_main_stack;
+extern void grt_stack_set_main_stack (struct stack_context *stack);
 
 /* If MAP_ANONYMOUS is not defined, use /dev/zero. */
 #ifndef MAP_ANONYMOUS
@@ -78,10 +78,8 @@ static int dev_zero_fd;
 #endif
 
 #if EXTEND_STACK
-/* Defined in Grt.Processes (body).
-   This is the current process being run.
-   FIXME: this won't work with pthread!  */
-extern void **grt_cur_proc;
+/* This is the current process being run.  */
+extern struct stack_context *grt_get_current_process (void);
 
 /* Stack used for signals.
    The stack must be different from the running stack, because we want to be
@@ -124,7 +122,7 @@ static void grt_sigsegv_handler (int signo, siginfo_t *info, void *ptr)
     }
 #endif
 
-  if (info == NULL || grt_cur_proc == NULL || in_handler > 1)
+  if (info == NULL || grt_get_current_process () == NULL || in_handler > 1)
     {
       /* We loose.  */
       sigaction (SIGSEGV, &prev_sigsegv_act, NULL);
@@ -134,7 +132,7 @@ static void grt_sigsegv_handler (int signo, siginfo_t *info, void *ptr)
   addr = info->si_addr;
   
   /* Check ADDR belong to the stack.  */
-  ctxt = *grt_cur_proc;
+  ctxt = grt_get_current_process ()->cur_sp;
   stack_high = (void *)(ctxt + 1);
   stack_low = stack_high - stack_max_size;
   if (addr > stack_high || addr < stack_low)
@@ -216,7 +214,7 @@ grt_stack_init (void)
   /* Initialize the main stack context.  */
   main_stack_context.cur_sp = NULL;
   main_stack_context.cur_length = 0;
-  grt_stack_main_stack = &main_stack_context;
+  grt_stack_set_main_stack (&main_stack_context);
 
 #ifdef USE_DEV_ZERO
   dev_zero_fd = open ("/dev/zero", O_RDWR);
diff --git a/translate/grt/grt-main.adb b/translate/grt/grt-main.adb
index fa56046..28bd8b0 100644
--- a/translate/grt/grt-main.adb
+++ b/translate/grt/grt-main.adb
@@ -159,10 +159,6 @@ package body Grt.Main is
             Grt.Disp.Disp_Signals_Order;
          end if;
 
-         if Flag_Stats then
-            Stats.Start_Cycles;
-         end if;
-
          --  Do the simulation.
          Status := Grt.Processes.Simulation;
       end if;
diff --git a/translate/grt/grt-options.adb b/translate/grt/grt-options.adb
index 9aa6f64..15b56d4 100644
--- a/translate/grt/grt-options.adb
+++ b/translate/grt/grt-options.adb
@@ -156,6 +156,7 @@ package body Grt.Options is
       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;
       P ("trace options:");
       P (" --disp-time       disp time as simulation advances");
@@ -457,6 +458,21 @@ package body Grt.Options is
                else
                   Error ("bad argument for --activity, try --help");
                end if;
+            elsif Len > 10 and then Argument (1 .. 10) = "--threads=" then
+               declare
+                  Ok : Boolean;
+                  Pos : Natural;
+                  Val : Integer_64;
+               begin
+                  Extract_Integer (Argument (11 .. Len), Ok, Val, Pos);
+                  if not Ok or else Pos <= Len then
+                     Error_C ("bad value in '");
+                     Error_C (Argument);
+                     Error_E ("'");
+                  else
+                     Nbr_Threads := Integer (Val);
+                  end if;
+               end;
             elsif not Grt.Hooks.Call_Option_Hooks (Argument) then
                Error_C ("unknown option '");
                Error_C (Argument);
diff --git a/translate/grt/grt-options.ads b/translate/grt/grt-options.ads
index 3257e9f..756fe5d 100644
--- a/translate/grt/grt-options.ads
+++ b/translate/grt/grt-options.ads
@@ -118,10 +118,17 @@ package Grt.Options is
    type Activity_Mode is (Activity_All, Activity_Minimal, Activity_None);
    Flag_Activity : Activity_Mode := Activity_Minimal;
 
+   --  Set by --thread=
+   --  Number of threads used to do the simulation.
+   --  1 mean no additionnal threads, 0 means as many threads as number of
+   --  CPUs.
+   Nbr_Threads : Natural := 1;
+
    --  Set the time resolution.
    --  Only call this subprogram if you are allowed to set the time resolution.
    procedure Set_Time_Resolution (Res : Character);
 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/translate/grt/grt-processes.adb b/translate/grt/grt-processes.adb
index 70ba85e..1bb0be8 100644
--- a/translate/grt/grt-processes.adb
+++ b/translate/grt/grt-processes.adb
@@ -32,81 +32,10 @@ with Grt.Hooks;
 with Grt.Disp_Signals;
 with Grt.Stdio;
 with Grt.Stats;
+with Grt.Threads; use Grt.Threads;
 
 package body Grt.Processes is
-   --  Access to a process subprogram.
-   type Proc_Acc is access procedure (Self : System.Address);
-
-   --  Simply linked list for sensitivity.
-   type Sensitivity_El;
-   type Sensitivity_Acc is access Sensitivity_El;
-   type Sensitivity_El is record
-      Sig : Ghdl_Signal_Ptr;
-      Next : Sensitivity_Acc;
-   end record;
-
-   Last_Time : Std_Time := Std_Time'Last;
-
-   --  State of a process.
-   type Process_State is
-     (
-      --  Sensitized process.  Its state cannot change.
-      State_Sensitized,
-
-      --  Verilog process, being suspended.
-      State_Delayed,
-
-      --  Non-sensitized process being suspended.
-      State_Wait,
-
-      --  Non-sensitized process being awaked by a wait timeout.  This state
-      --  is transcient.
-      State_Timeout,
-
-      --  Non-sensitized process waiting until end.
-      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 : Stack_Type;
-
-      --  Subprogram containing process code.
-      Subprg : Proc_Acc;
-
-      --  Instance (THIS parameter) for the subprogram.
-      This : System.Address;
-
-      --  Name of the process.
-      Rti : 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 : Process_State;
-
-      --  Timeout value for wait.
-      Timeout : Std_Time;
-
-      --  Sensitivity list.
-      Sensitivity : Sensitivity_Acc;
-   end record;
-   type Process_Acc is access all Process_Type;
-
-   --  Per 'thread' data.
-   --  The process being executed.
-   Cur_Proc_Id : Process_Id;
-
-   Cur_Proc : Process_Acc;
-   pragma Export (C, Cur_Proc, "grt_cur_proc");
-
-   --  The secondary stack for the thread.
-   Stack2 : Stack2_Ptr;
+   Last_Time : constant Std_Time := Std_Time'Last;
 
    --  Table of processes.
    package Process_Table is new GNAT.Table
@@ -148,12 +77,6 @@ package body Grt.Processes is
       Process_Table.Init;
    end Init;
 
-   function Get_Current_Process_Id return Process_Id
-   is
-   begin
-      return Cur_Proc_Id;
-   end Get_Current_Process_Id;
-
    function Get_Nbr_Processes return Natural is
    begin
       return Natural (Process_Table.Last);
@@ -203,10 +126,10 @@ package body Grt.Processes is
          Timeout => Bad_Time,
          Stack => Stack);
       --  Used to create drivers.
-      Cur_Proc_Id := Process_Table.Last;
+      Set_Current_Process (Process_Table.Last, null);
 
       if State /= State_Sensitized then
-         Non_Sensitized_Process_Table.Append (Cur_Proc_Id);
+         Non_Sensitized_Process_Table.Append (Process_Table.Last);
       end if;
       if Postponed then
          Nbr_Postponed_Processes := Nbr_Postponed_Processes + 1;
@@ -274,7 +197,7 @@ package body Grt.Processes is
          This => This,
          Stack => Null_Stack);
       --  Used to create drivers.
-      Cur_Proc_Id := Process_Table.Last;
+      Set_Current_Process (Process_Table.Last, null);
    end Verilog_Process_Register;
 
    procedure Ghdl_Initial_Register (Instance : System.Address;
@@ -318,20 +241,23 @@ package body Grt.Processes is
      return System.Address
    is
    begin
-      return Grt.Stack2.Allocate (Stack2, Size);
+      return Grt.Stack2.Allocate (Get_Stack2, Size);
    end Ghdl_Stack2_Allocate;
 
-   function Ghdl_Stack2_Mark return Mark_Id is
+   function Ghdl_Stack2_Mark return Mark_Id
+   is
+      St2 : Stack2_Ptr := Get_Stack2;
    begin
-      if Stack2 = Null_Stack2_Ptr then
-         Stack2 := Grt.Stack2.Create;
+      if St2 = Null_Stack2_Ptr then
+         St2 := Grt.Stack2.Create;
+         Set_Stack2 (St2);
       end if;
-      return Grt.Stack2.Mark (Stack2);
+      return Grt.Stack2.Mark (St2);
    end Ghdl_Stack2_Mark;
 
    procedure Ghdl_Stack2_Release (Mark : Mark_Id) is
    begin
-      Grt.Stack2.Release (Stack2, Mark);
+      Grt.Stack2.Release (Get_Stack2, Mark);
    end Ghdl_Stack2_Release;
 
    function To_Acc is new Ada.Unchecked_Conversion
@@ -342,8 +268,8 @@ package body Grt.Processes is
       El : Sensitivity_Acc;
    begin
       El := new Sensitivity_El'(Sig => Sig,
-                                Next => Cur_Proc.Sensitivity);
-      Cur_Proc.Sensitivity := El;
+                                Next => Get_Current_Process.Sensitivity);
+      Get_Current_Process.Sensitivity := El;
    end Ghdl_Process_Wait_Add_Sensitivity;
 
    procedure Ghdl_Process_Wait_Set_Timeout (Time : Std_Time)
@@ -353,31 +279,33 @@ package body Grt.Processes is
          --  LRM93 8.1
          Error ("negative timeout clause");
       end if;
-      Cur_Proc.Timeout := Current_Time + Time;
+      Get_Current_Process.Timeout := Current_Time + Time;
    end Ghdl_Process_Wait_Set_Timeout;
 
    function Ghdl_Process_Wait_Suspend return Boolean
    is
+      Proc : constant Process_Acc := Get_Current_Process;
    begin
-      if Cur_Proc.State = State_Sensitized then
+      if Proc.State = State_Sensitized then
          Error ("wait statement in a sensitized process");
       end if;
       --  Suspend this process.
-      Cur_Proc.State := State_Wait;
+      Proc.State := State_Wait;
 --       if Cur_Proc.Timeout = Bad_Time then
 --          Cur_Proc.Timeout := Std_Time'Last;
 --       end if;
-      Stack_Switch (Main_Stack, Cur_Proc.Stack);
-      return Cur_Proc.State = State_Timeout;
+      Stack_Switch (Get_Main_Stack, Proc.Stack);
+      return Proc.State = State_Timeout;
    end Ghdl_Process_Wait_Suspend;
 
    procedure Ghdl_Process_Wait_Close
    is
+      Proc : constant Process_Acc := Get_Current_Process;
       El : Sensitivity_Acc;
       N_El : Sensitivity_Acc;
    begin
-      El := Cur_Proc.Sensitivity;
-      Cur_Proc.Sensitivity := null;
+      El := Proc.Sensitivity;
+      Proc.Sensitivity := null;
       while El /= null loop
          N_El := El.Next;
          Free (El);
@@ -387,39 +315,42 @@ package body Grt.Processes is
 
    procedure Ghdl_Process_Wait_Exit
    is
+      Proc : constant Process_Acc := Get_Current_Process;
    begin
-      if Cur_Proc.State = State_Sensitized then
+      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.
-      Cur_Proc.State := State_Dead;
+      Proc.State := State_Dead;
       --  Suspend this process.
-      Stack_Switch (Main_Stack, Cur_Proc.Stack);
+      Stack_Switch (Get_Main_Stack, Proc.Stack);
    end Ghdl_Process_Wait_Exit;
 
    procedure Ghdl_Process_Wait_Timeout (Time : Std_Time)
    is
+      Proc : constant Process_Acc := Get_Current_Process;
    begin
-      if Cur_Proc.State = State_Sensitized then
+      if Proc.State = State_Sensitized then
          Error ("wait statement in a sensitized process");
       end if;
       if Time < 0 then
          --  LRM93 8.1
          Error ("negative timeout clause");
       end if;
-      Cur_Proc.Timeout := Current_Time + Time;
-      Cur_Proc.State := State_Wait;
+      Proc.Timeout := Current_Time + Time;
+      Proc.State := State_Wait;
       --  Suspend this process.
-      Stack_Switch (Main_Stack, Cur_Proc.Stack);
+      Stack_Switch (Get_Main_Stack, Proc.Stack);
    end Ghdl_Process_Wait_Timeout;
 
    --  Verilog.
    procedure Ghdl_Process_Delay (Del : Ghdl_U32)
    is
+      Proc : constant Process_Acc := Get_Current_Process;
    begin
-      Cur_Proc.Timeout := Current_Time + Std_Time (Del);
-      Cur_Proc.State := State_Delayed;
+      Proc.Timeout := Current_Time + Std_Time (Del);
+      Proc.State := State_Delayed;
    end Ghdl_Process_Delay;
 
    --  Protected object lock.
@@ -564,33 +495,26 @@ package body Grt.Processes is
    --  Failure, simulation should stop.
    Run_Failure : constant Integer := -1;
 
-   function Run_Processes (Postponed : Boolean) return Integer
+   Mt_Last : Natural;
+   Mt_Table : Process_Id_Array_Acc;
+   Mt_Index : aliased Natural;
+
+   procedure Run_Processes_Threads
    is
-      Table : Process_Id_Array_Acc;
-      Last : Natural;
-      Status : Integer;
+      Pid : Process_Id;
+      Idx : Natural;
    begin
-      Status := Run_None;
-
-      if Options.Flag_Stats then
-         Stats.Start_Processes;
-      end if;
+      loop
+         --  Atomically get a process to be executed
+         Idx := Grt.Threads.Atomic_Inc (Mt_Index'Access);
+         if Idx > Mt_Last then
+            return;
+         end if;
+         Pid := Mt_Table (Idx);
 
-      if Postponed then
-         Table := Postponed_Resume_Process_Table;
-         Last := Last_Postponed_Resume_Process;
-      else
-         Table := Resume_Process_Table;
-         Last := Last_Resume_Process;
-      end if;
-      for I in 1 .. Last loop
          declare
-            Pid : constant Process_Id := Table (I);
             Proc : Process_Type renames Process_Table.Table (Pid);
          begin
-            if not Proc.Resumed then
-               Internal_Error ("run non-resumed process");
-            end if;
             if Grt.Options.Trace_Processes then
                Grt.Astdio.Put ("run process ");
                Disp_Process_Name (Stdio.stdout, Pid);
@@ -599,33 +523,89 @@ package body Grt.Processes is
                Grt.Astdio.Put ("]");
                Grt.Astdio.New_Line;
             end if;
-            Nbr_Resumed_Processes := Nbr_Resumed_Processes + 1;
+            if not Proc.Resumed then
+               Internal_Error ("run non-resumed process");
+            end if;
             Proc.Resumed := False;
-            Status := Run_Resumed;
-            Cur_Proc_Id := Pid;
-            Cur_Proc := To_Acc (Process_Table.Table (Pid)'Address);
-            if Cur_Proc.State = State_Sensitized then
-               Cur_Proc.Subprg.all (Cur_Proc.This);
+            Set_Current_Process
+              (Pid, To_Acc (Process_Table.Table (Pid)'Address));
+            if Proc.State = State_Sensitized then
+               Proc.Subprg.all (Proc.This);
             else
-               Stack_Switch (Cur_Proc.Stack, Main_Stack);
+               Stack_Switch (Proc.Stack, Get_Main_Stack);
             end if;
             if Grt.Options.Checks then
                Ghdl_Signal_Internal_Checks;
-               Grt.Stack2.Check_Empty (Stack2);
+               Grt.Stack2.Check_Empty (Get_Stack2);
             end if;
          end;
       end loop;
+   end Run_Processes_Threads;
+
+   function Run_Processes (Postponed : Boolean) return Integer
+   is
+      Table : Process_Id_Array_Acc;
+      Last : Natural;
+   begin
+      if Options.Flag_Stats then
+         Stats.Start_Processes;
+      end if;
 
       if Postponed then
+         Table := Postponed_Resume_Process_Table;
+         Last := Last_Postponed_Resume_Process;
          Last_Postponed_Resume_Process := 0;
       else
+         Table := Resume_Process_Table;
+         Last := Last_Resume_Process;
          Last_Resume_Process := 0;
       end if;
+      Nbr_Resumed_Processes := Nbr_Resumed_Processes + Last;
 
-      if Options.Flag_Stats then
-         Stats.End_Processes;
+      if Options.Nbr_Threads = 1 then
+         for I in 1 .. Last loop
+            declare
+               Pid : constant Process_Id := Table (I);
+               Proc : Process_Type renames Process_Table.Table (Pid);
+            begin
+               if not Proc.Resumed then
+                  Internal_Error ("run non-resumed process");
+               end if;
+               if Grt.Options.Trace_Processes then
+                  Grt.Astdio.Put ("run process ");
+                  Disp_Process_Name (Stdio.stdout, Pid);
+                  Grt.Astdio.Put (" [");
+                  Grt.Astdio.Put (Stdio.stdout, Proc.This);
+                  Grt.Astdio.Put ("]");
+                  Grt.Astdio.New_Line;
+               end if;
+
+               Proc.Resumed := False;
+               Set_Current_Process
+                 (Pid, To_Acc (Process_Table.Table (Pid)'Address));
+               if Proc.State = State_Sensitized then
+                  Proc.Subprg.all (Proc.This);
+               else
+                  Stack_Switch (Proc.Stack, Get_Main_Stack);
+               end if;
+               if Grt.Options.Checks then
+                  Ghdl_Signal_Internal_Checks;
+                  Grt.Stack2.Check_Empty (Get_Stack2);
+               end if;
+            end;
+         end loop;
+      else
+         Mt_Last := Last;
+         Mt_Table := Table;
+         Mt_Index := 1;
+         Threads.Run_Parallel (Run_Processes_Threads'Access);
+      end if;
+
+      if Last >= 1 then
+         return Run_Resumed;
+      else
+         return Run_None;
       end if;
-      return Status;
    end Run_Processes;
 
    function Initialization_Phase return Integer
@@ -705,7 +685,6 @@ package body Grt.Processes is
       end if;
       Update_Signals;
       if Options.Flag_Stats then
-         Stats.End_Update;
          Stats.Start_Resume;
       end if;
 
@@ -753,10 +732,6 @@ package body Grt.Processes is
          end;
       end loop;
 
-      if Options.Flag_Stats then
-         Stats.End_Resume;
-      end if;
-
       --  e) Each nonpostponed that has resumed in the current simulation cycle
       --     is executed until it suspends.
       Status := Run_Processes (Postponed => False);
@@ -775,9 +750,6 @@ package body Grt.Processes is
          Stats.Start_Next_Time;
       end if;
       Tn := Compute_Next_Time;
-      if Options.Flag_Stats then
-         Stats.End_Next_Time;
-      end if;
 
       --  g) If the next simulation cycle will be a delta cycle, the remainder
       --     of the step is skipped.
@@ -805,9 +777,6 @@ package body Grt.Processes is
                Stats.Start_Next_Time;
             end if;
             Tn := Compute_Next_Time;
-            if Options.Flag_Stats then
-               Stats.End_Next_Time;
-            end if;
             if Tn = Current_Time then
                Error ("postponed process causes a delta cycle");
             end if;
@@ -824,8 +793,9 @@ package body Grt.Processes is
       use Options;
       Status : Integer;
    begin
-      --Put_Line ("grt.processes:" & Process_Id'Image (Process_Table.Last)
-      --          & " process(es)");
+      if Nbr_Threads /= 1 then
+         Threads.Init;
+      end if;
 
 --       if Disp_Sig_Types then
 --          Grt.Disp.Disp_Signals_Type;
@@ -889,6 +859,10 @@ package body Grt.Processes is
          end if;
       end loop;
 
+      if Nbr_Threads /= 1 then
+         Threads.Finish;
+      end if;
+
       Grt.Hooks.Call_Finish_Hooks;
 
       if Status = Run_Failure then
diff --git a/translate/grt/grt-processes.ads b/translate/grt/grt-processes.ads
index b81e42d..2ef0653 100644
--- a/translate/grt/grt-processes.ads
+++ b/translate/grt/grt-processes.ads
@@ -19,7 +19,9 @@ with System;
 with Grt.Stack2; use Grt.Stack2;
 with Grt.Types; use Grt.Types;
 with Grt.Signals; use Grt.Signals;
+with Grt.Stacks;
 with Grt.Rtis; use Grt.Rtis;
+with Grt.Rtis_Addr;
 with Grt.Stdio;
 
 package Grt.Processes is
@@ -44,8 +46,6 @@ package Grt.Processes is
    --  During the elaboration, this is the identifier of the last process
    --  being elaborated.  So, this function can be used to create signal
    --  drivers.
-   function Get_Current_Process_Id return Process_Id;
-   pragma Inline (Get_Current_Process_Id);
 
    --  Return the total number of processes and number of sensitized processes.
    --  Used for statistics.
@@ -118,7 +118,70 @@ package Grt.Processes is
    procedure Ghdl_Protected_Init (Obj : System.Address);
    procedure Ghdl_Protected_Fini (Obj : System.Address);
 
+   type Process_Type is private;
+   type Process_Acc is access all Process_Type;
 private
+      --  Access to a process subprogram.
+   type Proc_Acc is access procedure (Self : System.Address);
+
+   --  Simply linked list for sensitivity.
+   type Sensitivity_El;
+   type Sensitivity_Acc is access Sensitivity_El;
+   type Sensitivity_El is record
+      Sig : Ghdl_Signal_Ptr;
+      Next : Sensitivity_Acc;
+   end record;
+
+   --  State of a process.
+   type Process_State is
+     (
+      --  Sensitized process.  Its state cannot change.
+      State_Sensitized,
+
+      --  Verilog process, being suspended.
+      State_Delayed,
+
+      --  Non-sensitized process being suspended.
+      State_Wait,
+
+      --  Non-sensitized process being awaked by a wait timeout.  This state
+      --  is transcient.
+      State_Timeout,
+
+      --  Non-sensitized process waiting until end.
+      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 : System.Address;
+
+      --  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 : Process_State;
+
+      --  Timeout value for wait.
+      Timeout : Std_Time;
+
+      --  Sensitivity list.
+      Sensitivity : Sensitivity_Acc;
+   end record;
+
    pragma Export (C, Ghdl_Process_Register,
                   "__ghdl_process_register");
    pragma Export (C, Ghdl_Sensitized_Process_Register,
diff --git a/translate/grt/grt-signals.adb b/translate/grt/grt-signals.adb
index fed1788..e0376c2 100644
--- a/translate/grt/grt-signals.adb
+++ b/translate/grt/grt-signals.adb
@@ -26,6 +26,7 @@ with Grt.Rtis_Types; use Grt.Rtis_Types;
 with Grt.Disp_Signals;
 with Grt.Astdio;
 with Grt.Stdio;
+with Grt.Threads; use Grt.Threads;
 
 package body Grt.Signals is
    function Is_Signal_Guarded (Sig : Ghdl_Signal_Ptr) return Boolean
@@ -403,11 +404,11 @@ package body Grt.Signals is
    Signal_End : Ghdl_Signal_Ptr;
 
    --  List of active signals.
-   Active_List : Ghdl_Signal_Ptr;
+   Active_List : aliased Ghdl_Signal_Ptr;
 
    --  List of signals which have projected waveforms in the future (beyond
    --  the next delta cycle).
-   Future_List : Ghdl_Signal_Ptr;
+   Future_List : aliased Ghdl_Signal_Ptr;
 
    procedure Ghdl_Signal_Start_Assign (Sign : Ghdl_Signal_Ptr;
                                        Reject : Std_Time;
@@ -430,15 +431,13 @@ package body Grt.Signals is
          --  Put SIGN on the active list if the transaction is scheduled
          --   for the next delta cycle.
          if Sign.Link = null then
-            Sign.Link := Active_List;
-            Active_List := Sign;
+            Sign.Link := Grt.Threads.Atomic_Insert (Active_List'access, Sign);
          end if;
       else
          --  AFTER > 0.
          --  Put SIGN on the future list.
          if Sign.Flink = null then
-            Sign.Flink := Future_List;
-            Future_List := Sign;
+            Sign.Flink := Grt.Threads.Atomic_Insert (Future_List'access, Sign);
          end if;
       end if;
 
diff --git a/translate/grt/grt-stacks.ads b/translate/grt/grt-stacks.ads
index 2624f5c..920012c 100644
--- a/translate/grt/grt-stacks.ads
+++ b/translate/grt/grt-stacks.ads
@@ -21,10 +21,6 @@ package Grt.Stacks is
    type Stack_Type is new Address;
    Null_Stack : constant Stack_Type := Stack_Type (Null_Address);
 
-   --  The main stack.  This is initialized by STACK_INIT.
-   --  The return point.
-   Main_Stack : Stack_Type;
-
    --  Initialize the stacks package.
    --  This may adjust stack sizes.
    --  Must be called after grt.options.decode.
@@ -54,8 +50,6 @@ package Grt.Stacks is
    procedure Error_Null_Access;
    pragma No_Return (Error_Null_Access);
 private
-   pragma Export (C, Main_Stack, "grt_stack_main_stack");
-
    pragma Import (C, Stack_Init, "grt_stack_init");
    pragma Import (C, Stack_Create, "grt_stack_create");
    pragma Import (C, Stack_Switch, "grt_stack_switch");
diff --git a/translate/grt/grt-stats.adb b/translate/grt/grt-stats.adb
index 065909b..340c3db 100644
--- a/translate/grt/grt-stats.adb
+++ b/translate/grt/grt-stats.adb
@@ -19,7 +19,6 @@ with System; use System;
 with System.Storage_Elements; --  Work around GNAT bug.
 with Grt.Stdio; use Grt.Stdio;
 with Grt.Astdio; use Grt.Astdio;
-with Grt.Vstrings;
 with Grt.Signals;
 with Grt.Processes;
 with Grt.Types; use Grt.Types;
@@ -71,29 +70,20 @@ package body Grt.Stats is
 
    procedure Put (Stream : FILEs; Val : Clock_T)
    is
-      use Grt.Vstrings;
+      Fmt : constant String := "%3d.%03d" & Character'Val (0);
 
-      Ms : Ghdl_I32;
-      Buf : String (1 .. 11);
-      First : Natural;
-      C : Character;
+      procedure fprintf (Stream : FILEs; Fmt : Address; A, B : Clock_T);
+      pragma Import (C, fprintf);
+
+      Sec : Clock_T;
+      Ms : Clock_T;
    begin
-      To_String (Buf, First, Ghdl_I32 (Val / One_Second));
-      if First > 8 then
-         Buf (8 .. First - 1) := (others => ' ');
-         First := 8;
-      end if;
-      Put (Stream, Buf (First .. Buf'Last));
-      Put (Stream, '.');
+      Sec := Val / One_Second;
 
       --  Avoid overflow.
-      Ms := Ghdl_I32 (((Val mod One_Second) * 1000) / One_Second);
+      Ms := ((Val mod One_Second) * 1000) / One_Second;
 
-      for I in 1 .. 3 loop
-         C := Character'Val (Character'Pos ('0') + (Ms / 100));
-         Put (Stream, C);
-         Ms := (Ms * 10) mod 1000;
-      end loop;
+      fprintf (Stream, Fmt'Address, Sec, Ms);
    end Put;
 
    procedure Put (Stream : FILEs; T : Time_Stats) is
@@ -106,103 +96,85 @@ package body Grt.Stats is
       Put (Stream, T.Sys);
    end Put;
 
-   --  Stats at origin.
-   Start_Time : Time_Stats;
-   End_Elab_Time : Time_Stats;
-   End_Order_Time : Time_Stats;
+   type Counter_Kind is (Counter_Elab, Counter_Order,
+                         Counter_Process, Counter_Update,
+                         Counter_Next, Counter_Resume);
+
+   type Counter_Array is array (Counter_Kind) of Time_Stats;
+   Counters : Counter_Array := (others => (0, 0, 0));
 
-   Start_Proc_Time : Time_Stats;
-   Proc_Times : Time_Stats;
+   Init_Time : Time_Stats;
+   Last_Counter : Counter_Kind;
+   Last_Time : Time_Stats;
 
-   Start_Update_Time : Time_Stats;
-   Update_Times : Time_Stats;
+--     --  Stats at origin.
+--     Start_Time : Time_Stats;
+--     End_Elab_Time : Time_Stats;
+--     End_Order_Time : Time_Stats;
 
-   Start_Next_Time_Time : Time_Stats;
-   Next_Time_Times : Time_Stats;
+--     Start_Proc_Time : Time_Stats;
+--     Proc_Times : Time_Stats;
 
-   Start_Resume_Time : Time_Stats;
-   Resume_Times : Time_Stats;
+--     Start_Update_Time : Time_Stats;
+--     Update_Times : Time_Stats;
 
-   Running_Time : Time_Stats;
-   Simu_Time : Time_Stats;
+--     Start_Next_Time_Time : Time_Stats;
+--     Next_Time_Times : Time_Stats;
+
+--     Start_Resume_Time : Time_Stats;
+--     Resume_Times : Time_Stats;
+
+--     Running_Time : Time_Stats;
+--     Simu_Time : Time_Stats;
 
    procedure Start_Elaboration is
    begin
       One_Second := Get_Clk_Tck;
-      Proc_Times := (0, 0, 0);
 
-      Get_Stats (Start_Time);
+      Get_Stats (Init_Time);
+      Last_Time := Init_Time;
+      Last_Counter := Counter_Elab;
    end Start_Elaboration;
 
-   procedure Start_Order is
+   procedure Change_Counter (Cnt : Counter_Kind)
+   is
+      New_Time : Time_Stats;
    begin
-      Get_Stats (End_Elab_Time);
-   end Start_Order;
+      Get_Stats (New_Time);
+      Counters (Last_Counter) := Counters (Last_Counter)
+        + (New_Time - Last_Time);
+      Last_Time := New_Time;
+      Last_Counter := Cnt;
+   end Change_Counter;
 
-   procedure Start_Cycles is
+   procedure Start_Order is
    begin
-      Get_Stats (End_Order_Time);
-   end Start_Cycles;
+      Change_Counter (Counter_Order);
+   end Start_Order;
 
    procedure Start_Processes is
    begin
-      Get_Stats (Start_Proc_Time);
+      Change_Counter (Counter_Process);
    end Start_Processes;
 
-   procedure End_Processes
-   is
-      Now : Time_Stats;
-   begin
-      Get_Stats (Now);
-      Proc_Times := Proc_Times + (Now - Start_Proc_Time);
-   end End_Processes;
-
    procedure Start_Update is
    begin
-      Get_Stats (Start_Update_Time);
+      Change_Counter (Counter_Update);
    end Start_Update;
 
-   procedure End_Update
-   is
-      Now : Time_Stats;
-   begin
-      Get_Stats (Now);
-      Update_Times := Update_Times + (Now - Start_Update_Time);
-   end End_Update;
-
    procedure Start_Next_Time is
    begin
-      Get_Stats (Start_Next_Time_Time);
+      Change_Counter (Counter_Next);
    end Start_Next_Time;
 
-   procedure End_Next_Time
-   is
-      Now : Time_Stats;
-   begin
-      Get_Stats (Now);
-      Next_Time_Times := Next_Time_Times + (Now - Start_Next_Time_Time);
-   end End_Next_Time;
-
    procedure Start_Resume is
    begin
-      Get_Stats (Start_Resume_Time);
+      Change_Counter (Counter_Resume);
    end Start_Resume;
 
-   procedure End_Resume
-   is
-      Now : Time_Stats;
-   begin
-      Get_Stats (Now);
-      Resume_Times := Resume_Times + (Now - Start_Resume_Time);
-   end End_Resume;
-
-   procedure End_Simulation
-   is
-      Now : Time_Stats;
+   procedure End_Simulation is
    begin
-      Get_Stats (Now);
-      Simu_Time := Now - Start_Time;
-      Running_Time := Now - End_Order_Time;
+      Change_Counter (Last_Counter);
    end End_Simulation;
 
    procedure Disp_Signals_Stats
@@ -312,31 +284,29 @@ package body Grt.Stats is
       N : Natural;
    begin
       Put (stdout, "total:          ");
-      Put (stdout, Simu_Time);
+      Put (stdout, Last_Time - Init_Time);
       New_Line (stdout);
       Put (stdout, " elab:          ");
-      Put (stdout, End_Elab_Time - Start_Time);
+      Put (stdout, Counters (Counter_Elab));
       New_Line (stdout);
       Put (stdout, " internal elab: ");
-      Put (stdout, End_Order_Time - End_Elab_Time);
-      New_Line (stdout);
-      Put (stdout, " running time:  ");
-      Put (stdout, Running_Time);
+      Put (stdout, Counters (Counter_Order));
       New_Line (stdout);
       Put (stdout, " cycle (sum):   ");
-      Put (stdout, Proc_Times + Update_Times + Next_Time_Times + Resume_Times);
+      Put (stdout, Counters (Counter_Process) + Counters (Counter_Resume)
+           + Counters (Counter_Update) + Counters (Counter_Next));
       New_Line (stdout);
       Put (stdout, "  processes:    ");
-      Put (stdout, Proc_Times);
+      Put (stdout, Counters (Counter_Process));
       New_Line (stdout);
       Put (stdout, "  resume:       ");
-      Put (stdout, Resume_Times);
+      Put (stdout, Counters (Counter_Resume));
       New_Line (stdout);
       Put (stdout, "  update:       ");
-      Put (stdout, Update_Times);
+      Put (stdout, Counters (Counter_Update));
       New_Line (stdout);
       Put (stdout, "  next compute: ");
-      Put (stdout, Next_Time_Times);
+      Put (stdout, Counters (Counter_Next));
       New_Line (stdout);
 
       Disp_Signals_Stats;
diff --git a/translate/grt/grt-stats.ads b/translate/grt/grt-stats.ads
index 7844a86..8b23073 100644
--- a/translate/grt/grt-stats.ads
+++ b/translate/grt/grt-stats.ads
@@ -20,23 +20,21 @@ package Grt.Stats is
    --  Entry points to gather statistics.
    procedure Start_Elaboration;
    procedure Start_Order;
-   procedure Start_Cycles;
 
    --  Time in user processes.
    procedure Start_Processes;
-   procedure End_Processes;
+
 
    --  Time in next time computation.
    procedure Start_Next_Time;
-   procedure End_Next_Time;
+
 
    --  Time in signals update.
    procedure Start_Update;
-   procedure End_Update;
+
 
    --  Time in process resume
    procedure Start_Resume;
-   procedure End_Resume;
 
 
    procedure End_Simulation;
diff --git a/translate/grt/grt-threads.ads b/translate/grt/grt-threads.ads
new file mode 100644
index 0000000..ada5d7e
--- /dev/null
+++ b/translate/grt/grt-threads.ads
@@ -0,0 +1,20 @@
+--  GHDL Run Time (GRT) - threading.
+--  Copyright (C) 2005 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.
+with Grt.Unithread;
+
+package Grt.Threads renames Grt.Unithread;
diff --git a/translate/grt/grt-unithread.adb b/translate/grt/grt-unithread.adb
new file mode 100644
index 0000000..668e9b7
--- /dev/null
+++ b/translate/grt/grt-unithread.adb
@@ -0,0 +1,107 @@
+--  GHDL Run Time (GRT) - mono-thread version.
+--  Copyright (C) 2005 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.
+with Grt.Types; use Grt.Types;
+
+package body Grt.Unithread is
+   procedure Init is
+   begin
+      null;
+   end Init;
+
+   procedure Finish is
+   begin
+      null;
+   end Finish;
+
+   procedure Run_Parallel (Subprg : Parallel_Subprg_Acc) is
+   begin
+      Subprg.all;
+   end Run_Parallel;
+
+   function Atomic_Insert (List : access Ghdl_Signal_Ptr; El : Ghdl_Signal_Ptr)
+                          return Ghdl_Signal_Ptr
+   is
+      Prev : Ghdl_Signal_Ptr;
+   begin
+      Prev := List.all;
+      List.all := El;
+      return Prev;
+   end Atomic_Insert;
+
+   function Atomic_Inc (Val : access Natural) return Natural
+   is
+      Res : Natural;
+   begin
+      Res := Val.all;
+      Val.all := Val.all + 1;
+      return Res;
+   end Atomic_Inc;
+
+   Current_Process : Process_Acc;
+   Current_Process_Id : Process_Id;
+
+   --  Called by linux.c
+   function Grt_Get_Current_Process return Process_Acc;
+   pragma Export (C, Grt_Get_Current_Process);
+
+   function Grt_Get_Current_Process return Process_Acc is
+   begin
+      return Current_Process;
+   end Grt_Get_Current_Process;
+
+
+   procedure Set_Current_Process (Id : Process_Id; Proc : Process_Acc) is
+   begin
+      Current_Process := Proc;
+      Current_Process_Id := Id;
+   end Set_Current_Process;
+
+   function Get_Current_Process return Process_Acc is
+   begin
+      return Current_Process;
+   end Get_Current_Process;
+
+   function Get_Current_Process_Id return Process_Id is
+   begin
+      return Current_Process_Id;
+   end Get_Current_Process_Id;
+
+   Stack2 : Stack2_Ptr;
+
+   function Get_Stack2 return Stack2_Ptr is
+   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;
+end Grt.Unithread;
diff --git a/translate/grt/grt-unithread.ads b/translate/grt/grt-unithread.ads
new file mode 100644
index 0000000..1dc3713
--- /dev/null
+++ b/translate/grt/grt-unithread.ads
@@ -0,0 +1,66 @@
+--  GHDL Run Time (GRT) - mono-thread version.
+--  Copyright (C) 2005 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.
+with System.Storage_Elements; --  Work around GNAT bug.
+with Grt.Signals; use Grt.Signals;
+with Grt.Stack2; use Grt.Stack2;
+with Grt.Stacks; use Grt.Stacks;
+with Grt.Types; use Grt.Types;
+with Grt.Processes; use Grt.Processes;
+
+package Grt.Unithread is
+   procedure Init;
+   procedure Finish;
+
+   type Parallel_Subprg_Acc is access procedure;
+   procedure Run_Parallel (Subprg : Parallel_Subprg_Acc);
+
+   --  Return the old value of LIST.all and store EL into LIST.all.
+   function Atomic_Insert (List : access Ghdl_Signal_Ptr; El : Ghdl_Signal_Ptr)
+                          return Ghdl_Signal_Ptr;
+
+   --  Return the old value.
+   function Atomic_Inc (Val : access Natural) return Natural;
+
+   --  Set and get the current process being executed by the thread.
+   procedure Set_Current_Process (Id : Process_Id; Proc : Process_Acc);
+   function Get_Current_Process return Process_Acc;
+   function Get_Current_Process_Id return Process_Id;
+
+   --  The secondary stack for the thread.
+   function Get_Stack2 return Stack2_Ptr;
+   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);
+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_stack_set_main_stack");
+
+   pragma Inline (Set_Current_Process);
+   pragma Inline (Get_Current_Process);
+   pragma Inline (Get_Current_Process_Id);
+
+end Grt.Unithread;
diff --git a/translate/translation.adb b/translate/translation.adb
index a0e63ee..17c80f9 100644
--- a/translate/translation.adb
+++ b/translate/translation.adb
@@ -1995,12 +1995,12 @@ package body Translation is
       --  Get the offset in the range pointed by RANGE_PTR of INDEX.
       --  This checks INDEX belongs to the range.
       --  INDEX_TYPE is the subtype of the array index.
-      function Translate_Index_To_Offset (Range_Ptr : O_Dnode;
+      function Translate_Index_To_Offset (Rng : Mnode;
                                           Index : O_Enode;
                                           Index_Expr : Iir;
                                           Index_Type : Iir;
                                           Loc : Iir)
-        return O_Enode;
+                                         return O_Enode;
    end Chap6;
 
    package Chap7 is
@@ -4277,15 +4277,13 @@ package body Translation is
                   end;
                when Iir_Kind_Indexed_Name =>
                   declare
-                     Range_Ptr : O_Dnode;
+                     Rng : Mnode;
                   begin
                      Open_Temp;
-                     Range_Ptr := Create_Temp_Ptr
-                       (Type_Info.T.Range_Ptr_Type,
-                        Get_Var (Get_Info (Iter_Type).T.Range_Var));
+                     Rng := Stabilize (Chap3.Type_To_Range (Iter_Type));
                      Gen_Subblock_Call
                        (Chap6.Translate_Index_To_Offset
-                        (Range_Ptr,
+                        (Rng,
                          Chap7.Translate_Expression
                          (Get_Nth_Element (Get_Index_List (Spec), 0),
                           Iter_Type),
@@ -4295,7 +4293,7 @@ package body Translation is
                   end;
                when Iir_Kind_Slice_Name =>
                   declare
-                     Range_Ptr : O_Dnode;
+                     Rng : Mnode;
                      Slice : O_Dnode;
                      Slice_Ptr : O_Dnode;
                      Left, Right : O_Dnode;
@@ -4305,9 +4303,7 @@ package body Translation is
                      Label : O_Snode;
                   begin
                      Open_Temp;
-                     Range_Ptr := Create_Temp_Ptr
-                       (Type_Info.T.Range_Ptr_Type,
-                        Get_Var (Get_Info (Iter_Type).T.Range_Var));
+                     Rng := Stabilize (Chap3.Type_To_Range (Iter_Type));
                      Slice := Create_Temp (Type_Info.T.Range_Type);
                      Slice_Ptr := Create_Temp_Ptr
                        (Type_Info.T.Range_Ptr_Type, New_Obj (Slice));
@@ -4316,14 +4312,14 @@ package body Translation is
                      Left := Create_Temp_Init
                        (Ghdl_Index_Type,
                         Chap6.Translate_Index_To_Offset
-                        (Range_Ptr,
+                        (Rng,
                          New_Value (New_Selected_Element
                                     (New_Obj (Slice), Type_Info.T.Range_Left)),
                          Spec, Iter_Type, Spec));
                      Right := Create_Temp_Init
                        (Ghdl_Index_Type,
                         Chap6.Translate_Index_To_Offset
-                        (Range_Ptr,
+                        (Rng,
                          New_Value (New_Selected_Element
                                     (New_Obj (Slice),
                                      Type_Info.T.Range_Right)),
@@ -4333,9 +4329,7 @@ package body Translation is
                      Start_If_Stmt
                        (If_Blk,
                         New_Compare_Op (ON_Eq,
-                                        New_Value_Selected_Acc_Value
-                                        (New_Obj (Range_Ptr),
-                                         Type_Info.T.Range_Dir),
+                                        M2E (Chap3.Range_To_Dir (Rng)),
                                         New_Value
                                         (New_Selected_Element
                                          (New_Obj (Slice),
@@ -12048,17 +12042,20 @@ package body Translation is
       is
          Rng : Iir;
       begin
+         --  Do checks if type of the expression is not a subtype.
+         if Expr_Type = Null_Iir --  FIXME: to be removed (generate stmt)
+           or else
+           Get_Kind (Expr_Type) not in Iir_Kinds_Discrete_Subtype_Definition
+         then
+            return True;
+         end if;
+
          --  No check if the expression has the type of the index.
          if Expr_Type = Rng_Type then
             return False;
          end if;
 
          --  No check for 'Range or 'Reverse_Range.
-         if Get_Kind (Expr_Type) not in Iir_Kinds_Discrete_Subtype_Definition
-         then
-            return True;
-         end if;
-
          Rng := Get_Range_Constraint (Expr_Type);
          if (Get_Kind (Rng) = Iir_Kind_Range_Array_Attribute
              or Get_Kind (Rng) = Iir_Kind_Reverse_Range_Array_Attribute)
@@ -12070,42 +12067,174 @@ package body Translation is
          return True;
       end Need_Index_Check;
 
+      procedure Get_Deep_Range_Expression
+        (Atype : Iir; Rng : out Iir; Is_Reverse : out Boolean)
+      is
+         T : Iir;
+         R : Iir;
+      begin
+         Is_Reverse := False;
+
+         --  T is an integer/enumeration subtype.
+         T := Atype;
+         loop
+            if Get_Kind (T) not in Iir_Kinds_Discrete_Subtype_Definition then
+               Error_Kind ("get_deep_range_expression(1)", T);
+            end if;
 
-      function Translate_Index_To_Offset (Range_Ptr : O_Dnode;
+            R := Get_Range_Constraint (T);
+            case Get_Kind (R) is
+               when Iir_Kind_Range_Expression =>
+                  Rng := R;
+                  return;
+               when Iir_Kind_Range_Array_Attribute =>
+                  null;
+               when Iir_Kind_Reverse_Range_Array_Attribute =>
+                  Is_Reverse := not Is_Reverse;
+               when others =>
+                  Error_Kind ("get_deep_range_expression(2)", R);
+            end case;
+            T := Get_Index_Subtype (R);
+            if T = Null_Iir then
+               Rng := Null_Iir;
+               return;
+            end if;
+         end loop;
+      end Get_Deep_Range_Expression;
+
+      function Translate_Index_To_Offset (Rng : Mnode;
                                           Index : O_Enode;
                                           Index_Expr : Iir;
                                           Index_Type : Iir;
                                           Loc : Iir)
-        return O_Enode
+                                         return O_Enode
       is
+         Need_Check : Boolean;
          Dir : O_Enode;
          If_Blk : O_If_Block;
          Res : O_Dnode;
          Off : O_Dnode;
+         Bound : O_Enode;
          Cond1, Cond2: O_Enode;
          Index_Node : O_Dnode;
          Bound_Node : O_Dnode;
          Index_Info : Type_Info_Acc;
+         Deep_Rng : Iir;
+         Deep_Reverse : Boolean;
       begin
          Index_Info := Get_Info (Get_Base_Type (Index_Type));
+         Need_Check := Need_Index_Check (Get_Type (Index_Expr), Index_Type);
+         Get_Deep_Range_Expression (Index_Type, Deep_Rng, Deep_Reverse);
 
          Res := Create_Temp (Ghdl_Index_Type);
 
          Open_Temp;
 
+         Off := Create_Temp (Index_Info.Ortho_Type (Mode_Value));
+
+         Bound := M2E (Chap3.Range_To_Left (Rng));
+
+         if Deep_Rng /= Null_Iir then
+            if Get_Direction (Deep_Rng) = Iir_To xor Deep_Reverse then
+               --  Direction TO:  INDEX - LEFT.
+               New_Assign_Stmt (New_Obj (Off),
+                                New_Dyadic_Op (ON_Sub_Ov,
+                                               Index, Bound));
+            else
+               --  Direction DOWNTO: LEFT - INDEX.
+               New_Assign_Stmt (New_Obj (Off),
+                                New_Dyadic_Op (ON_Sub_Ov,
+                                               Bound, Index));
+            end if;
+         else
+            Index_Node := Create_Temp_Init
+              (Index_Info.Ortho_Type (Mode_Value), Index);
+            Bound_Node := Create_Temp_Init
+              (Index_Info.Ortho_Type (Mode_Value), Bound);
+            Dir := M2E (Chap3.Range_To_Dir (Rng));
+
+            --  Non-static direction.
+            Start_If_Stmt (If_Blk,
+                           New_Compare_Op (ON_Eq, Dir,
+                                           New_Lit (Ghdl_Dir_To_Node),
+                                           Ghdl_Bool_Type));
+            --  Direction TO:  INDEX - LEFT.
+            New_Assign_Stmt (New_Obj (Off),
+                             New_Dyadic_Op (ON_Sub_Ov,
+                                            New_Obj_Value (Index_Node),
+                                            New_Obj_Value (Bound_Node)));
+            New_Else_Stmt (If_Blk);
+            --  Direction DOWNTO: LEFT - INDEX.
+            New_Assign_Stmt (New_Obj (Off),
+                             New_Dyadic_Op (ON_Sub_Ov,
+                                            New_Obj_Value (Bound_Node),
+                                            New_Obj_Value (Index_Node)));
+            Finish_If_Stmt (If_Blk);
+         end if;
+
+         --  Get the offset.
+         New_Assign_Stmt
+           (New_Obj (Res), New_Convert_Ov (New_Obj_Value (Off),
+                                           Ghdl_Index_Type));
+
+         --  Check bounds.
+         if Need_Check then
+            Cond1 := New_Compare_Op
+              (ON_Lt,
+               New_Obj_Value (Off),
+               New_Lit (New_Signed_Literal (Index_Info.Ortho_Type (Mode_Value),
+                                            0)),
+               Ghdl_Bool_Type);
+
+            Cond2 := New_Compare_Op
+              (ON_Ge,
+               New_Obj_Value (Res),
+               M2E (Chap3.Range_To_Length (Rng)),
+               Ghdl_Bool_Type);
+            Check_Bound_Error (New_Dyadic_Op (ON_Or, Cond1, Cond2), Loc, 0);
+         end if;
+
+         Close_Temp;
+
+         return New_Obj_Value (Res);
+      end Translate_Index_To_Offset;
+
+      function Translate_Fat_Index_To_Offset (Rng : Mnode;
+                                              Index : O_Enode;
+                                              Index_Type : Iir;
+                                              Loc : Iir)
+                                             return O_Enode
+      is
+         Dir : O_Enode;
+         If_Blk : O_If_Block;
+         Res : O_Dnode;
+         Off : O_Dnode;
+         Bound : O_Enode;
+         Cond1, Cond2: O_Enode;
+         Index_Node : O_Dnode;
+         Bound_Node : O_Dnode;
+         Index_Info : Type_Info_Acc;
+      begin
+         Index_Info := Get_Info (Get_Base_Type (Index_Type));
+
+         Res := Create_Temp (Ghdl_Index_Type);
+
+         Open_Temp;
+
+         Off := Create_Temp (Index_Info.Ortho_Type (Mode_Value));
+
+         Bound := M2E (Chap3.Range_To_Left (Rng));
+
          Index_Node := Create_Temp_Init
            (Index_Info.Ortho_Type (Mode_Value), Index);
          Bound_Node := Create_Temp_Init
-           (Index_Info.Ortho_Type (Mode_Value),
-            New_Value_Selected_Acc_Value (New_Obj (Range_Ptr),
-                                          Index_Info.T.Range_Left));
-         Off := Create_Temp (Index_Info.Ortho_Type (Mode_Value));
-
-         Dir := New_Value_Selected_Acc_Value (New_Obj (Range_Ptr),
-                                              Index_Info.T.Range_Dir);
+           (Index_Info.Ortho_Type (Mode_Value), Bound);
+         Dir := M2E (Chap3.Range_To_Dir (Rng));
 
+         --  Non-static direction.
          Start_If_Stmt (If_Blk,
-                        New_Compare_Op (ON_Eq, Dir, New_Lit (Ghdl_Dir_To_Node),
+                        New_Compare_Op (ON_Eq, Dir,
+                                        New_Lit (Ghdl_Dir_To_Node),
                                         Ghdl_Bool_Type));
          --  Direction TO:  INDEX - LEFT.
          New_Assign_Stmt (New_Obj (Off),
@@ -12126,27 +12255,24 @@ package body Translation is
                                            Ghdl_Index_Type));
 
          --  Check bounds.
-         if Need_Index_Check (Get_Type (Index_Expr), Index_Type) then
-            Cond1 := New_Compare_Op
-              (ON_Lt,
-               New_Obj_Value (Off),
-               New_Lit (New_Signed_Literal (Index_Info.Ortho_Type (Mode_Value),
-                                            0)),
-               Ghdl_Bool_Type);
-
-            Cond2 := New_Compare_Op
-              (ON_Ge,
-               New_Obj_Value (Res),
-               New_Value_Selected_Acc_Value (New_Obj (Range_Ptr),
-                                             Index_Info.T.Range_Length),
-               Ghdl_Bool_Type);
-            Check_Bound_Error (New_Dyadic_Op (ON_Or, Cond1, Cond2), Loc, 0);
-         end if;
+         Cond1 := New_Compare_Op
+           (ON_Lt,
+            New_Obj_Value (Off),
+            New_Lit (New_Signed_Literal (Index_Info.Ortho_Type (Mode_Value),
+                                         0)),
+            Ghdl_Bool_Type);
+
+         Cond2 := New_Compare_Op
+           (ON_Ge,
+            New_Obj_Value (Res),
+            M2E (Chap3.Range_To_Length (Rng)),
+            Ghdl_Bool_Type);
+         Check_Bound_Error (New_Dyadic_Op (ON_Or, Cond1, Cond2), Loc, 0);
 
          Close_Temp;
 
          return New_Obj_Value (Res);
-      end Translate_Index_To_Offset;
+      end Translate_Fat_Index_To_Offset;
 
       --  Translate index EXPR in dimension DIM of thin array into an
       --  offset.
@@ -12262,23 +12388,21 @@ package body Translation is
             --  Compute index for the current dimension.
             case Prefix_Info.Type_Mode is
                when Type_Mode_Fat_Array =>
-                  Range_Ptr := Chap3.Get_Array_Range
-                    (Prefix, Prefix_Type, Dim);
+                  Range_Ptr := Stabilize
+                    (Chap3.Get_Array_Range (Prefix, Prefix_Type, Dim));
+                  R := Translate_Fat_Index_To_Offset
+                    (Range_Ptr,
+                     Chap7.Translate_Expression (Index, Ibasetype),
+                     Itype, Index);
                when Type_Mode_Ptr_Array =>
+                  --  Manually extract range since there is no infos for
+                  --   index subtype.
                   Range_Ptr := Chap3.Bounds_To_Range
                     (Chap3.Get_Array_Type_Bounds (Prefix_Type),
                      Prefix_Type, Dim);
-               when Type_Mode_Array =>
-                  null;
-               when others =>
-                  raise Internal_Error;
-            end case;
-            case Prefix_Info.Type_Mode is
-               when Type_Mode_Fat_Array
-                 | Type_Mode_Ptr_Array =>
-                  Range_Ptr := Stabilize (Range_Ptr);
+                  Stabilize (Range_Ptr);
                   R := Translate_Index_To_Offset
-                    (M2Dp (Range_Ptr),
+                    (Range_Ptr,
                      Chap7.Translate_Expression (Index, Ibasetype),
                      Index, Itype, Index);
                when Type_Mode_Array =>