First import from sources

85 files changed, 24128 insertions, 0 deletions

diff --git a/translate/grt/Makefile b/translate/grt/Makefile
new file mode 100644
index 000000000..2b60de150
--- /dev/null
+++ b/translate/grt/Makefile
@@ -0,0 +1,51 @@
+#  -*- Makefile -*- for the GHDL Run Time library.
+#  Copyright (C) 2002, 2003, 2004, 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.
+GRT_FLAGS=-g
+
+ADAC=gnatgcc
+GNATFLAGS=$(CFLAGS) -gnatf -gnaty3befhkmr -gnatwlu
+GHDL1=../ghdl1-gcc
+GRTSRCDIR=.
+GRT_RANLIB=ranlib
+
+INSTALL=install
+INSTALL_DATA=$(INSTALL) -m 644
+
+prefix=/usr/local
+exec_prefix=$(prefix)
+libdir=$(exec_prefix)/lib
+grt_libdir=$(libdir)
+
+target=i686-pc-linux-gnu
+
+all: grt-all
+install: grt-install
+clean: grt-clean
+	$(RM) *~
+
+include Makefile.inc
+
+
+GRT_CFLAGS=$(GRT_FLAGS) -Wall
+ghwdump: ghwdump.o ghwlib.o
+	$(CC) $(GRT_CFLAGS) -o $@ ghwdump.o ghwlib.o
+
+ghwlib.o: ghwlib.c ghwlib.h
+	$(CC) -c $(GRT_CFLAGS) -o $@ $<
+ghwdump.o: ghwdump.c ghwlib.h
+	$(CC) -c $(GRT_CFLAGS) -o $@ $<
diff --git a/translate/grt/Makefile.inc b/translate/grt/Makefile.inc
new file mode 100644
index 000000000..9300770a8
--- /dev/null
+++ b/translate/grt/Makefile.inc
@@ -0,0 +1,161 @@
+#  -*- Makefile -*- for the GHDL Run Time library.
+#  Copyright (C) 2002, 2003, 2004, 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.
+
+# Variables used:
+# AR: ar command
+# RM
+# CC
+# ADAC: the GNAT compiler
+# GHDL1: the ghdl compiler
+# GRT_RANLIB: the ranlib tool for the grt library.
+# grt_libdir: the place to put grt.
+# GRTSRCDIR: the source directory of grt.
+# target: GCC target
+# GRT_FLAGS: compilation flags.
+
+# Set target files.
+ifeq ($(filter-out i%86-pc-linux-gnu,$(target)),)
+  GRT_TARGET_OBJS=i386.o linux.o times.o
+  GRT_EXTRA_LIB=-ldl
+endif
+ifeq ($(filter-out sparc-sun-solaris%,$(target)),)
+  GRT_TARGET_OBJS=sparc.o linux.o times.o
+  GRT_EXTRA_LIB=-ldl
+endif
+ifeq ($(filter-out powerpc-linux%,$(target)),)
+  GRT_TARGET_OBJS=ppc.o linux.o times.o
+  GRT_EXTRA_LIB=-ldl
+endif
+ifeq ($(filter-out i%86-pc-mingw32,$(target)),)
+  GRT_TARGET_OBJS=win32.o clock.o
+endif
+ifeq ($(filter-out i%86-pc-cygwin,$(target)),)
+  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
+endif
+
+GRT_ADD_OBJS=$(GRT_TARGET_OBJS) grt-cbinding.o grt-cvpi.o
+
+GRT_PRAGMA_FLAG=-gnatec$(GRTSRCDIR)/grt.adc
+
+GRT_OBJS_FILES=\
+grt.o \
+grt-disp.o \
+grt-main.o \
+grt-stacks.o \
+grt-errors.o \
+grt-options.o \
+grt-stdio.o \
+grt-files.o \
+grt-processes.o \
+grt-typedesc.o \
+grt-hierarchy.o \
+grt-shadow_ieee.o \
+grt-types.o \
+grt-images.o \
+grt-signals.o \
+grt-vcd.o \
+grt-vpi.o \
+grt-lib.o \
+grt-sdf.o \
+grt-stack2.o \
+grt-names.o
+
+GRT_ADACOMPILE=$(ADAC) -c $(GRT_FLAGS) -o $@ $<
+
+grt-all: libgrt.a grt.lst
+
+libgrt.a: $(GRT_ADD_OBJS) run-bind.o main.o grt-files
+	$(RM) -f $@
+	$(AR) rcv $@ `sed -e "/^-/d" < grt-files` $(GRT_ADD_OBJS) \
+	 run-bind.o main.o
+	$(GRT_RANLIB) $@
+
+run-bind.adb: grt-force
+	gnatmake -c $(GNATFLAGS) -aI$(GRTSRCDIR) $(GRT_PRAGMA_FLAG) ghdl_main \
+	  -cargs $(GRT_FLAGS)
+	gnatbind -Lgrt_ -o run-bind.adb -n ghdl_main.ali
+
+run-bind.o: run-bind.adb
+	$(GRT_ADACOMPILE)
+
+main.o: $(GRTSRCDIR)/main.adb
+	$(GRT_ADACOMPILE)
+
+i386.o: $(GRTSRCDIR)/config/i386.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 $@ $<
+
+linux.o: $(GRTSRCDIR)/config/linux.c
+	$(CC) -c $(GRT_FLAGS) -o $@ $<
+
+win32.o: $(GRTSRCDIR)/config/win32.c
+	$(CC) -c $(GRT_FLAGS) -o $@ $<
+
+pthread.o: $(GRTSRCDIR)/config/pthread.c
+	$(CC) -c $(GRT_FLAGS) -o $@ $<
+
+times.o : $(GRTSRCDIR)/config/times.c
+	$(CC) -c $(GRT_FLAGS) -o $@ $<
+
+clock.o : $(GRTSRCDIR)/config/clock.c
+	$(CC) -c $(GRT_FLAGS) -o $@ $<
+
+grt-cbinding.o: $(GRTSRCDIR)/grt-cbinding.c
+	$(CC) -c $(GRT_FLAGS) -o $@ $<
+
+grt-cvpi.o: $(GRTSRCDIR)/grt-cvpi.c
+	$(CC) -c $(GRT_FLAGS) -o $@ $<
+
+grt-files: run-bind.adb
+	sed -e "1,/-- *BEGIN/d" -e "/-- *END/,\$$d" \
+	  -e "s/   --   //" < $< > $@
+
+# Remove local files (they are now in the libgrt library).
+# Also, remove the -shared option, in order not to build a shared library
+# instead of an executable.
+grt-files.in: grt-files
+	sed -e "\!^./!d" -e "/-shared/d" < $< > $@
+
+grt.lst: grt-files.in
+	echo "@/libgrt.a" > $@
+ifdef GRT_EXTRA_LIB
+	echo $(GRT_EXTRA_LIB) >> $@
+endif
+	cat $< >> $@
+
+grt-install: libgrt.a grt.lst
+	$(INSTALL_DATA) libgrt.a $(DESTDIR)$(grt_libdir)/libgrt.a
+	$(INSTALL_DATA) grt.lst $(DESTDIR)$(grt_libdir)/grt.lst
+
+grt-force:
+
+grt-clean: grt-force
+	$(RM) *.o *.ali run-bind.adb run-bind.ads *.a std_standard.s
+	$(RM) grt-files grt-files.in grt.lst
+
+.PHONY: grt-all grt-force grt-clean grt-install
diff --git a/translate/grt/config/clock.c b/translate/grt/config/clock.c
new file mode 100644
index 000000000..038ce2210
--- /dev/null
+++ b/translate/grt/config/clock.c
@@ -0,0 +1,36 @@
+/*  GRT C bindings for time.
+    Copyright (C) 2002, 2003, 2004, 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.
+*/
+#include <time.h>
+
+int
+grt_get_clk_tck (void)
+{
+  return CLOCKS_PER_SEC;
+}
+
+void
+grt_get_times (int *wall, int *user, int *sys)
+{
+  clock_t res;
+
+  *wall = clock ();
+  *user = 0;
+  *sys = 0;
+}
+
diff --git a/translate/grt/config/i386.S b/translate/grt/config/i386.S
new file mode 100644
index 000000000..fbd8954cb
--- /dev/null
+++ b/translate/grt/config/i386.S
@@ -0,0 +1,108 @@
+/*  GRT stack implementation for x86.
+    Copyright (C) 2002, 2003, 2004, 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.
+*/
+	.file		"i386.S"
+	.version	"01.01"
+	
+	.text
+
+	/* Function called to loop on the process.  */	
+	.align 4
+	.type	grt_stack_loop,@function
+grt_stack_loop:	
+	call	*4(%esp)
+	jmp	grt_stack_loop
+	.size	grt_stack_loop, . - grt_stack_loop
+
+	/* function Stack_Create (Func : Address; Arg : Address)
+ 	                          return Stack_Type;
+	*/
+	.align	4
+	.globl grt_stack_create
+	.type	 grt_stack_create,@function
+grt_stack_create:
+	/* Standard prologue.  */
+	pushl	%ebp
+	movl	%esp,%ebp
+	/* Keep aligned (call + pushl + 8 = 16 bytes).  */
+	subl	$8,%esp
+	
+	/* Allocate the stack, and exit in case of failure  */
+	call	grt_stack_allocate
+	testl	%eax,%eax
+	je	.Ldone
+
+	/* Note: %EAX contains the address of the stack_context.  This is
+	   also the top of the stack.  */
+				
+	/* Prepare stack.  */
+	/* The function to be executed.  */
+	movl	8(%ebp), %ecx
+	movl	%ecx, -4(%eax)
+	/* The argument.  */
+	movl	12(%ebp), %ecx
+	movl	%ecx, -8(%eax)
+	/* The return function.  */
+	movl	$grt_stack_loop, -12(%eax)
+	/* The context.  */
+	movl	%ebx, -16(%eax)
+	movl	%esi, -20(%eax)
+	movl	%edi, -24(%eax)
+	movl	%ebp, -28(%eax)
+
+	/* Save the new stack pointer to the stack context.  */
+	leal	-28(%eax), %ecx
+	movl	%ecx, (%eax)
+
+.Ldone:
+	leave
+	ret
+	.size	 grt_stack_create,. - grt_stack_create
+
+
+
+	.align 4
+	.globl grt_stack_switch
+	/* Arguments:	TO, FROM
+	   Both are pointers to a stack_context.  */
+	.type	 grt_stack_switch,@function
+grt_stack_switch:
+	/* TO -> ECX.  */
+	movl	4(%esp), %ecx
+	/* FROM -> EDX.  */
+	movl	8(%esp), %edx
+	/* Save call-used registers.  */
+	pushl	%ebx
+	pushl	%esi
+	pushl	%edi
+	pushl	%ebp
+	/* Save the current stack.  */
+	movl	%esp, (%edx)
+	/* Stack switch.  */
+	movl	(%ecx), %esp
+	/* Restore call-used registers.  */
+	popl	%ebp
+	popl	%edi
+	popl	%esi
+	popl	%ebx
+	/* Run.  */
+	ret
+	.size	 grt_stack_switch, . - grt_stack_switch
+
+	
+	.ident	"Written by T.Gingold"
diff --git a/translate/grt/config/linux.c b/translate/grt/config/linux.c
new file mode 100644
index 000000000..047cfd1b4
--- /dev/null
+++ b/translate/grt/config/linux.c
@@ -0,0 +1,268 @@
+/*  GRT stacks implementation for linux and other *nix.
+    Copyright (C) 2002, 2003, 2004, 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.
+*/
+#define _GNU_SOURCE
+#include <unistd.h>
+#include <sys/mman.h>
+#include <signal.h>
+#include <fcntl.h>
+#include <sys/ucontext.h>
+//#include <stdint.h>
+
+/* On x86, the stack growns downward.  */
+#define STACK_GROWNS_DOWNWARD 1
+
+#ifdef linux
+/* If set, SIGSEGV is caught in order to automatically grow the stacks.  */
+#define EXTEND_STACK 1
+#endif
+
+/* Defined in Grt.Stacks.  */
+extern unsigned int stack_size;
+extern unsigned int stack_max_size;
+
+/* Size of a memory page.  */
+static size_t page_size;
+
+extern void grt_stack_error_grow_failed (void);
+extern void grt_stack_error_null_access (void);
+extern void grt_stack_error_memory_access (void);
+extern void grt_overflow_error (void);
+
+/* Definitions:
+   The base of the stack is the address before the first available byte on the
+     stack.  If the stack grows downward, the base is equal to the high bound.
+*/
+   
+/* Per stack context.
+   This context is allocated at the top (or bottom if the stack grows
+   upward) of the stack.
+   Therefore, the base of the stack can be easily deduced from the context.  */
+struct stack_context
+{
+  /* The current stack pointer.  */
+  void *cur_sp;
+  /* The current stack length.  */
+  size_t cur_length;
+};
+
+/* Context for the main stack.  */
+static struct stack_context main_stack_context;
+
+extern struct stack_context *grt_stack_main_stack;
+
+/* If MAP_ANONYMOUS is not defined, use /dev/zero. */
+#ifndef MAP_ANONYMOUS
+#define USE_DEV_ZERO
+static int dev_zero_fd;
+#define MAP_ANONYMOUS 0
+#define MMAP_FILEDES dev_zero_fd
+#else
+#define MMAP_FILEDES -1
+#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;
+
+/* Stack used for signals.
+   The stack must be different from the running stack, because we want to be
+   able to extend the running stack.  When the stack need to be extended, the
+   current stack pointer does not point to a valid address.  Therefore, the
+   stack cannot be used or else a second SIGSEGV is generated while the
+   arguments are pushed.  */
+static unsigned long sig_stack[SIGSTKSZ / sizeof (long)];
+
+/* Signal stack descriptor.  */
+static stack_t sig_stk;
+
+static struct sigaction prev_sigsegv_act;
+static struct sigaction sigsegv_act;
+
+/* The following code assumes stack grows downward.  */
+#if !STACK_GROWNS_DOWNWARD
+#error "Not implemented"
+#endif
+
+/* Handler for SIGSEGV signal, which grow the stack.  */
+static void grt_sigsegv_handler (int signo, siginfo_t *info, void *ptr)
+{
+  static int in_handler;
+  void *addr;
+  struct stack_context *ctxt;
+  void *stack_high;
+  void *stack_low;
+  void *n_low;
+  size_t n_len;
+  ucontext_t *uctxt = (ucontext_t *)ptr;
+
+  in_handler++;
+
+#ifdef __i386__
+  /* Linux generates a SIGSEGV (!) for an overflow exception.  */
+  if (uctxt->uc_mcontext.gregs[REG_TRAPNO] == 4)
+    {
+      grt_overflow_error ();
+    }
+#endif
+
+  if (info == NULL || grt_cur_proc == NULL || in_handler > 1)
+    {
+      /* We loose.  */
+      sigaction (SIGSEGV, &prev_sigsegv_act, NULL);
+      return;
+    }
+
+  addr = info->si_addr;
+  
+  /* Check ADDR belong to the stack.  */
+  ctxt = *grt_cur_proc;
+  stack_high = (void *)(ctxt + 1);
+  stack_low = stack_high - stack_max_size;
+  if (addr > stack_high || addr < stack_low)
+    {
+      /* Out of the stack.  */
+      if (addr < (void *)page_size)
+	grt_stack_error_null_access ();
+      else
+	grt_stack_error_memory_access ();
+    }
+  /* Compute the address of the faulting page.  */
+  n_low = (void *)((unsigned long)addr & ~(page_size - 1));
+
+  /* Should not happen.  */
+  if (n_low < stack_low)
+    abort ();
+
+  /*  Allocate one more page, if possible.  */
+  if (n_low != stack_low)
+    n_low -= page_size;
+
+  /* Compute the new length.  */
+  n_len = stack_high - n_low;
+
+  if (mmap (n_low, n_len - ctxt->cur_length,  PROT_READ | PROT_WRITE,
+	    MAP_FIXED | MAP_PRIVATE | MAP_ANONYMOUS, MMAP_FILEDES, 0)
+      != n_low)
+    {
+      /* Cannot grow the stack.  */
+      grt_stack_error_grow_failed ();
+    }
+
+  ctxt->cur_length = n_len;
+
+  sigaction (SIGSEGV, &sigsegv_act, NULL);
+
+  in_handler--;
+
+  /* Hopes we can resume!  */
+  return;
+}
+
+static void grt_signal_setup (void)
+{
+  sigsegv_act.sa_sigaction = &grt_sigsegv_handler;
+  sigemptyset (&sigsegv_act.sa_mask);
+  sigsegv_act.sa_flags = SA_ONESHOT | SA_ONSTACK | SA_SIGINFO;
+
+  /* Use an alternate stack during signals.  */
+  sig_stk.ss_sp = sig_stack;
+  sig_stk.ss_size = sizeof (sig_stack);
+  sig_stk.ss_flags = 0;
+  sigaltstack (&sig_stk, NULL);
+
+  /* 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
+
+void
+grt_stack_init (void)
+{
+  size_t pg_round;
+
+  page_size = getpagesize ();
+  pg_round = page_size - 1;
+
+  /* Align size.  */
+  stack_size = (stack_size + pg_round) & ~pg_round;
+  stack_max_size = (stack_max_size + pg_round) & ~pg_round;
+
+  /* Set mimum values.  */
+  if (stack_size < 2 * page_size)
+    stack_size = 2 * page_size;
+  if (stack_max_size < (stack_size + 2 * page_size))
+    stack_max_size = stack_size + 2 * page_size;
+
+  /* Initialize the main stack context.  */
+  main_stack_context.cur_sp = NULL;
+  main_stack_context.cur_length = 0;
+  grt_stack_main_stack = &main_stack_context;
+
+#ifdef USE_DEV_ZERO
+  dev_zero_fd = open ("/dev/zero", O_RDWR);
+  if (dev_zero_fd < 0)
+    abort ();
+#endif
+
+#if EXTEND_STACK
+  grt_signal_setup ();
+#endif
+}
+
+/* Allocate a stack.
+   Called by i386.S  */
+struct stack_context *
+grt_stack_allocate (void)
+{
+  struct stack_context *res;
+  void *r;
+  void *base;
+
+  /* Allocate the stack, but without any rights.  This is a guard.  */
+  base = (void *)mmap (NULL, stack_max_size, PROT_NONE,
+		       MAP_PRIVATE | MAP_ANONYMOUS, MMAP_FILEDES, 0);
+
+  if (base == (void *)-1)
+    return NULL;
+
+  /* Set rights on the allocated stack.  */
+#if STACK_GROWNS_DOWNWARD
+  r = base + stack_max_size - stack_size;
+#else
+  r = base;
+#endif
+  if (mmap (r, stack_size,  PROT_READ | PROT_WRITE,
+	    MAP_FIXED | MAP_PRIVATE | MAP_ANONYMOUS, MMAP_FILEDES, 0)
+      != r)
+    return NULL;
+
+#if STACK_GROWNS_DOWNWARD
+  res = (struct stack_context *)
+    (base + stack_max_size - sizeof (struct stack_context));
+#else
+  res = (struct stack_context *)(base + sizeof (struct stack_context));
+#endif
+
+  res->cur_sp = (void *)res;
+  res->cur_length = stack_size;
+  return res;
+}
diff --git a/translate/grt/config/ppc.S b/translate/grt/config/ppc.S
new file mode 100644
index 000000000..ccfdc2209
--- /dev/null
+++ b/translate/grt/config/ppc.S
@@ -0,0 +1,327 @@
+/*  GRT stack implementation for ppc.
+    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.
+*/
+	.file		"ppc.S"
+	
+	.section	".text"
+
+#define OFF 240
+
+#define GREG(x) x
+#define FREG(x) x
+	
+#define r0 GREG(0)
+#define r1 GREG(1)
+#define r2 GREG(2)
+#define r3 GREG(3)
+#define r4 GREG(4)
+#define r5 GREG(5)
+#define r6 GREG(6)
+#define r7 GREG(7)
+#define r8 GREG(8)
+#define r9 GREG(9)
+#define r10 GREG(10)
+#define r11 GREG(11)
+#define r12 GREG(12)
+#define r13 GREG(13)
+#define r14 GREG(14)
+#define r15 GREG(15)
+#define r16 GREG(16)
+#define r17 GREG(17)
+#define r18 GREG(18)
+#define r19 GREG(19)
+#define r20 GREG(20)
+#define r21 GREG(21)
+#define r22 GREG(22)
+#define r23 GREG(23)
+#define r24 GREG(24)
+#define r25 GREG(25)
+#define r26 GREG(26)
+#define r27 GREG(27)
+#define r28 GREG(28)
+#define r29 GREG(29)
+#define r30 GREG(30)
+#define r31 GREG(31)
+
+#define f0 FREG(0)
+#define f1 FREG(1)
+#define f2 FREG(2)
+#define f3 FREG(3)
+#define f4 FREG(4)
+#define f5 FREG(5)
+#define f6 FREG(6)
+#define f7 FREG(7)
+#define f8 FREG(8)
+#define f9 FREG(9)
+#define f10 FREG(10)
+#define f11 FREG(11)
+#define f12 FREG(12)
+#define f13 FREG(13)
+#define f14 FREG(14)
+#define f15 FREG(15)
+#define f16 FREG(16)
+#define f17 FREG(17)
+#define f18 FREG(18)
+#define f19 FREG(19)
+#define f20 FREG(20)
+#define f21 FREG(21)
+#define f22 FREG(22)
+#define f23 FREG(23)
+#define f24 FREG(24)
+#define f25 FREG(25)
+#define f26 FREG(26)
+#define f27 FREG(27)
+#define f28 FREG(28)
+#define f29 FREG(29)
+#define f30 FREG(30)
+#define f31 FREG(31)
+
+	/* Stack structure is:
+           +4 :	cur_length   \  Stack
+	   +0 :	cur_sp       /  Context
+	   -4 :	arg
+	   -8 :	func
+	
+	   -12:	pad
+	   -16: pad
+           -20: LR save word
+	   -24:	Back chain
+	
+	   -28: fp/gp saved registers. 
+	   -4 :	return address
+	   -8 :	process function to be executed
+           -12:	function argument
+	   ...
+           -72:	%sp
+	*/
+	
+	/* Function called to loop on the process.  */	
+	.align 4
+	.type	grt_stack_loop,@function
+grt_stack_loop:
+	/* Get function.  */
+	lwz	r0,16(r1)
+	/* Get argument.  */
+	lwz	r3,20(r1)
+	mtlr	r0
+	blrl
+	b	grt_stack_loop
+	.size	grt_stack_loop, . - grt_stack_loop
+
+	/* function Stack_Create (Func : Address; Arg : Address)
+	                         return Stack_Type;  */
+	.align	4
+	.global grt_stack_create
+	.type	 grt_stack_create,@function
+grt_stack_create:
+	/* Standard prologue.  */
+	stwu	r1,-32(r1)
+	mflr	r0
+	stw	r0,36(r1)
+
+	/* Save arguments.  */
+	stw	r3,24(r1)
+	stw	r4,28(r1)
+	
+	/* Allocate the stack, and exit in case of failure  */
+	bl	grt_stack_allocate
+	cmpwi	0,r3,0
+	beq-	.Ldone
+
+	/* Note: r3 contains the address of the stack_context.  This is
+	   also the top of the stack.  */
+				
+	/* Prepare stack.  */
+	/* Align the stack.  */
+	addi	r5,r3,-24
+
+	/* Save the parameters.  */
+	lwz	r6,24(r1)
+	stw	r6,16(r5)
+	lwz	r7,28(r1)
+	stw	r7,20(r5)
+	
+	/* The return function.  */
+	lis	r4,grt_stack_loop@ha
+	la	r4,grt_stack_loop@l(r4)
+	stw	r4,4(r5)
+	/* Back-Chain.  */
+	addi	r4,r1,32
+	stw	r4,0(r5)
+
+	/* Save register.
+	   They should be considered as garbage.  */
+	addi	r4,r5,-OFF
+	
+	stfd	f31,(OFF - 8)(r4)
+	stfd	f30,(OFF - 16)(r4)
+	stfd	f29,(OFF - 24)(r4)
+	stfd	f28,(OFF - 32)(r4)
+	stfd	f27,(OFF - 40)(r4)
+	stfd	f26,(OFF - 48)(r4)
+	stfd	f25,(OFF - 56)(r4)
+	stfd	f24,(OFF - 64)(r4)
+	stfd	f23,(OFF - 72)(r4)
+	stfd	f22,(OFF - 80)(r4)
+	stfd	f21,(OFF - 88)(r4)
+	stfd	f20,(OFF - 96)(r4)
+	stfd	f19,(OFF - 104)(r4)
+	stfd	f18,(OFF - 112)(r4)
+	stfd	f17,(OFF - 120)(r4)
+	stfd	f16,(OFF - 128)(r4)
+	stfd	f15,(OFF - 136)(r4)
+	stfd	f14,(OFF - 144)(r4)
+	stw	r31,(OFF - 148)(r4)
+	stw	r30,(OFF - 152)(r4)
+	stw	r29,(OFF - 156)(r4)
+	stw	r28,(OFF - 160)(r4)
+	stw	r27,(OFF - 164)(r4)
+	stw	r26,(OFF - 168)(r4)
+	stw	r25,(OFF - 172)(r4)
+	stw	r24,(OFF - 176)(r4)
+	stw	r23,(OFF - 180)(r4)
+	stw	r22,(OFF - 184)(r4)
+	stw	r21,(OFF - 188)(r4)
+	stw	r20,(OFF - 192)(r4)
+	stw	r19,(OFF - 196)(r4)
+	stw	r18,(OFF - 200)(r4)
+	stw	r17,(OFF - 204)(r4)
+	stw	r16,(OFF - 208)(r4)
+	stw	r15,(OFF - 212)(r4)
+	stw	r14,(OFF - 216)(r4)
+	mfcr	r0
+	stw	r0, (OFF - 220)(r4)
+
+	/* Save stack pointer.  */
+	stw	r4, 0(r3)
+
+.Ldone:
+	lwz	r0,36(r1)
+	mtlr	r0
+	addi	r1,r1,32
+	blr
+	.size	 grt_stack_create,. - grt_stack_create
+
+
+	.align 4
+	.global grt_stack_switch
+	/* Arguments:	TO, FROM.
+	   Both are pointers to a stack_context.  */
+	.type	 grt_stack_switch,@function
+grt_stack_switch:
+	/* Standard prologue, save return address.  */
+	stwu	r1,(-OFF)(r1)
+	mflr	r0
+	stw	r0,(OFF + 4)(r1)
+
+	/* Save r14-r31, f14-f31, CR
+	   This is 18 words + 18 double words, ie 216 bytes.  */
+	/* Maybe use the savefpr function ? */
+	stfd	f31,(OFF - 8)(r1)
+	stfd	f30,(OFF - 16)(r1)
+	stfd	f29,(OFF - 24)(r1)
+	stfd	f28,(OFF - 32)(r1)
+	stfd	f27,(OFF - 40)(r1)
+	stfd	f26,(OFF - 48)(r1)
+	stfd	f25,(OFF - 56)(r1)
+	stfd	f24,(OFF - 64)(r1)
+	stfd	f23,(OFF - 72)(r1)
+	stfd	f22,(OFF - 80)(r1)
+	stfd	f21,(OFF - 88)(r1)
+	stfd	f20,(OFF - 96)(r1)
+	stfd	f19,(OFF - 104)(r1)
+	stfd	f18,(OFF - 112)(r1)
+	stfd	f17,(OFF - 120)(r1)
+	stfd	f16,(OFF - 128)(r1)
+	stfd	f15,(OFF - 136)(r1)
+	stfd	f14,(OFF - 144)(r1)
+	stw	r31,(OFF - 148)(r1)
+	stw	r30,(OFF - 152)(r1)
+	stw	r29,(OFF - 156)(r1)
+	stw	r28,(OFF - 160)(r1)
+	stw	r27,(OFF - 164)(r1)
+	stw	r26,(OFF - 168)(r1)
+	stw	r25,(OFF - 172)(r1)
+	stw	r24,(OFF - 176)(r1)
+	stw	r23,(OFF - 180)(r1)
+	stw	r22,(OFF - 184)(r1)
+	stw	r21,(OFF - 188)(r1)
+	stw	r20,(OFF - 192)(r1)
+	stw	r19,(OFF - 196)(r1)
+	stw	r18,(OFF - 200)(r1)
+	stw	r17,(OFF - 204)(r1)
+	stw	r16,(OFF - 208)(r1)
+	stw	r15,(OFF - 212)(r1)
+	stw	r14,(OFF - 216)(r1)
+	mfcr	r0
+	stw	r0, (OFF - 220)(r1)
+	
+	/* Save stack pointer.  */
+	stw	r1, 0(r4)
+
+	/* Load stack pointer.  */
+	lwz	r1, 0(r3)
+			
+
+	lfd	f31,(OFF - 8)(r1)
+	lfd	f30,(OFF - 16)(r1)
+	lfd	f29,(OFF - 24)(r1)
+	lfd	f28,(OFF - 32)(r1)
+	lfd	f27,(OFF - 40)(r1)
+	lfd	f26,(OFF - 48)(r1)
+	lfd	f25,(OFF - 56)(r1)
+	lfd	f24,(OFF - 64)(r1)
+	lfd	f23,(OFF - 72)(r1)
+	lfd	f22,(OFF - 80)(r1)
+	lfd	f21,(OFF - 88)(r1)
+	lfd	f20,(OFF - 96)(r1)
+	lfd	f19,(OFF - 104)(r1)
+	lfd	f18,(OFF - 112)(r1)
+	lfd	f17,(OFF - 120)(r1)
+	lfd	f16,(OFF - 128)(r1)
+	lfd	f15,(OFF - 136)(r1)
+	lfd	f14,(OFF - 144)(r1)
+	lwz	r31,(OFF - 148)(r1)
+	lwz	r30,(OFF - 152)(r1)
+	lwz	r29,(OFF - 156)(r1)
+	lwz	r28,(OFF - 160)(r1)
+	lwz	r27,(OFF - 164)(r1)
+	lwz	r26,(OFF - 168)(r1)
+	lwz	r25,(OFF - 172)(r1)
+	lwz	r24,(OFF - 176)(r1)
+	lwz	r23,(OFF - 180)(r1)
+	lwz	r22,(OFF - 184)(r1)
+	lwz	r21,(OFF - 188)(r1)
+	lwz	r20,(OFF - 192)(r1)
+	lwz	r19,(OFF - 196)(r1)
+	lwz	r18,(OFF - 200)(r1)
+	lwz	r17,(OFF - 204)(r1)
+	lwz	r16,(OFF - 208)(r1)
+	lwz	r15,(OFF - 212)(r1)
+	lwz	r14,(OFF - 216)(r1)
+	lwz	r0, (OFF - 220)(r1)
+	mtcr	r0
+
+	lwz	r0,(OFF + 4)(r1)
+	mtlr	r0
+	addi	r1,r1,OFF
+	blr
+	.size	 grt_stack_switch, . - grt_stack_switch
+
+	
+	.ident	"Written by T.Gingold"
diff --git a/translate/grt/config/pthread.c b/translate/grt/config/pthread.c
new file mode 100644
index 000000000..f611bb615
--- /dev/null
+++ b/translate/grt/config/pthread.c
@@ -0,0 +1,157 @@
+/*  GRT stack implementation based on pthreads.
+    Copyright (C) 2003, 2004, 2005 Felix Bertram & 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.
+*/
+//-----------------------------------------------------------------------------
+// Project:     GHDL - VHDL Simulator
+// Description: pthread port of stacks package, for use with MacOSX
+// Note:        Tristan's original i386/Linux used assembly-code 
+//              to manually switch stacks for performance reasons.
+// History:     2003may22, FB, created.
+//-----------------------------------------------------------------------------
+
+#include <pthread.h>
+#include <stdlib.h>
+#include <stdio.h>
+
+
+//#define INFO printf
+#define INFO (void)
+
+// GHDL names an endless loop calling FUNC with ARG a 'stack'
+// at a given time, only one stack may be 'executed'
+typedef struct 
+{	pthread_t           thread;         // stack's thread
+	pthread_mutex_t     mutex;          // mutex to suspend/resume thread
+	void                (*Func)(void*); // stack's FUNC
+	void*               Arg;            // ARG passed to FUNC
+} Stack_Type_t, *Stack_Type;
+
+Stack_Type_t      main_stack_context;
+extern Stack_Type grt_stack_main_stack;
+
+//------------------------------------------------------------------------------
+void grt_stack_init(void)
+// Initialize the stacks package.
+// This may adjust stack sizes.
+// Must be called after grt.options.decode.
+// => procedure Stack_Init;
+{	INFO("grt_stack_init\n");
+	INFO("  main_stack_context=0x%08x\n", &main_stack_context);
+	
+	pthread_mutex_init(&(main_stack_context.mutex), NULL);
+
+	// lock the mutex, as we are currently running
+	pthread_mutex_lock(&(main_stack_context.mutex));
+	
+	grt_stack_main_stack= &main_stack_context;
+}
+
+//------------------------------------------------------------------------------
+static void* grt_stack_loop(void* pv_myStack)
+{
+	Stack_Type myStack= (Stack_Type)pv_myStack;
+
+	INFO("grt_stack_loop\n");
+	
+	INFO("  myStack=0x%08x\n", myStack);
+
+	// block until mutex becomes available again.
+	// this happens when this stack is enabled for the first time
+	pthread_mutex_lock(&(myStack->mutex));
+	
+	// run stack's function in endless loop
+	while(1)
+	{	INFO("  call 0x%08x with 0x%08x\n", myStack->Func, myStack->Arg);
+		myStack->Func(myStack->Arg);
+	}
+	
+	// we never get here...
+	return 0;
+}
+
+//------------------------------------------------------------------------------
+Stack_Type grt_stack_create(void* Func, void* Arg) 
+// Create a new stack, which on first execution will call FUNC with
+// an argument ARG.
+// => function Stack_Create (Func : Address; Arg : Address) return Stack_Type;
+{
+  	Stack_Type newStack;
+
+	INFO("grt_stack_create\n");
+	INFO("  call 0x%08x with 0x%08x\n", Func, Arg);
+			
+	newStack= malloc(sizeof(Stack_Type_t));
+	
+	// init function and argument
+	newStack->Func= Func;
+	newStack->Arg=  Arg;
+	
+	// create mutex
+	pthread_mutex_init(&(newStack->mutex), NULL);
+	
+	// block the mutex, so that thread will blocked in grt_stack_loop
+	pthread_mutex_lock(&(newStack->mutex));
+	
+	INFO("  newStack=0x%08x\n", newStack);
+	
+	// create thread, which executes grt_stack_loop
+	pthread_create(&(newStack->thread), NULL, grt_stack_loop, newStack); 
+	
+	return newStack;
+}
+
+//------------------------------------------------------------------------------
+void grt_stack_switch(Stack_Type To, Stack_Type From)
+// Resume stack TO and save the current context to the stack pointed by
+// CUR.
+// => procedure Stack_Switch (To : Stack_Type; From : Stack_Type);
+{	INFO("grt_stack_switch\n");
+	INFO("  from 0x%08x to 0x%08x\n", From, To);
+	
+	// unlock 'To' mutex. this will make the other thread either
+	// - starts for first time in grt_stack_loop
+	// - resumes at lock below
+	pthread_mutex_unlock(&(To->mutex));
+		
+	// block until 'From' mutex becomes available again
+	// as we are running, our mutex is locked and we block here
+	// when stacks are switched, with above unlock, we may proceed
+	pthread_mutex_lock(&(From->mutex));
+}
+
+//------------------------------------------------------------------------------
+void grt_stack_delete(Stack_Type Stack)
+// Delete stack STACK, which must not be currently executed.
+// => procedure Stack_Delete (Stack : Stack_Type);
+{	INFO("grt_stack_delete\n");
+}
+
+//------------------------------------------------------------------------------
+void __gnat_raise_storage_error(void)
+{
+   abort ();
+}
+
+void __gnat_raise_program_error(void)
+{
+   abort ();
+}
+
+//------------------------------------------------------------------------------
+// end of file
+
diff --git a/translate/grt/config/sparc.S b/translate/grt/config/sparc.S
new file mode 100644
index 000000000..698d49eb4
--- /dev/null
+++ b/translate/grt/config/sparc.S
@@ -0,0 +1,134 @@
+/*  GRT stack implementation for x86.
+    Copyright (C) 2002, 2003, 2004, 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.
+*/
+	.file		"sparc.S"
+	
+	.section	".text"
+
+	/* Stack structure is:
+           +4 :	cur_length
+	   +0 :	cur_sp
+	   -4 :	return address
+	   -8 :	process function to be executed
+           -12:	function argument
+	   ...
+           -72:	%sp
+	*/
+	
+	/* Function called to loop on the process.  */	
+	.align 4
+	.type	grt_stack_loop,#function
+grt_stack_loop:
+	ld	[%sp + 64], %o1
+	jmpl	%o1 + 0, %o7
+	ld	[%sp + 68], %o0
+	ba	grt_stack_loop
+	nop
+	.size	grt_stack_loop, . - grt_stack_loop
+
+	/* function Stack_Create (Func : Address; Arg : Address)
+	                         return Stack_Type;  */
+	.align	4
+	.global grt_stack_create
+	.type	 grt_stack_create,#function
+grt_stack_create:
+	/* Standard prologue.  */
+	save	%sp,-80,%sp
+	
+	/* Allocate the stack, and exit in case of failure  */
+	call	grt_stack_allocate
+	nop
+	cmp	%o0, 0
+	be	.Ldone
+	nop
+
+	/* Note: %o0 contains the address of the stack_context.  This is
+	   also the top of the stack.  */
+				
+	/* Prepare stack.  */
+
+	/* The return function.  */
+	sethi	%hi(grt_stack_loop - 8), %l2
+	or	%lo(grt_stack_loop - 8), %l2, %l2
+
+	/* Create a frame for grt_stack_loop. */
+	sub	%o0, (64 + 8), %l1
+
+	/* The function to be executed.  */
+	st	%i0, [%l1 + 64]
+	/* The argument.  */
+	st	%i1, [%l1 + 68]
+
+	/* Create a frame for grt_stack_switch.  */
+	sub	%l1, 64, %l0
+
+	/* Save frame pointer.  */
+	st	%l1, [%l0 + 56]
+	/* Save return address.  */
+	st	%l2, [%l0 + 60]
+
+	/* Save stack pointer.  */
+	st	%l0, [%o0]
+
+.Ldone:
+	ret
+	restore %o0, %g0, %o0
+	.size	 grt_stack_create,. - grt_stack_create
+
+
+	.align 4
+	.global grt_stack_switch
+	/* Arguments:	TO, FROM.
+	   Both are pointers to a stack_context.  */
+	.type	 grt_stack_switch,#function
+grt_stack_switch:
+	/* Standard prologue.  */
+	save	%sp,-80,%sp
+
+	/* Flush and invalidate windows.
+	   It is not clear wether the current window is saved or not,
+	    therefore, I assume it is not.
+	*/
+	ta	3
+
+	/* Only IN registers %fp and %i7 (return address) must be saved.
+	   Of course, I could use std/ldd, but it is not as clear
+	*/
+	/* Save current frame pointer.  */
+	st	%fp, [%sp + 56]
+	/* Save return address.  */
+	st	%i7, [%sp + 60]
+
+	/* Save stack pointer.  */
+	st	%sp, [%i1]
+
+	/* Load stack pointer.  */
+	ld	[%i0], %sp
+	
+	/* Load return address.  */
+	ld	[%sp + 60], %i7
+	/* Load frame pointer.  */
+	ld	[%sp + 56], %fp
+
+	/* Return.  */
+	ret
+	restore	
+	.size	 grt_stack_switch, . - grt_stack_switch
+
+	
+	.ident	"Written by T.Gingold"
diff --git a/translate/grt/config/times.c b/translate/grt/config/times.c
new file mode 100644
index 000000000..7a6dd5d82
--- /dev/null
+++ b/translate/grt/config/times.c
@@ -0,0 +1,48 @@
+/*  GRT C bindings for time.
+    Copyright (C) 2002, 2003, 2004, 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.
+*/
+#include <sys/times.h>
+#include <unistd.h>
+
+int
+grt_get_clk_tck (void)
+{
+  return sysconf (_SC_CLK_TCK);
+}
+
+void
+grt_get_times (int *wall, int *user, int *sys)
+{
+  clock_t res;
+  struct tms buf;
+
+  res = times (&buf);
+  if (res == (clock_t)-1)
+    {
+      *wall = 0;
+      *user = 0;
+      *sys = 0;
+    }
+  else
+    {
+      *wall = res;
+      *user = buf.tms_utime;
+      *sys = buf.tms_stime;
+    }
+}
+
diff --git a/translate/grt/config/win32.c b/translate/grt/config/win32.c
new file mode 100644
index 000000000..6c55f7b8a
--- /dev/null
+++ b/translate/grt/config/win32.c
@@ -0,0 +1,164 @@
+/*  GRT stack implementation for Win32
+    Copyright (C) 2004, 2005 Felix Bertram.
+
+    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.
+*/
+//-----------------------------------------------------------------------------
+// Project:     GHDL - VHDL Simulator
+// Description: Win32 port of stacks package
+// Note:        Tristan's original i386/Linux used assembly-code 
+//              to manually switch stacks for performance reasons.
+// History:     2004feb09, FB, created.
+//-----------------------------------------------------------------------------
+
+#include <windows.h>
+//#include <pthread.h>
+//#include <stdlib.h>
+//#include <stdio.h>
+
+
+//#define INFO printf
+#define INFO (void)
+
+// GHDL names an endless loop calling FUNC with ARG a 'stack'
+// at a given time, only one stack may be 'executed'
+typedef struct 
+{	HANDLE              thread;         // stack's thread
+	HANDLE              mutex;          // mutex to suspend/resume thread
+	void                (*Func)(void*); // stack's FUNC
+	void*               Arg;            // ARG passed to FUNC
+} Stack_Type_t, *Stack_Type;
+
+Stack_Type_t      main_stack_context;
+extern Stack_Type grt_stack_main_stack;
+
+//------------------------------------------------------------------------------
+void grt_stack_init(void)
+// Initialize the stacks package.
+// This may adjust stack sizes.
+// Must be called after grt.options.decode.
+// => procedure Stack_Init;
+{	INFO("grt_stack_init\n");
+	INFO("  main_stack_context=0x%08x\n", &main_stack_context);
+
+	// create event. reset event, as we are currently running
+	main_stack_context.mutex = CreateEvent(NULL,  // lpsa
+	                                       FALSE, // fManualReset
+	                                       FALSE, // fInitialState
+	                                       NULL); // lpszEventName
+
+	grt_stack_main_stack= &main_stack_context;
+}
+
+//------------------------------------------------------------------------------
+static unsigned long __stdcall grt_stack_loop(void* pv_myStack)
+{
+	Stack_Type myStack= (Stack_Type)pv_myStack;
+
+	INFO("grt_stack_loop\n");
+	
+	INFO("  myStack=0x%08x\n", myStack);
+
+	// block until event becomes set again.
+	// this happens when this stack is enabled for the first time
+	WaitForSingleObject(myStack->mutex, INFINITE);
+	
+	// run stack's function in endless loop
+	while(1)
+	{	INFO("  call 0x%08x with 0x%08x\n", myStack->Func, myStack->Arg);
+		myStack->Func(myStack->Arg);
+	}
+	
+	// we never get here...
+	return 0;
+}
+
+//------------------------------------------------------------------------------
+Stack_Type grt_stack_create(void* Func, void* Arg) 
+// Create a new stack, which on first execution will call FUNC with
+// an argument ARG.
+// => function Stack_Create (Func : Address; Arg : Address) return Stack_Type;
+{  	Stack_Type newStack;
+	DWORD      m_IDThread; // Thread's ID (dummy)
+
+	INFO("grt_stack_create\n");
+	INFO("  call 0x%08x with 0x%08x\n", Func, Arg);
+			
+	newStack= malloc(sizeof(Stack_Type_t));
+	
+	// init function and argument
+	newStack->Func= Func;
+	newStack->Arg=  Arg;
+	
+	// create event. reset event, so that thread will blocked in grt_stack_loop
+	newStack->mutex= CreateEvent(NULL,  // lpsa
+	                             FALSE, // fManualReset
+	                             FALSE, // fInitialState
+	                             NULL); // lpszEventName
+	
+	INFO("  newStack=0x%08x\n", newStack);
+	
+	// create thread, which executes grt_stack_loop
+	newStack->thread= CreateThread(NULL,           // lpsa
+	                               0,              // cbStack
+	                               grt_stack_loop, // lpStartAddr
+	                               newStack,       // lpvThreadParm
+	                               0,              // fdwCreate
+	                               &m_IDThread);   // lpIDThread
+	
+	return newStack;
+}
+
+//------------------------------------------------------------------------------
+void grt_stack_switch(Stack_Type To, Stack_Type From)
+// Resume stack TO and save the current context to the stack pointed by
+// CUR.
+// => procedure Stack_Switch (To : Stack_Type; From : Stack_Type);
+{	INFO("grt_stack_switch\n");
+	INFO("  from 0x%08x to 0x%08x\n", From, To);
+	
+	// set 'To' event. this will make the other thread either
+	// - start for first time in grt_stack_loop
+	// - resume at WaitForSingleObject below
+	SetEvent(To->mutex);
+		
+	// block until 'From' event becomes set again
+	// as we are running, our event is reset and we block here
+	// when stacks are switched, with above SetEvent, we may proceed
+	WaitForSingleObject(From->mutex, INFINITE);
+}
+
+//------------------------------------------------------------------------------
+void grt_stack_delete(Stack_Type Stack)
+// Delete stack STACK, which must not be currently executed.
+// => procedure Stack_Delete (Stack : Stack_Type);
+{	INFO("grt_stack_delete\n");
+}
+
+//------------------------------------------------------------------------------
+void __gnat_raise_storage_error(void)
+{
+   abort ();
+}
+
+void __gnat_raise_program_error(void)
+{
+   abort ();
+}
+
+//------------------------------------------------------------------------------
+// end of file
+
diff --git a/translate/grt/ghdl_main.adb b/translate/grt/ghdl_main.adb
new file mode 100644
index 000000000..3ca98fb6b
--- /dev/null
+++ b/translate/grt/ghdl_main.adb
@@ -0,0 +1,51 @@
+--  GHDL Run Time (GRT) entry point.
+--  Copyright (C) 2002, 2003, 2004, 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 Ada.Unchecked_Conversion;
+with Grt.Options; use Grt.Options;
+with Grt.Main;
+with Grt.Types; use Grt.Types;
+
+pragma Warnings (Off);
+with Grt.Rtis_Binding;
+pragma Warnings (On);
+
+
+function Ghdl_Main (Argc : Integer; Argv : System.Address)
+                   return Integer
+is
+   --  Grt_Init corresponds to the 'adainit' subprogram for grt.
+   procedure Grt_Init;
+   pragma Import (C, Grt_Init, "grt_init");
+
+   function To_Argv_Type is new Ada.Unchecked_Conversion
+     (Source => System.Address, Target => Grt.Options.Argv_Type);
+
+   Default_Progname : constant String := "ghdl_design" & NUL;
+begin
+   if Argc > 0 then
+      Grt.Options.Progname := To_Argv_Type (Argv)(0);
+   else
+      Grt.Options.Progname := To_Ghdl_C_String (Default_Progname'Address);
+   end if;
+   Grt.Options.Argc := Argc;
+   Grt.Options.Argv := To_Argv_Type (Argv);
+
+   Grt_Init;
+   Grt.Main.Run;
+   return 0;
+end Ghdl_Main;
diff --git a/translate/grt/ghdl_main.ads b/translate/grt/ghdl_main.ads
new file mode 100644
index 000000000..a3636cb56
--- /dev/null
+++ b/translate/grt/ghdl_main.ads
@@ -0,0 +1,26 @@
+--  GHDL Run Time (GRT) entry point.
+--  Copyright (C) 2002, 2003, 2004, 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;
+
+--  'main' function for grt.
+--  Contrary to the C main function, ARGC can be 0 (in this case a fake argv[0]
+--  is used).
+function Ghdl_Main (Argc : Integer; Argv : System.Address)
+                   return Integer;
+pragma Export (C, Ghdl_Main, "ghdl_main");
+
diff --git a/translate/grt/ghwdump.c b/translate/grt/ghwdump.c
new file mode 100644
index 000000000..4affc2b5c
--- /dev/null
+++ b/translate/grt/ghwdump.c
@@ -0,0 +1,195 @@
+/*  Display a GHDL Wavefile for debugging.
+    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.
+*/
+
+#include <stdio.h>
+#include <stdint.h>
+#include <string.h>
+#include <stdlib.h>
+#include <unistd.h>
+
+#include "ghwlib.h"
+
+static const char *progname;
+void
+usage (void)
+{
+  printf ("usage: %s [OPTIONS] FILEs...\n", progname);
+  printf ("Options are:\n"
+	  " -t  display types\n"
+	  " -h  display hierarchy\n"
+	  " -T  display time\n"
+	  " -s  display signals (and time)\n"
+	  " -l  display list of sections\n"
+	  " -v  verbose\n");
+}
+
+int
+main (int argc, char **argv)
+{
+  int i;
+  int flag_disp_types;
+  int flag_disp_hierarchy;
+  int flag_disp_time;
+  int flag_disp_signals;
+  int flag_list;
+  int flag_verbose;
+  int eof;
+  enum ghw_sm_type sm;
+
+  progname = argv[0];
+  flag_disp_types = 0;
+  flag_disp_hierarchy = 0;
+  flag_disp_time = 0;
+  flag_disp_signals = 0;
+  flag_list = 0;
+  flag_verbose = 0;
+
+  while (1)
+    {
+      int c;
+
+      c = getopt (argc, argv, "thTslv");
+      if (c == -1)
+	break;
+      switch (c)
+	{
+	case 't':
+	  flag_disp_types = 1;
+	  break;
+	case 'h':
+	  flag_disp_hierarchy = 1;
+	  break;
+	case 'T':
+	  flag_disp_time = 1;
+	  break;
+	case 's':
+	  flag_disp_signals = 1;
+	  flag_disp_time = 1;
+	  break;
+	case 'l':
+	  flag_list = 1;
+	  break;
+	case 'v':
+	  flag_verbose++;
+	  break;
+	default:
+	  usage ();
+	  exit (2);
+	}
+    }
+
+  if (optind >= argc)
+    {
+      usage ();
+      return 1;
+    }
+
+  for (i = optind; i < argc; i++)
+    {
+      struct ghw_handler h;
+      struct ghw_handler *hp = &h;
+
+      hp->flag_verbose = flag_verbose;
+
+      if (ghw_open (hp, argv[i]) != 0)
+	{
+	  fprintf (stderr, "cannot open ghw file %s\n", argv[i]);
+	  return 1;
+	}
+      if (flag_list)
+	{
+	  while (1)
+	    {
+	      int section;
+
+	      section = ghw_read_section (hp);
+	      if (section == -2)
+		{
+		  printf ("eof of file\n");
+		  break;
+		}
+	      else if (section < 0)
+		{
+		  printf ("Error in file\n");
+		  break;
+		}
+	      else if (section == 0)
+		{
+		  printf ("Unknown section\n");
+		  break;
+		}
+	      printf ("Section %s\n", ghw_sections[section].name);
+	      if ((*ghw_sections[section].handler)(hp) < 0)
+		break;
+	    }
+	}
+      else
+	{
+	  if (ghw_read_base (hp) < 0)
+	    {
+	      fprintf (stderr, "cannot read ghw file\n");
+	      return 2;
+	    }
+	  if (0)
+	    {
+	      int i;
+	      printf ("String table:\n");
+	      
+	      for (i = 1; i < hp->nbr_str; i++)
+		printf (" %s\n", hp->str_table[i]);
+	    }
+	  if (flag_disp_types)
+	    ghw_disp_types (hp);
+	  if (flag_disp_hierarchy)
+	    ghw_disp_hie (hp, hp->hie);
+	  
+#if 1
+	  sm = ghw_sm_init;
+	  eof = 0;
+	  while (!eof)
+	    {
+	      switch (ghw_read_sm (hp, &sm))
+		{
+		case ghw_res_snapshot:
+		case ghw_res_cycle:
+		  if (flag_disp_time)
+		    printf ("Time is %lld fs\n", hp->snap_time);
+		  if (flag_disp_signals)
+		    ghw_disp_values (hp);
+		  break;
+		case ghw_res_eof:
+		  eof = 1;
+		  break;
+		default:
+		  abort ();
+		}
+	    }
+	  
+#else
+	  if (ghw_read_dump (hp) < 0)
+	    {
+	      fprintf (stderr, "error in ghw dump\n");
+	      return 3;
+	    }
+#endif
+	}
+      ghw_close (&h);
+    }
+  return 0;
+}
diff --git a/translate/grt/ghwlib.c b/translate/grt/ghwlib.c
new file mode 100644
index 000000000..827e69851
--- /dev/null
+++ b/translate/grt/ghwlib.c
@@ -0,0 +1,1717 @@
+/*  GHDL Wavefile reader library.
+    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.
+*/
+
+#include <stdio.h>
+#include <stdint.h>
+#include <string.h>
+#include <stdlib.h>
+#include <unistd.h>
+
+#include "ghwlib.h"
+
+int
+ghw_open (struct ghw_handler *h, const char *filename)
+{
+  char hdr[16];
+
+  h->stream = fopen (filename, "rb");
+  if (h->stream == NULL)
+    return -1;
+
+  if (fread (hdr, sizeof (hdr), 1, h->stream) != 1)
+    return -1;
+  /* Check magic.  */
+  if (memcmp (hdr, "GHDLwave\n", 9) != 0)
+    return -2;
+  /* Check version.  */
+  if (hdr[9] != 16
+      || hdr[10] != 0)
+    return -2;
+  h->version = hdr[11];
+  if (h->version > 1)
+    return -3;
+  if (hdr[12] == 1)
+    h->word_be = 0;
+  else if (hdr[12] == 2)
+    h->word_be = 1;
+  else
+    return -4;
+#if 0
+  /* Endianness.  */
+  {
+    int endian;
+    union { unsigned char b[4]; uint32_t i;} v;
+    v.i = 0x11223344;
+    if (v.b[0] == 0x11)
+      endian = 2;
+    else if (v.b[0] == 0x44)
+      endian = 1;
+    else
+      return -3;
+
+    if (hdr[12] != 1 && hdr[12] != 2)
+      return -3;
+    if (hdr[12] != endian)
+      h->swap_word = 1;
+    else
+      h->swap_word = 0;
+  }
+#endif
+  h->word_len = hdr[13];
+  h->off_len = hdr[14];
+
+  if (hdr[15] != 0)
+    return -5;
+
+  h->hie = NULL;
+  return 0;
+}
+
+int32_t
+ghw_get_i32 (struct ghw_handler *h, unsigned char *b)
+{
+  if (h->word_be)
+    return (b[0] << 24) | (b[1] << 16) | (b[2] << 8) | (b[3] << 0);
+  else
+    return (b[3] << 24) | (b[2] << 16) | (b[1] << 8) | (b[0] << 0);
+}
+
+int64_t
+ghw_get_i64 (struct ghw_handler *ghw_h, unsigned char *b)
+{
+  int l, h;
+
+  if (ghw_h->word_be)
+    {
+      h = (b[0] << 24) | (b[1] << 16) | (b[2] << 8) | (b[3] << 0);
+      l = (b[4] << 24) | (b[5] << 16) | (b[6] << 8) | (b[7] << 0);
+    }
+  else
+    {
+      l = (b[3] << 24) | (b[2] << 16) | (b[1] << 8) | (b[0] << 0);
+      h = (b[7] << 24) | (b[6] << 16) | (b[5] << 8) | (b[4] << 0);
+    }
+  return (((int64_t)h) << 32) | l;
+}
+
+int
+ghw_read_byte (struct ghw_handler *h, unsigned char *res)
+{
+  int v;
+
+  v = fgetc (h->stream);
+  if (v == EOF)
+    return -1;
+  *res = v;
+  return 0;
+}
+
+int
+ghw_read_uleb128 (struct ghw_handler *h, uint32_t *res)
+{
+  unsigned int r = 0;
+  unsigned int off = 0;
+
+  while (1)
+    {
+      int v = fgetc (h->stream);
+      if (v == EOF)
+	return -1;
+      r |= (v & 0x7f) << off;
+      if ((v & 0x80) == 0)
+	break;
+      off += 7;
+    }
+  *res = r;
+  return 0;
+}
+
+int
+ghw_read_sleb128 (struct ghw_handler *h, int32_t *res)
+{
+  int32_t r = 0;
+  unsigned int off = 0;
+
+  while (1)
+    {
+      int v = fgetc (h->stream);
+      if (v == EOF)
+	return -1;
+      r |= ((int32_t)(v & 0x7f)) << off;
+      off += 7;
+      if ((v & 0x80) == 0)
+	{
+	  if ((v & 0x40) && off < 32)
+	    r |= -1 << off;
+	  break;
+	}
+    }
+  *res = r;
+  return 0;
+}
+
+int
+ghw_read_lsleb128 (struct ghw_handler *h, int64_t *res)
+{
+  int64_t r = 0;
+  unsigned int off = 0;
+
+  while (1)
+    {
+      int v = fgetc (h->stream);
+      if (v == EOF)
+	return -1;
+      r |= ((int64_t)(v & 0x7f)) << off;
+      off += 7;
+      if ((v & 0x80) == 0)
+	{
+	  if ((v & 0x40) && off < 64)
+	    r |= __INT64_C (-1) << off;
+	  break;
+	}
+    }
+  *res = r;
+  return 0;
+}
+
+int
+ghw_read_f64 (struct ghw_handler *h, double *res)
+{
+  /* FIXME: handle byte order.  */
+  if (fread (res, sizeof (*res), 1, h->stream) != 1)
+    return -1;
+  return 0;
+}
+
+const char *
+ghw_read_strid (struct ghw_handler *h)
+{
+  unsigned int id;
+  if (ghw_read_uleb128 (h, &id) != 0)
+    return NULL;
+  return h->str_table[id];
+}
+
+union ghw_type *
+ghw_read_typeid (struct ghw_handler *h)
+{
+  unsigned int id;
+  if (ghw_read_uleb128 (h, &id) != 0)
+    return NULL;
+  return h->types[id - 1];
+}
+
+union ghw_range *
+ghw_read_range (struct ghw_handler *h)
+{
+  int t = fgetc (h->stream);
+  if (t == EOF)
+    return NULL;
+  switch (t & 0x7f)
+    {
+    case ghdl_rtik_type_e8:
+      {
+	struct ghw_range_e8 *r;
+	r = malloc (sizeof (struct ghw_range_e8));
+	r->kind = t & 0x7f;
+	r->dir = (t & 0x80) != 0;
+	if (ghw_read_byte (h, &r->left) != 0)
+	  return NULL;
+	if (ghw_read_byte (h, &r->right) != 0)
+	  return NULL;
+	return (union ghw_range *)r;
+      }
+    case ghdl_rtik_type_i32:
+    case ghdl_rtik_type_p32:
+      {
+	struct ghw_range_i32 *r;
+	r = malloc (sizeof (struct ghw_range_i32));
+	r->kind = t & 0x7f;
+	r->dir = (t & 0x80) != 0;
+	if (ghw_read_sleb128 (h, &r->left) != 0)
+	  return NULL;
+	if (ghw_read_sleb128 (h, &r->right) != 0)
+	  return NULL;
+	return (union ghw_range *)r;
+      }
+    case ghdl_rtik_type_i64:
+    case ghdl_rtik_type_p64:
+      {
+	struct ghw_range_i64 *r;
+	r = malloc (sizeof (struct ghw_range_i64));
+	r->kind = t & 0x7f;
+	r->dir = (t & 0x80) != 0;
+	if (ghw_read_lsleb128 (h, &r->left) != 0)
+	  return NULL;
+	if (ghw_read_lsleb128 (h, &r->right) != 0)
+	  return NULL;
+	return (union ghw_range *)r;
+      }
+    case ghdl_rtik_type_f64:
+      {
+	struct ghw_range_f64 *r;
+	r = malloc (sizeof (struct ghw_range_f64));
+	r->kind = t & 0x7f;
+	r->dir = (t & 0x80) != 0;
+	if (ghw_read_f64 (h, &r->left) != 0)
+	  return NULL;
+	if (ghw_read_f64 (h, &r->right) != 0)
+	  return NULL;
+	return (union ghw_range *)r;
+      }
+    default:
+      fprintf (stderr, "ghw_read_range: type %d unhandled\n", t & 0x7f);
+      return NULL;
+    }
+}
+
+int
+ghw_read_str (struct ghw_handler *h)
+{
+  char hdr[12];
+  int i;
+  char *p;
+  int prev_len;
+
+  if (fread (hdr, sizeof (hdr), 1, h->stream) != 1)
+    return -1;
+
+  if (hdr[0] != 0 || hdr[1] != 0 || hdr[2] != 0 || hdr[3] != 0)
+    return -1;
+  h->nbr_str = ghw_get_i32 (h, &hdr[4]);
+  h->nbr_str++;
+  h->str_size = ghw_get_i32 (h, &hdr[8]);
+  h->str_table = (char **)malloc ((h->nbr_str + 1) * sizeof (char *));
+  h->str_content = (char *)malloc (h->str_size + h->nbr_str + 1);
+
+  if (h->flag_verbose)
+    {
+      printf ("Number of strings: %d\n", h->nbr_str - 1);
+      printf ("String table size: %d\n", h->str_size);
+    }
+
+  h->str_table[0] = "<anon>";
+  p = h->str_content;
+  prev_len = 0;
+  for (i = 1; i < h->nbr_str; i++)
+    {
+      int j;
+      int c;
+      char *prev;
+      int sh;
+
+      h->str_table[i] = p;
+      prev = h->str_table[i - 1];
+      for (j = 0; j < prev_len; j++)
+	*p++ = prev[j];
+
+      while (1)
+	{
+	  c = fgetc (h->stream);
+	  if (c == EOF)
+	    return -1;
+	  if ((c >= 0 && c <= 31)
+	      || (c >= 128 && c <= 159))
+	    break;
+	  *p++ = c;
+	}
+      *p++ = 0;
+
+      if (h->flag_verbose > 1)
+	printf ("string %d (pl=%d): %s\n", i, prev_len, h->str_table[i]);
+
+      prev_len = c & 0x1f;
+      sh = 5;
+      while (c >= 128)
+	{
+	  c = fgetc (h->stream);
+	  if (c == EOF)
+	    return -1;
+	  prev_len |= (c & 0x1f) << sh;
+	  sh += 5;
+	}
+    }
+  if (fread (hdr, 4, 1, h->stream) != 1)
+    return -1;
+  if (memcmp (hdr, "EOS", 4) != 0)
+    return -1;
+  return 0;
+}
+
+union ghw_type *
+ghw_get_base_type (union ghw_type *t)
+{
+  switch (t->kind)
+    {
+    case ghdl_rtik_type_b2:
+    case ghdl_rtik_type_e8:
+    case ghdl_rtik_type_e32:
+    case ghdl_rtik_type_i32:
+    case ghdl_rtik_type_i64:
+    case ghdl_rtik_type_f64:
+    case ghdl_rtik_type_p32:
+    case ghdl_rtik_type_p64:
+      return t;
+    case ghdl_rtik_subtype_scalar:
+      return t->ss.base;
+    case ghdl_rtik_subtype_array:
+      return (union ghw_type*)(t->sa.base);
+    default:
+      fprintf (stderr, "ghw_get_base_type: cannot handle type %d\n", t->kind);
+      abort ();
+    }
+}
+
+int
+get_nbr_elements (union ghw_type *t)
+{
+  switch (t->kind)
+    {
+    case ghdl_rtik_type_b2:
+    case ghdl_rtik_type_e8:
+    case ghdl_rtik_type_e32:
+    case ghdl_rtik_type_i32:
+    case ghdl_rtik_type_i64:
+    case ghdl_rtik_type_f64:
+    case ghdl_rtik_type_p32:
+    case ghdl_rtik_type_p64:
+    case ghdl_rtik_subtype_scalar:
+      return 1;
+    case ghdl_rtik_subtype_array:
+    case ghdl_rtik_subtype_array_ptr:
+      return t->sa.nbr_el;
+    case ghdl_rtik_type_record:
+      return t->rec.nbr_el;
+    default:
+      fprintf (stderr, "get_nbr_elements: unhandled type %d\n", t->kind);
+      abort ();
+    }
+}
+
+int
+get_range_length (union ghw_range *rng)
+{
+  switch (rng->kind)
+    {
+    case ghdl_rtik_type_i32:
+      if (rng->i32.dir)
+	return (rng->i32.left - rng->i32.right + 1);
+      else
+	return (rng->i32.right - rng->i32.left + 1);
+    default:
+      fprintf (stderr, "get_range_length: unhandled kind %d\n", rng->kind);
+      abort ();
+    }
+}
+
+int
+ghw_read_type (struct ghw_handler *h)
+{
+  char hdr[8];
+  int i;
+
+  if (fread (hdr, sizeof (hdr), 1, h->stream) != 1)
+    return -1;
+
+  if (hdr[0] != 0 || hdr[1] != 0 || hdr[2] != 0 || hdr[3] != 0)
+    return -1;
+  h->nbr_types = ghw_get_i32 (h, &hdr[4]);
+  h->types = (union ghw_type **)
+    malloc (h->nbr_types * sizeof (union ghw_type *));
+
+  for (i = 0; i < h->nbr_types; i++)
+    {
+      int t;
+
+      t = fgetc (h->stream);
+      if (t == EOF)
+	return -1;
+      /* printf ("type[%d]= %d\n", i, t); */
+      switch (t)
+	{
+	case ghdl_rtik_type_b2:
+	case ghdl_rtik_type_e8:
+	  {
+	    struct ghw_type_enum *e;
+	    int j;
+
+	    e = malloc (sizeof (struct ghw_type_enum));
+	    e->kind = t;
+	    e->wkt = ghw_wkt_unknown;
+	    e->name = ghw_read_strid (h);
+	    if (ghw_read_uleb128 (h, &e->nbr) != 0)
+	      return -1;
+	    e->lits = (const char **) malloc (e->nbr * sizeof (char *));
+	    if (h->flag_verbose > 1)
+	      printf ("enum %s:", e->name);
+	    for (j = 0; j < e->nbr; j++)
+	      {
+		e->lits[j] = ghw_read_strid (h);
+		if (h->flag_verbose > 1)
+		  printf (" %s", e->lits[j]);
+	      }
+	    if (h->flag_verbose > 1)
+	      printf ("\n");
+	    h->types[i] = (union ghw_type *)e;
+	  }
+	  break;
+	case ghdl_rtik_type_i32:
+	case ghdl_rtik_type_i64:
+	case ghdl_rtik_type_f64:
+	  {
+	    struct ghw_type_scalar *sc;
+
+	    sc = malloc (sizeof (struct ghw_type_scalar));
+	    sc->kind = t;
+	    sc->name = ghw_read_strid (h);
+	    if (h->flag_verbose > 1)
+	      printf ("scalar: %s\n", sc->name);
+	    h->types[i] = (union ghw_type *)sc;
+	  }
+	  break;
+	case ghdl_rtik_type_p32:
+	case ghdl_rtik_type_p64:
+	  {
+	    struct ghw_type_physical *ph;
+
+	    ph = malloc (sizeof (struct ghw_type_physical));
+	    ph->kind = t;
+	    ph->name = ghw_read_strid (h);
+	    if (h->version == 0)
+	      ph->nbr_units = 0;
+	    else
+	      {
+		int i;
+
+		if (ghw_read_uleb128 (h, &ph->nbr_units) != 0)
+		  return -1;
+		ph->units = malloc (ph->nbr_units * sizeof (struct ghw_unit));
+		for (i = 0; i < ph->nbr_units; i++)
+		  {
+		    ph->units[i].name = ghw_read_strid (h);
+		    if (ghw_read_lsleb128 (h, &ph->units[i].val) < 0)
+		      return -1;
+		  }
+	      }
+	    if (h->flag_verbose > 1)
+	      printf ("physical: %s\n", ph->name);
+	    h->types[i] = (union ghw_type *)ph;
+	  }
+	  break;
+	case ghdl_rtik_subtype_scalar:
+	  {
+	    struct ghw_subtype_scalar *ss;
+
+	    ss = malloc (sizeof (struct ghw_subtype_scalar));
+	    ss->kind = t;
+	    ss->name = ghw_read_strid (h);
+	    ss->base = ghw_read_typeid (h);
+	    ss->rng = ghw_read_range (h);
+	    if (h->flag_verbose > 1)
+	      printf ("subtype scalar: %s\n", ss->name);
+	    h->types[i] = (union ghw_type *)ss;
+	  }
+	  break;
+	case ghdl_rtik_type_array:
+	  {
+	    struct ghw_type_array *arr;
+	    int j;
+
+	    arr = malloc (sizeof (struct ghw_type_array));
+	    arr->kind = t;
+	    arr->name = ghw_read_strid (h);
+	    arr->el = ghw_read_typeid (h);
+	    if (ghw_read_uleb128 (h, &arr->nbr_dim) != 0)
+	      return -1;
+	    arr->dims = (union ghw_type **)
+	      malloc (arr->nbr_dim * sizeof (union ghw_type *));
+	    for (j = 0; j < arr->nbr_dim; j++)
+	      arr->dims[j] = ghw_read_typeid (h);
+	    if (h->flag_verbose > 1)
+	      printf ("array: %s\n", arr->name);
+	    h->types[i] = (union ghw_type *)arr;
+	  }
+	  break;
+	case ghdl_rtik_subtype_array:
+	case ghdl_rtik_subtype_array_ptr:
+	  {
+	    struct ghw_subtype_array *sa;
+	    int j;
+	    int nbr_el;
+
+	    sa = malloc (sizeof (struct ghw_subtype_array));
+	    sa->kind = t;
+	    sa->name = ghw_read_strid (h);
+	    sa->base = (struct ghw_type_array *)ghw_read_typeid (h);
+	    nbr_el = get_nbr_elements (sa->base->el);
+	    sa->rngs = malloc (sa->base->nbr_dim * sizeof (union ghw_range *));
+	    for (j = 0; j < sa->base->nbr_dim; j++)
+	      {
+		sa->rngs[j] = ghw_read_range (h);
+		nbr_el *= get_range_length (sa->rngs[j]);
+	      }
+	    sa->nbr_el = nbr_el;
+	    if (h->flag_verbose > 1)
+	      printf ("subtype array: %s (nbr_el=%d)\n", sa->name, sa->nbr_el);
+	    h->types[i] = (union ghw_type *)sa;
+	  }
+	  break;
+	case ghdl_rtik_type_record:
+	  {
+	    struct ghw_type_record *rec;
+	    int j;
+	    int nbr_el;
+
+	    rec = malloc (sizeof (struct ghw_type_record));
+	    rec->kind = t;
+	    rec->name = ghw_read_strid (h);
+	    if (ghw_read_uleb128 (h, &rec->nbr_fields) != 0)
+	      return -1;
+	    rec->el = malloc
+	      (rec->nbr_fields * sizeof (struct ghw_record_element));
+	    nbr_el = 0;
+	    for (j = 0; j < rec->nbr_fields; j++)
+	      {
+		rec->el[j].name = ghw_read_strid (h);
+		rec->el[j].type = ghw_read_typeid (h);
+		nbr_el += get_nbr_elements (rec->el[j].type);
+	      }
+	    rec->nbr_el = nbr_el;
+	    if (h->flag_verbose > 1)
+	      printf ("record type: %s (nbr_el=%d)\n", rec->name, rec->nbr_el);
+	    h->types[i] = (union ghw_type *)rec;
+	  }
+	  break;
+	default:
+	  fprintf (stderr, "ghw_read_type: unknown type %d\n", t);
+	  return -1;
+	}
+    }
+  if (fgetc (h->stream) != 0)
+    return -1;
+  return 0;
+}
+
+int
+ghw_read_wk_types (struct ghw_handler *h)
+{
+  char hdr[4];
+
+  if (fread (hdr, sizeof (hdr), 1, h->stream) != 1)
+    return -1;
+
+  if (hdr[0] != 0 || hdr[1] != 0 || hdr[2] != 0 || hdr[3] != 0)
+    return -1;
+
+  while (1)
+    {
+      int t;
+      union ghw_type *tid;
+
+      t = fgetc (h->stream);
+      if (t == EOF)
+	return -1;
+      else if (t == 0)
+	break;
+
+      tid = ghw_read_typeid (h);
+      if (tid->kind == ghdl_rtik_type_b2
+	  || tid->kind == ghdl_rtik_type_e8)
+	{
+	  if (h->flag_verbose > 0)
+	    printf ("%s: wkt=%d\n", tid->en.name, t);
+	  tid->en.wkt = t;
+	}
+    }
+  return 0;
+}
+
+void
+ghw_disp_typename (struct ghw_handler *h, union ghw_type *t)
+{
+  printf ("%s", t->common.name);
+}
+
+/* Read a signal composed of severals elements.  */
+int
+ghw_read_signal (struct ghw_handler *h, unsigned int *sigs, union ghw_type *t)
+{
+  switch (t->kind)
+    {
+    case ghdl_rtik_type_b2:
+    case ghdl_rtik_type_e8:
+    case ghdl_rtik_type_e32:
+    case ghdl_rtik_subtype_scalar:
+      {
+	unsigned int sig_el;
+
+	if (ghw_read_uleb128 (h, &sig_el) < 0)
+	  return -1;
+	*sigs = sig_el;
+	if (sig_el >= h->nbr_sigs)
+	  abort ();
+	if (h->sigs[sig_el].type == NULL)
+	  h->sigs[sig_el].type = ghw_get_base_type (t);
+      }
+      return 0;
+    case ghdl_rtik_subtype_array:
+    case ghdl_rtik_subtype_array_ptr:
+      {
+	int i;
+	int stride;
+	int len;
+
+	len = t->sa.nbr_el;
+	stride = get_nbr_elements (t->sa.base->el);
+
+	for (i = 0; i < len; i += stride)
+	  if (ghw_read_signal (h, &sigs[i], t->sa.base->el) < 0)
+	    return -1;
+      }
+      return 0;
+    case ghdl_rtik_type_record:
+      {
+	int i;
+	int off;
+	
+	off = 0;
+	for (i = 0; i < t->rec.nbr_fields; i++)
+	  {
+	    if (ghw_read_signal (h, &sigs[off], t->rec.el[i].type) < 0)
+	      return -1;
+	    off += get_nbr_elements (t->rec.el[i].type);
+	  }
+      }
+      return 0;
+    default:
+      fprintf (stderr, "ghw_read_signal: type kind %d unhandled\n", t->kind);
+      abort ();
+    }
+}
+
+
+int
+ghw_read_value (struct ghw_handler *h,
+		union ghw_val *val, union ghw_type *type)
+{
+  switch (ghw_get_base_type (type)->kind)
+    {
+    case ghdl_rtik_type_b2:
+      {
+	int v;
+	v = fgetc (h->stream);
+	if (v == EOF)
+	  return -1;
+	val->b2 = v;
+      }
+      break;
+    case ghdl_rtik_type_e8:
+      {
+	int v;
+	v = fgetc (h->stream);
+	if (v == EOF)
+	  return -1;
+	val->e8 = v;
+      }
+      break;
+    case ghdl_rtik_type_i32:
+    case ghdl_rtik_type_p32:
+      {
+	int32_t v;
+	if (ghw_read_sleb128 (h, &v) < 0)
+	  return -1;
+	val->i32 = v;
+      }
+      break;
+    case ghdl_rtik_type_f64:
+      {
+	double v;
+	if (ghw_read_f64 (h, &v) < 0)
+	  return -1;
+	val->f64 = v;
+      }
+      break;
+    case ghdl_rtik_type_p64:
+      {
+	int64_t v;
+	if (ghw_read_lsleb128 (h, &v) < 0)
+	  return -1;
+	val->i64 = v;
+      }
+      break;
+    default:
+      fprintf (stderr, "read_value: cannot handle format %d\n", type->kind);
+      abort ();
+    }
+  return 0;
+}
+
+int
+ghw_read_hie (struct ghw_handler *h)
+{
+  char hdr[16];
+  int nbr_scopes;
+  int nbr_sigs;
+  int i;
+  struct ghw_hie *blk;
+  struct ghw_hie **last;
+
+  if (fread (hdr, sizeof (hdr), 1, h->stream) != 1)
+    return -1;
+
+  if (hdr[0] != 0 || hdr[1] != 0 || hdr[2] != 0 || hdr[3] != 0)
+    return -1;
+  nbr_scopes = ghw_get_i32 (h, &hdr[4]);
+  /* Number of declared signals (which may be composite).  */
+  nbr_sigs = ghw_get_i32 (h, &hdr[8]);
+  /* Number of basic signals.  */
+  h->nbr_sigs = ghw_get_i32 (h, &hdr[12]);
+
+  blk = (struct ghw_hie *)malloc (sizeof (struct ghw_hie));
+  blk->kind = ghw_hie_design;
+  blk->name = NULL;
+  blk->parent = NULL;
+  blk->brother = NULL;
+  blk->u.blk.child = NULL;
+
+  last = &blk->u.blk.child;
+  h->hie = blk;
+
+  h->nbr_sigs++;
+  h->sigs = (struct ghw_sig *) malloc (h->nbr_sigs * sizeof (struct ghw_sig));
+  memset (h->sigs, 0, h->nbr_sigs * sizeof (struct ghw_sig));
+
+  while (1)
+    {
+      int t;
+      struct ghw_hie *el;
+      unsigned int str;
+
+      t = fgetc (h->stream);
+      if (t == EOF)
+	return -1;
+      if (t == 0)
+	break;
+
+      if (t == ghw_hie_eos)
+	{
+	  blk = blk->parent;
+	  if (blk->u.blk.child == NULL)
+	    last = &blk->u.blk.child;
+	  else
+	    {
+	      struct ghw_hie *l = blk->u.blk.child;
+	      while (l->brother != NULL)
+		l = l->brother;
+	      last = &l->brother;
+	    }
+
+	  continue;
+	}
+
+      el = (struct ghw_hie *) malloc (sizeof (struct ghw_hie));
+      el->kind = t;
+      el->parent = blk;
+      el->brother = NULL;
+
+      /* Link.  */
+      *last = el;
+      last = &el->brother;
+
+      /* Read name.  */
+      if (ghw_read_uleb128 (h, &str) != 0)
+	return -1;
+      el->name = h->str_table[str];
+
+      switch (t)
+	{
+	case ghw_hie_eoh:
+	case ghw_hie_design:
+	case ghw_hie_eos:
+	  /* Should not be here.  */
+	  abort ();
+	case ghw_hie_process:
+	  break;
+	case ghw_hie_block:
+	case ghw_hie_generate_if:
+	case ghw_hie_generate_for:
+	case ghw_hie_instance:
+	case ghw_hie_generic:
+	  /* Create a block.  */
+	  el->u.blk.child = NULL;
+
+	  if (t == ghw_hie_generate_for)
+	    {
+	      el->u.blk.iter_type = ghw_read_typeid (h);
+	      el->u.blk.iter_value = malloc (sizeof (union ghw_val));
+	      if (ghw_read_value (h, el->u.blk.iter_value,
+				  el->u.blk.iter_type) < 0)
+		return -1;
+	    }
+	  blk = el;
+	  last = &el->u.blk.child;
+	  break;
+	case ghw_hie_signal:
+	case ghw_hie_port_in:
+	case ghw_hie_port_out:
+	case ghw_hie_port_inout:
+	case ghw_hie_port_buffer:
+	case ghw_hie_port_linkage:
+	  /* For a signal, read type.  */
+	  {
+	    int nbr_el;
+	    unsigned int *sigs;
+
+	    el->u.sig.type = ghw_read_typeid (h);
+	    nbr_el = get_nbr_elements (el->u.sig.type);
+	    sigs = (unsigned int *) malloc
+	      ((nbr_el + 1) * sizeof (unsigned int));
+	    el->u.sig.sigs = sigs;
+	    /* Last element is NULL.  */
+	    sigs[nbr_el] = 0;
+
+	    if (h->flag_verbose > 1)
+	      printf ("signal %s: %d el\n", el->name, nbr_el);
+	    if (ghw_read_signal (h, sigs, el->u.sig.type) < 0)
+	      return -1;
+#if 0
+	    for (i = 0; i < nbr_el; i++)
+	      {
+		unsigned int sig_el;
+
+		if (ghw_read_uleb128 (h, &sig_el) < 0)
+		  return -1;
+		sigs[i] = sig_el;
+		if (sig_el >= h->nbr_sigs)
+		  abort ();
+		if (h->sigs[sig_el].type == NULL)
+		  {
+		    h->sigs[sig_el].type = ghw_get_base_type (el->u.sig.type);
+		  }
+	      }
+	    sigs[i] = 0;
+#endif
+	  }
+	  break;
+	default:
+	  fprintf (stderr, "ghw_read_hie: unhandled kind %d\n", t);
+	  abort ();
+	}
+    }
+
+  /* Allocate values.  */
+  for (i = 0; i < h->nbr_sigs; i++)
+    if (h->sigs[i].type != NULL)
+      h->sigs[i].val = (union ghw_val *) malloc (sizeof (union ghw_val));
+  return 0;
+}
+
+const char *
+ghw_get_hie_name (struct ghw_hie *h)
+{
+  switch (h->kind)
+    {
+    case ghw_hie_eoh:
+      return "eoh";
+    case ghw_hie_design:
+      return "design";
+    case ghw_hie_block:
+      return "block";
+    case ghw_hie_generate_if:
+      return "generate-if";
+    case ghw_hie_generate_for:
+      return "generate-for";
+    case ghw_hie_instance:
+      return "instance";
+    case ghw_hie_process:
+      return "process";
+    case ghw_hie_generic:
+      return "generic";
+    case ghw_hie_eos:
+      return "eos";
+    case ghw_hie_signal:
+      return "signal";
+    case ghw_hie_port_in:
+      return "port-in";
+    case ghw_hie_port_out:
+      return "port-out";
+    case ghw_hie_port_inout:
+      return "port-inout";
+    case ghw_hie_port_buffer:
+      return "port-buffer";
+    case ghw_hie_port_linkage:
+      return "port-linkage";
+    default:
+      return "??";
+    }
+}
+
+void
+ghw_disp_value (union ghw_val *val, union ghw_type *type);
+
+void
+ghw_disp_hie (struct ghw_handler *h, struct ghw_hie *top)
+{
+  int i;
+  int indent;
+  struct ghw_hie *hie;
+  struct ghw_hie *n;
+
+  hie = top;
+  indent = 0;
+  
+  while (1)
+    {
+      for (i = 0; i < indent; i++)
+	fputc (' ', stdout);
+      printf ("%s", ghw_get_hie_name (hie));
+
+      switch (hie->kind)
+	{
+	case ghw_hie_design:
+	case ghw_hie_block:
+	case ghw_hie_generate_if:
+	case ghw_hie_generate_for:
+	case ghw_hie_instance:
+	case ghw_hie_process:
+	  if (hie->name)
+	    printf (" %s", hie->name);
+	  if (hie->kind == ghw_hie_generate_for)
+	    {
+	      printf ("(");
+	      ghw_disp_value (hie->u.blk.iter_value, hie->u.blk.iter_type);
+	      printf (")");
+	    }
+	  n = hie->u.blk.child;
+	  if (n == NULL)
+	    n = hie->brother;
+	  else
+	    indent++;
+	  break;
+	case ghw_hie_generic:
+	case ghw_hie_eos:
+	  abort ();
+	case ghw_hie_signal:
+	case ghw_hie_port_in:
+	case ghw_hie_port_out:
+	case ghw_hie_port_inout:
+	case ghw_hie_port_buffer:
+	case ghw_hie_port_linkage:
+	  {
+	    unsigned int *sigs;
+
+	    printf (" %s: ", hie->name);
+	    ghw_disp_typename (h, hie->u.sig.type);
+	    for (sigs = hie->u.sig.sigs; *sigs != 0; sigs++)
+	      printf (" #%u", *sigs);
+	    n = hie->brother;
+	  }
+	  break;
+	default:
+	  abort ();
+	}
+      printf ("\n");
+
+      while (n == NULL)
+	{
+	  if (hie->parent == NULL)
+	    return;
+	  hie = hie->parent;
+	  indent--;
+	  n = hie->brother;
+	}
+      hie = n;
+    }
+}
+
+int
+ghw_read_eoh (struct ghw_handler *h)
+{
+  return 0;
+}
+
+
+int
+ghw_read_base (struct ghw_handler *h)
+{
+  unsigned char hdr[4];
+  int res;
+
+  while (1)
+    {
+      if (fread (hdr, sizeof (hdr), 1, h->stream) != 1)
+	return -1;
+      if (memcmp (hdr, "STR", 4) == 0)
+	res = ghw_read_str (h);
+      else if (memcmp (hdr, "HIE", 4) == 0)
+	res = ghw_read_hie (h);
+      else if (memcmp (hdr, "TYP", 4) == 0)
+	res = ghw_read_type (h);
+      else if (memcmp (hdr, "WKT", 4) == 0)
+	res = ghw_read_wk_types (h);
+      else if (memcmp (hdr, "EOH", 4) == 0)
+	return 0;
+      else
+	{
+	  fprintf (stderr, "ghw_read_base: unknown GHW section %c%c%c%c\n",
+		   hdr[0], hdr[1], hdr[2], hdr[3]);
+	  return -1;
+	}
+      if (res != 0)
+	{
+	  fprintf (stderr, "ghw_read_base: error in section %s\n", hdr);
+	  return res;
+	}
+    }
+}
+
+int
+ghw_read_signal_value (struct ghw_handler *h, struct ghw_sig *s)
+{
+  return ghw_read_value (h, s->val, s->type);
+}
+
+int
+ghw_read_snapshot (struct ghw_handler *h)
+{
+  char hdr[12];
+  int i;
+  struct ghw_sig *s;
+
+  if (fread (hdr, sizeof (hdr), 1, h->stream) != 1)
+    return -1;
+
+  if (hdr[0] != 0 || hdr[1] != 0 || hdr[2] != 0 || hdr[3] != 0)
+    return -1;
+  h->snap_time = ghw_get_i64 (h, &hdr[4]);
+  if (h->flag_verbose > 1)
+    printf ("Time is %lld fs\n", h->snap_time);
+
+  for (i = 0; i < h->nbr_sigs; i++)
+    {
+      s = &h->sigs[i];
+      if (s->type != NULL)
+	{
+	  if (h->flag_verbose > 1)
+	    printf ("read type %d for sig %d\n", s->type->kind, i);
+	  if (ghw_read_signal_value (h, s) < 0)
+	    return -1;
+	}
+    }
+  if (fread (hdr, 4, 1, h->stream) != 1)
+    return -1;
+
+  if (memcmp (hdr, "ESN", 4))
+    return -1;
+
+  return 0;
+}
+
+void ghw_disp_values (struct ghw_handler *h);
+
+int
+ghw_read_cycle_start (struct ghw_handler *h)
+{
+  char hdr[8];
+
+  if (fread (hdr, sizeof (hdr), 1, h->stream) != 1)
+    return -1;
+
+  h->snap_time = ghw_get_i64 (h, hdr);
+  return 0;
+}
+
+int
+ghw_read_cycle_cont (struct ghw_handler *h, int *list)
+{
+  int i;
+  int *list_p;
+
+  i = 0;
+  list_p = list;
+  while (1)
+    {
+      int32_t d;
+      
+      /* Read delta to next signal.  */
+      if (ghw_read_sleb128 (h, &d) < 0)
+	return -1;
+      if (d == 0)
+	{
+	  /* Last signal reached.  */
+	  break;
+	}
+
+      /* Find next signal.  */
+      while (d > 0)
+	{
+	  i++;
+	  if (h->sigs[i].type != NULL)
+	    d--;
+	}
+      
+      if (ghw_read_signal_value (h, &h->sigs[i]) < 0)
+	return -1;
+      if (list_p)
+	*list_p++ = i;
+    }
+  
+  if (list_p)
+    *list_p = 0;
+  return 0;
+}
+
+int
+ghw_read_cycle_next (struct ghw_handler *h)
+{
+  int64_t d_time;
+
+  if (ghw_read_lsleb128 (h, &d_time) < 0)
+    return -1;
+  if (d_time == -1)
+    return 0;
+  h->snap_time += d_time;
+  return 1;
+}
+
+
+int
+ghw_read_cycle_end (struct ghw_handler *h)
+{
+  char hdr[4];
+
+  if (fread (hdr, sizeof (hdr), 1, h->stream) != 1)
+    return -1;
+  if (memcmp (hdr, "ECY", 4))
+    return -1;
+
+  return 0;
+}
+
+void
+ghw_disp_value (union ghw_val *val, union ghw_type *type)
+{
+  switch (ghw_get_base_type (type)->kind)
+    {
+    case ghdl_rtik_type_b2:
+      printf ("%s (%d)", type->en.lits[val->b2], val->b2);
+      break;
+    case ghdl_rtik_type_e8:
+      printf ("%s (%d)", type->en.lits[val->e8], val->e8);
+      break;
+    case ghdl_rtik_type_i32:
+      printf ("%d", val->i32);
+      break;
+    case ghdl_rtik_type_p64:
+      printf ("%lld", val->i64);
+      break;
+    case ghdl_rtik_type_f64:
+      printf ("%g", val->f64);
+      break;
+    default:
+      fprintf (stderr, "ghw_disp_value: cannot handle type %d\n",
+	       type->kind);
+      abort ();
+    }
+}
+
+/* Put the ASCII representation of VAL into BUF, whose size if LEN.
+   A NUL is always written to BUF.
+*/
+void
+ghw_get_value (char *buf, int len, union ghw_val *val, union ghw_type *type)
+{
+  switch (ghw_get_base_type (type)->kind)
+    {
+    case ghdl_rtik_type_b2:
+      if (val->b2 <= 1)
+	{
+	  strncpy (buf, type->en.lits[val->b2], len - 1);
+	  buf[len - 1] = 0;
+	}
+      else
+	{
+	  snprintf (buf, len, "?%d", val->b2);
+	}
+      break;
+    case ghdl_rtik_type_e8:
+      if (val->b2 <= type->en.nbr)
+	{
+	  strncpy (buf, type->en.lits[val->e8], len - 1);
+	  buf[len - 1] = 0;
+	}
+      else
+	{
+	  snprintf (buf, len, "?%d", val->e8);
+	}
+      break;
+    case ghdl_rtik_type_i32:
+      snprintf (buf, len, "%d", val->i32);
+      break;
+    case ghdl_rtik_type_p64:
+      snprintf (buf, len, "%lld", val->i64);
+      break;
+    case ghdl_rtik_type_f64:
+      snprintf (buf, len, "%g", val->f64);
+      break;
+    default:
+      snprintf (buf, len, "?bad type %d?", type->kind);
+    }
+}
+
+void
+ghw_disp_values (struct ghw_handler *h)
+{
+  int i;
+
+  for (i = 0; i < h->nbr_sigs; i++)
+    {
+      struct ghw_sig *s = &h->sigs[i];
+      if (s->type != NULL)
+	{
+	  printf ("#%d: ", i);
+	  ghw_disp_value (s->val, s->type);
+	  printf ("\n");
+	}
+    }
+}
+
+int
+ghw_read_directory (struct ghw_handler *h)
+{
+  unsigned char hdr[8];
+  int nbr_entries;
+  int i;
+
+  if (fread (hdr, sizeof (hdr), 1, h->stream) != 1)
+    return -1;
+
+  nbr_entries = ghw_get_i32 (h, &hdr[4]);
+  
+  if (h->flag_verbose)
+    printf ("Directory (%d entries):\n", nbr_entries);
+
+  for (i = 0; i < nbr_entries; i++)
+    {
+      unsigned char ent[8];
+      int pos;
+
+      if (fread (ent, sizeof (ent), 1, h->stream) != 1)
+	return -1;
+
+      pos = ghw_get_i32 (h, &ent[4]);
+      if (h->flag_verbose)
+	printf (" %s at %d\n", ent, pos);
+    }
+
+  if (fread (hdr, 4, 1, h->stream) != 1)
+    return -1;
+  if (memcmp (hdr, "EOD", 4))
+    return -1;
+  return 0;
+}
+
+int
+ghw_read_tailer (struct ghw_handler *h)
+{
+  unsigned char hdr[8];
+  int pos;
+
+  if (fread (hdr, sizeof (hdr), 1, h->stream) != 1)
+    return -1;
+
+  pos = ghw_get_i32 (h, &hdr[4]);
+  
+  if (h->flag_verbose)
+    printf ("Tailer: directory at %d\n", pos);
+  return 0;
+}
+
+enum ghw_res
+ghw_read_sm_hdr (struct ghw_handler *h, int *list)
+{
+  unsigned char hdr[4];
+  int res;
+
+  if (fread (hdr, sizeof (hdr), 1, h->stream) != 1)
+    {
+      if (feof (h->stream))
+	return ghw_res_eof;
+      else
+	return ghw_res_error;
+    }
+  if (memcmp (hdr, "SNP", 4) == 0)
+    {
+      res = ghw_read_snapshot (h);
+      if (res < 0)
+	return res;
+      return ghw_res_snapshot;
+    }
+  else if (memcmp (hdr, "CYC", 4) == 0)
+    {
+      res = ghw_read_cycle_start (h);
+      if (res < 0)
+	return res;
+      res = ghw_read_cycle_cont (h, list);
+      if (res < 0)
+	return res;
+      
+      return ghw_res_cycle;
+    }
+  else if (memcmp (hdr, "DIR", 4) == 0)
+    {
+      res = ghw_read_directory (h);
+    }
+  else if (memcmp (hdr, "TAI", 4) == 0)
+    {
+      res = ghw_read_tailer (h);
+    }
+  else 
+    {
+      fprintf (stderr, "unknown GHW section %c%c%c%c\n",
+	       hdr[0], hdr[1], hdr[2], hdr[3]);
+      return -1;
+    }
+  if (res != 0)
+    return res;
+  return ghw_res_other;
+}
+
+int
+ghw_read_sm (struct ghw_handler *h, enum ghw_sm_type *sm)
+{
+  int res;
+
+  while (1)
+    {
+      /* printf ("sm: state = %d\n", *sm); */
+      switch (*sm)
+	{
+	case ghw_sm_init:
+	case ghw_sm_sect:
+	  res = ghw_read_sm_hdr (h, NULL);
+	  switch (res)
+	    {
+	    case ghw_res_other:
+	      break;
+	    case ghw_res_snapshot:
+	      *sm = ghw_sm_sect;
+	      return res;
+	    case ghw_res_cycle:
+	      *sm = ghw_sm_cycle;
+	      return res;
+	    default:
+	      return res;
+	    }
+	  break;
+	case ghw_sm_cycle:
+	  if (0)
+	    printf ("Time is %lld fs\n", h->snap_time);
+	  if (0)
+	    ghw_disp_values (h);
+	  
+	  res = ghw_read_cycle_next (h);
+	  if (res < 0)
+	    return res;
+	  if (res == 1)
+	    {
+	      res = ghw_read_cycle_cont (h, NULL);
+	      if (res < 0)
+		return res;
+	      return ghw_res_cycle;
+	    }
+	  res = ghw_read_cycle_end (h);
+	  if (res < 0)
+	    return res;
+	  *sm = ghw_sm_sect;
+	  break;
+	}
+    }
+}
+
+int
+ghw_read_cycle (struct ghw_handler *h)
+{
+  int res;
+
+  res = ghw_read_cycle_start (h);
+  if (res < 0)
+    return res;
+  while (1)
+    {
+      res = ghw_read_cycle_cont (h, NULL);
+      if (res < 0)
+	return res;
+      
+      if (0)
+	printf ("Time is %lld fs\n", h->snap_time);
+      if (0)
+	ghw_disp_values (h);
+      
+	      
+      res = ghw_read_cycle_next (h);
+      if (res < 0)
+	return res;
+      if (res == 0)
+	break;
+    }
+  res = ghw_read_cycle_end (h);
+  return res;
+}
+
+int
+ghw_read_dump (struct ghw_handler *h)
+{
+  unsigned char hdr[4];
+  int res;
+
+  while (1)
+    {
+      if (fread (hdr, sizeof (hdr), 1, h->stream) != 1)
+	{
+	  if (feof (h->stream))
+	    return 0;
+	  else
+	    return -1;
+	}
+      if (memcmp (hdr, "SNP", 4) == 0)
+	{
+	  res = ghw_read_snapshot (h);
+	  if (0 && res >= 0)
+	    ghw_disp_values (h);
+	}
+      else if (memcmp (hdr, "CYC", 4) == 0)
+	{
+	  res = ghw_read_cycle (h);
+	}
+      else if (memcmp (hdr, "DIR", 4) == 0)
+	{
+	  res = ghw_read_directory (h);
+	}
+      else if (memcmp (hdr, "TAI", 4) == 0)
+	{
+	  res = ghw_read_tailer (h);
+	}
+      else 
+	{
+	  fprintf (stderr, "unknown GHW section %c%c%c%c\n",
+		   hdr[0], hdr[1], hdr[2], hdr[3]);
+	  return -1;
+	}
+      if (res != 0)
+	return res;
+    }
+}
+
+struct ghw_section ghw_sections[] = {
+  { "\0\0\0", NULL },
+  { "STR", ghw_read_str },
+  { "HIE", ghw_read_hie },
+  { "TYP", ghw_read_type },
+  { "WKT", ghw_read_wk_types },
+  { "EOH", ghw_read_eoh },
+  { "SNP", ghw_read_snapshot },
+  { "CYC", ghw_read_cycle },
+  { "DIR", ghw_read_directory },
+  { "TAI", ghw_read_tailer }
+};
+
+int
+ghw_read_section (struct ghw_handler *h)
+{
+  unsigned char hdr[4];
+  int i;
+
+  if (fread (hdr, sizeof (hdr), 1, h->stream) != 1)
+    {
+      if (feof (h->stream))
+	return -2;
+      else
+	return -1;
+    }
+  
+  for (i = 1; i < sizeof (ghw_sections) / sizeof (*ghw_sections); i++)
+    if (memcmp (hdr, ghw_sections[i].name, 4) == 0)
+      return i;
+
+  fprintf (stderr, "ghw_read_section: unknown GHW section %c%c%c%c\n",
+	   hdr[0], hdr[1], hdr[2], hdr[3]);
+  return 0;
+}
+
+void
+ghw_close (struct ghw_handler *h)
+{
+  if (h->stream)
+    {
+      fclose (h->stream);
+      h->stream = NULL;
+    }
+}
+
+const char *
+ghw_get_dir (int is_downto)
+{
+  return is_downto ? "downto" : "to";
+}
+
+void
+ghw_disp_range (union ghw_range *rng)
+{
+  switch (rng->kind)
+    {
+    case ghdl_rtik_type_i32:
+    case ghdl_rtik_type_p32:
+      printf ("%d %s %d",
+	      rng->i32.left, ghw_get_dir (rng->i32.dir), rng->i32.right);
+      break;
+    case ghdl_rtik_type_i64:
+    case ghdl_rtik_type_p64:
+      printf ("%lld %s %lld",
+	      rng->i64.left, ghw_get_dir (rng->i64.dir), rng->i64.right);
+      break;
+    case ghdl_rtik_type_f64:
+      printf ("%g %s %g",
+	      rng->f64.left, ghw_get_dir (rng->f64.dir), rng->f64.right);
+      break;
+    default:
+      printf ("?(%d)", rng->kind);
+    }
+}
+
+void
+ghw_disp_type (struct ghw_handler *h, union ghw_type *t)
+{
+  switch (t->kind)
+    {
+    case ghdl_rtik_type_b2:
+    case ghdl_rtik_type_e8:
+      {
+	struct ghw_type_enum *e = &t->en;
+	int i;
+
+	printf ("type %s is (", e->name);
+	for (i = 0; i < e->nbr; i++)
+	  {
+	    if (i != 0)
+	      printf (", ");
+	    printf ("%s", e->lits[i]);
+	  }
+	printf (");");
+	if (e->wkt != ghw_wkt_unknown)
+	  printf ("  -- WKT:%d", e->wkt);
+	printf ("\n");
+      }
+      break;
+    case ghdl_rtik_type_i32:
+    case ghdl_rtik_type_f64:
+      {
+	struct ghw_type_scalar *s = &t->sc;
+	printf ("type %s is range <>;\n", s->name);
+      }
+      break;
+    case ghdl_rtik_type_p32:
+    case ghdl_rtik_type_p64:
+      {
+	int i;
+
+	struct ghw_type_physical *p = &t->ph;
+	printf ("type %s is range <> units\n", p->name);
+	for (i = 0; i < p->nbr_units; i++)
+	  {
+	    struct ghw_unit *u = &p->units[i];
+	    printf ("  %s = %lld %s;\n", u->name, u->val, p->units[0].name);
+	  }
+	printf ("end units\n");
+      }
+      break;
+    case ghdl_rtik_subtype_scalar:
+      {
+	struct ghw_subtype_scalar *s = &t->ss;
+	printf ("subtype %s is ", s->name);
+	ghw_disp_typename (h, s->base);
+	printf (" range ");
+	ghw_disp_range (s->rng);
+	printf (";\n");
+      }
+      break;
+    case ghdl_rtik_type_array:
+      {
+	struct ghw_type_array *a = &t->ar;
+	int i;
+
+	printf ("type %s is array (", a->name);
+	for (i = 0; i < a->nbr_dim; i++)
+	  {
+	    if (i != 0)
+	      printf (", ");
+	    ghw_disp_typename (h, a->dims[i]);
+	    printf (" range <>");
+	  }
+	printf (") of ");
+	ghw_disp_typename (h, a->el);
+	printf (";\n");
+      }
+      break;
+    case ghdl_rtik_subtype_array:
+    case ghdl_rtik_subtype_array_ptr:
+      {
+	struct ghw_subtype_array *a = &t->sa;
+	int i;
+
+	printf ("subtype %s is ", a->name);
+	ghw_disp_typename (h, (union ghw_type *)a->base);
+	printf (" (");
+	for (i = 0; i < a->base->nbr_dim; i++)
+	  {
+	    if (i != 0)
+	      printf (", ");
+	    ghw_disp_range (a->rngs[i]);
+	  }
+	printf (");\n");
+      }
+      break;
+    case ghdl_rtik_type_record:
+      {
+	struct ghw_type_record *r = &t->rec;
+	int i;
+
+	printf ("type %s is record\n", r->name);
+	for (i = 0; i < r->nbr_fields; i++)
+	  {
+	    printf ("  %s: ", r->el[i].name);
+	    ghw_disp_typename (h, r->el[i].type);
+	    printf ("\n");
+	  }
+	printf ("end record;\n");
+      }
+      break;
+    default:
+      printf ("ghw_disp_type: unhandled type kind %d\n", t->kind);
+    }
+}
+
+void
+ghw_disp_types (struct ghw_handler *h)
+{
+  int i;
+
+  for (i = 0; i < h->nbr_types; i++)
+    ghw_disp_type (h, h->types[i]);
+}
diff --git a/translate/grt/ghwlib.h b/translate/grt/ghwlib.h
new file mode 100644
index 000000000..500dd6e9f
--- /dev/null
+++ b/translate/grt/ghwlib.h
@@ -0,0 +1,386 @@
+/*  GHDL Wavefile reader library.
+    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.
+*/
+
+
+#ifndef _GHWLIB_H_
+#define _GHWLIB_H_
+
+#include <stdio.h>
+#include <stdint.h>
+#include <stdlib.h>
+
+enum ghdl_rtik {
+  ghdl_rtik_top,		/* 0  */
+  ghdl_rtik_library,
+  ghdl_rtik_package,
+  ghdl_rtik_package_body,
+  ghdl_rtik_entity,
+  ghdl_rtik_architecture,	/* 5 */
+  ghdl_rtik_process,
+  ghdl_rtik_block,
+  ghdl_rtik_if_generate,
+  ghdl_rtik_for_generate,
+  ghdl_rtik_instance,
+  ghdl_rtik_constant,
+  ghdl_rtik_iterator,
+  ghdl_rtik_variable,
+  ghdl_rtik_signal,
+  ghdl_rtik_file,
+  ghdl_rtik_port,
+  ghdl_rtik_generic,
+  ghdl_rtik_alias,
+  ghdl_rtik_guard,
+  ghdl_rtik_component,
+  ghdl_rtik_attribute,
+  ghdl_rtik_type_b2,		/* 22 */
+  ghdl_rtik_type_e8,
+  ghdl_rtik_type_e32,
+  ghdl_rtik_type_i32,		/* 25 */
+  ghdl_rtik_type_i64,
+  ghdl_rtik_type_f64,
+  ghdl_rtik_type_p32,
+  ghdl_rtik_type_p64,
+  ghdl_rtik_type_access,	/* 30 */
+  ghdl_rtik_type_array,
+  ghdl_rtik_type_record,
+  ghdl_rtik_type_file,
+  ghdl_rtik_subtype_scalar,
+  ghdl_rtik_subtype_array,	/* 35 */
+  ghdl_rtik_subtype_array_ptr,
+  ghdl_rtik_subtype_unconstrained_array,
+  ghdl_rtik_subtype_record,
+  ghdl_rtik_subtype_access,
+  ghdl_rtik_type_protected,
+  ghdl_rtik_element,
+  ghdl_rtik_unit,
+  ghdl_rtik_attribute_transaction,
+  ghdl_rtik_attribute_quiet,
+  ghdl_rtik_attribute_stable,
+  ghdl_rtik_error
+};
+
+/* Well-known types.  */
+enum ghw_wkt_type {
+  ghw_wkt_unknown,
+  ghw_wkt_boolean,
+  ghw_wkt_bit,
+  ghw_wkt_std_ulogic
+};
+
+struct ghw_range_e8
+{
+  enum ghdl_rtik kind : 8;
+  int dir : 8; /* 0: to, !0: downto.  */
+  unsigned char left;
+  unsigned char right;
+};
+
+struct ghw_range_i32
+{
+  enum ghdl_rtik kind : 8;
+  int dir : 8; /* 0: to, !0: downto.  */
+  int32_t left;
+  int32_t right;
+};
+
+struct ghw_range_i64
+{
+  enum ghdl_rtik kind : 8;
+  int dir : 8;
+  int64_t left;
+  int64_t right;
+};
+
+struct ghw_range_f64
+{
+  enum ghdl_rtik kind : 8;
+  int dir : 8;
+  double left;
+  double right;
+};
+
+union ghw_range
+{
+  enum ghdl_rtik kind : 8;
+  struct ghw_range_e8 e8;
+  struct ghw_range_i32 i32;
+  struct ghw_range_i64 i64;
+  struct ghw_range_f64 f64;
+};
+
+/* Note: the first two fields must be kind and name.  */
+union ghw_type;
+
+struct ghw_type_common
+{
+  enum ghdl_rtik kind;
+  const char *name;
+};
+
+struct ghw_type_enum
+{
+  enum ghdl_rtik kind;
+  const char *name;
+
+  enum ghw_wkt_type wkt;
+  int nbr;
+  const char **lits;
+};
+
+struct ghw_type_scalar
+{
+  enum ghdl_rtik kind;
+  const char *name;
+};
+
+struct ghw_unit
+{
+  const char *name;
+  int64_t val;
+};
+
+struct ghw_type_physical
+{
+  enum ghdl_rtik kind;
+  const char *name;
+  uint32_t nbr_units;
+  struct ghw_unit *units;
+};
+
+struct ghw_type_array
+{
+  enum ghdl_rtik kind;
+  const char *name;
+
+  int nbr_dim;
+  union ghw_type *el;
+  union ghw_type **dims;
+};
+
+struct ghw_subtype_array
+{
+  enum ghdl_rtik kind;
+  const char *name;
+
+  struct ghw_type_array *base;
+  int nbr_el;
+  union ghw_range **rngs;
+};
+
+struct ghw_subtype_scalar
+{
+  enum ghdl_rtik kind;
+  const char *name;
+
+  union ghw_type *base;
+  union ghw_range *rng;
+};
+
+struct ghw_record_element
+{
+  const char *name;
+  union ghw_type *type;
+};
+
+struct ghw_type_record
+{
+  enum ghdl_rtik kind;
+  const char *name;
+
+  int nbr_fields;
+  int nbr_el;	/* Number of scalar signals.  */
+  struct ghw_record_element *el;
+};
+  
+union ghw_type
+{
+  enum ghdl_rtik kind;
+  struct ghw_type_common common;
+  struct ghw_type_enum en;
+  struct ghw_type_scalar sc;
+  struct ghw_type_physical ph;
+  struct ghw_subtype_scalar ss;
+  struct ghw_subtype_array sa;
+  struct ghw_type_array ar;
+  struct ghw_type_record rec;
+};
+
+union ghw_val
+{
+  unsigned char b2;
+  unsigned char e8;
+  int32_t i32;
+  int64_t i64;
+  double f64;
+};
+
+/* A non-composite signal.  */
+struct ghw_sig
+{
+  union ghw_type *type;
+  union ghw_val *val;
+};
+
+enum ghw_hie_kind {
+  ghw_hie_eoh          = 0,
+  ghw_hie_design       = 1,
+  ghw_hie_block        = 3,
+  ghw_hie_generate_if  = 4,
+  ghw_hie_generate_for = 5,
+  ghw_hie_instance     = 6,
+  ghw_hie_process      = 13,
+  ghw_hie_generic      = 14,
+  ghw_hie_eos          = 15,
+  ghw_hie_signal       = 16,
+  ghw_hie_port_in      = 17,
+  ghw_hie_port_out     = 18,
+  ghw_hie_port_inout   = 19,
+  ghw_hie_port_buffer  = 20,
+  ghw_hie_port_linkage = 21
+};
+
+struct ghw_hie
+{
+  enum ghw_hie_kind kind;
+  struct ghw_hie *parent;
+  const char *name;
+  struct ghw_hie *brother;
+  union
+  {
+    struct
+    {
+      struct ghw_hie *child;
+      union ghw_type *iter_type;
+      union ghw_val *iter_value;
+    } blk;
+    struct
+    {
+      union ghw_type *type;
+      /* Array of signal elements.
+	 Last element is 0.  */
+      unsigned int *sigs;
+    } sig;
+  } u;
+};
+
+struct ghw_handler
+{
+  FILE *stream;
+  /* True if words are big-endian.  */
+  int word_be;
+  int word_len;
+  int off_len;
+  /* Minor version.  */
+  int version;
+
+  /* Set by user.  */
+  int flag_verbose;
+
+  /* String table.  */
+  /* Number of strings.  */
+  int nbr_str;
+  /* Size of the strings (without nul).  */
+  int str_size;
+  /* String table.  */
+  char **str_table;
+  /* Array containing strings.  */
+  char *str_content;
+
+  /* Type table.  */
+  int nbr_types;
+  union ghw_type **types;
+
+  /* Non-composite (or basic) signals.  */
+  int nbr_sigs;
+  struct ghw_sig *sigs;
+
+  /* Hierarchy.  */
+  struct ghw_hie *hie;
+
+  /* Time of the next cycle.  */
+  int64_t snap_time;
+};
+
+/* Open a GHW file with H.
+   Return < 0 in case of error. */
+int ghw_open (struct ghw_handler *h, const char *filename);
+
+union ghw_type *ghw_get_base_type (union ghw_type *t);
+
+/* Put the ASCII representation of VAL into BUF, whose size if LEN.
+   A NUL is always written to BUF.  */
+void ghw_get_value (char *buf, int len, 
+		    union ghw_val *val, union ghw_type *type);
+
+const char *ghw_get_hie_name (struct ghw_hie *h);
+
+void ghw_disp_hie (struct ghw_handler *h, struct ghw_hie *top);
+
+int ghw_read_base (struct ghw_handler *h);
+
+void ghw_disp_values (struct ghw_handler *h);
+
+int ghw_read_cycle_start (struct ghw_handler *h);
+
+int ghw_read_cycle_cont (struct ghw_handler *h, int *list);
+
+int ghw_read_cycle_next (struct ghw_handler *h);
+
+int ghw_read_cycle_end (struct ghw_handler *h);
+
+enum ghw_sm_type {
+  /* At init;
+     Read section name.  */
+  ghw_sm_init = 0,
+  ghw_sm_sect = 1,
+  ghw_sm_cycle = 2
+};
+
+enum ghw_res {
+  ghw_res_error = -1,
+  ghw_res_eof = -2,
+  ghw_res_ok = 0,
+  ghw_res_snapshot = 1,
+  ghw_res_cycle = 2,
+  ghw_res_other = 3
+};
+
+int ghw_read_sm (struct ghw_handler *h, enum ghw_sm_type *sm);
+
+int ghw_read_dump (struct ghw_handler *h);
+
+struct ghw_section {
+  const char name[4];
+  int (*handler)(struct ghw_handler *h);
+};
+
+extern struct ghw_section ghw_sections[];
+
+int ghw_read_section (struct ghw_handler *h);
+
+void ghw_close (struct ghw_handler *h);
+
+const char *ghw_get_dir (int is_downto);
+
+void ghw_disp_range (union ghw_range *rng);
+
+void ghw_disp_type (struct ghw_handler *h, union ghw_type *t);
+
+void ghw_disp_types (struct ghw_handler *h);
+#endif /* _GHWLIB_H_ */
diff --git a/translate/grt/grt-astdio.adb b/translate/grt/grt-astdio.adb
new file mode 100644
index 000000000..3c19cc851
--- /dev/null
+++ b/translate/grt/grt-astdio.adb
@@ -0,0 +1,193 @@
+--  GHDL Run Time (GRT) stdio subprograms for GRT types.
+--  Copyright (C) 2002, 2003, 2004, 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.
+package body Grt.Astdio is
+   procedure Put (Stream : FILEs; Str : String)
+   is
+      S : size_t;
+   begin
+      S := fwrite (Str'Address, Str'Length, 1, Stream);
+   end Put;
+
+   procedure Put (Stream : FILEs; C : Character)
+   is
+      R : int;
+   begin
+      R := fputc (Character'Pos (C), Stream);
+   end Put;
+
+   procedure Put (Stream : FILEs; Str : Ghdl_C_String)
+   is
+      Len : Natural;
+      S : size_t;
+   begin
+      Len := strlen (Str);
+      S := fwrite (Str (1)'Address, size_t (Len), 1, Stream);
+   end Put;
+
+   procedure New_Line (Stream : FILEs) is
+   begin
+      Put (Stream, Nl);
+   end New_Line;
+
+   procedure Put (Str : String)
+   is
+      S : size_t;
+   begin
+      S := fwrite (Str'Address, Str'Length, 1, stdout);
+   end Put;
+
+   procedure Put (C : Character)
+   is
+      R : int;
+   begin
+      R := fputc (Character'Pos (C), stdout);
+   end Put;
+
+   procedure Put (Str : Ghdl_C_String)
+   is
+      Len : Natural;
+      S : size_t;
+   begin
+      Len := strlen (Str);
+      S := fwrite (Str (1)'Address, size_t (Len), 1, stdout);
+   end Put;
+
+   procedure New_Line is
+   begin
+      Put (Nl);
+   end New_Line;
+
+   procedure Put_Line (Str : String)
+   is
+   begin
+      Put (Str);
+      New_Line;
+   end Put_Line;
+
+   procedure Put_Str_Len (Stream : FILEs; Str : Ghdl_Str_Len_Type)
+   is
+      S : String (1 .. 3);
+   begin
+      if Str.Str = null then
+         S (1) := ''';
+         S (2) := Character'Val (Str.Len);
+         S (3) := ''';
+         Put (Stream, S);
+      else
+         Put (Stream, Str.Str (1 .. Str.Len));
+      end if;
+   end Put_Str_Len;
+
+      generic
+      type Ntype is range <>;
+      Max_Len : Natural;
+   procedure Put_Ntype (Stream : FILEs; N : Ntype);
+
+   procedure Put_Ntype (Stream : FILEs; N : Ntype)
+   is
+      Str : String (1 .. Max_Len);
+      P : Natural := Str'Last;
+      V : Ntype;
+   begin
+      if N > 0 then
+         V := -N;
+      else
+         V := N;
+      end if;
+      loop
+         Str (P) := Character'Val (48 - (V rem 10));
+         V := V / 10;
+         exit when V = 0;
+         P := P - 1;
+      end loop;
+      if N < 0 then
+         P := P - 1;
+         Str (P) := '-';
+      end if;
+      Put (Stream, Str (P .. Max_Len));
+   end Put_Ntype;
+
+   procedure Put_I32_1 is new Put_Ntype (Ntype => Ghdl_I32, Max_Len => 11);
+
+   procedure Put_I32 (Stream : FILEs; I32 : Ghdl_I32) renames Put_I32_1;
+
+   procedure Put_I64_1 is new Put_Ntype (Ntype => Ghdl_I64, Max_Len => 20);
+   procedure Put_I64 (Stream : FILEs; I64 : Ghdl_I64) renames Put_I64_1;
+
+   procedure Put_F64 (Stream : FILEs; F64 : Ghdl_F64)
+   is
+      procedure fprintf (Stream : FILEs;
+                         Template : System.Address;
+                         Arg : Ghdl_F64);
+      pragma Import (C, fprintf);
+
+      Str : constant String := "%g" & Character'Val (0);
+   begin
+      fprintf (Stream, Str'Address, F64);
+   end Put_F64;
+
+   Hex_Map : constant array (0 .. 15) of Character := "0123456789ABCDEF";
+
+   procedure Put (Stream : FILEs; Addr : System.Address)
+   is
+      Res : String (1 .. System.Word_Size / 4);
+      Val : Integer_Address := To_Integer (Addr);
+   begin
+      for I in reverse Res'Range loop
+         Res (I) := Hex_Map (Natural (Val and 15));
+         Val := Val / 16;
+      end loop;
+      Put (Stream, Res);
+   end Put;
+
+   procedure Put_Dir (Stream : FILEs; Dir : Ghdl_Dir_Type) is
+   begin
+      case Dir is
+         when Dir_To =>
+            Put (Stream, " to ");
+         when Dir_Downto =>
+            Put (Stream, " downto ");
+      end case;
+   end Put_Dir;
+
+   procedure Put_Time (Stream : FILEs; Time : Std_Time) is
+   begin
+      if Time = Std_Time'First then
+         Put (Stream, "-Inf");
+      else
+         --  Do not bother with sec, min, and hr.
+         if (Time mod 1_000_000_000_000) = 0 then
+            Put_I64 (Stream, Ghdl_I64 (Time / 1_000_000_000_000));
+            Put (Stream, "ms");
+         elsif (Time mod 1_000_000_000) = 0 then
+            Put_I64 (Stream, Ghdl_I64 (Time / 1_000_000_000));
+            Put (Stream, "us");
+         elsif (Time mod 1_000_000) = 0 then
+            Put_I64 (Stream, Ghdl_I64 (Time / 1_000_000));
+            Put (Stream, "ns");
+         elsif (Time mod 1_000) = 0 then
+            Put_I64 (Stream, Ghdl_I64 (Time / 1_000));
+            Put (Stream, "ps");
+         else
+            Put_I64 (Stream, Ghdl_I64 (Time));
+            Put (Stream, "fs");
+         end if;
+      end if;
+   end Put_Time;
+
+end Grt.Astdio;
diff --git a/translate/grt/grt-astdio.ads b/translate/grt/grt-astdio.ads
new file mode 100644
index 000000000..0791a1075
--- /dev/null
+++ b/translate/grt/grt-astdio.ads
@@ -0,0 +1,51 @@
+--  GHDL Run Time (GRT) stdio subprograms for GRT types.
+--  Copyright (C) 2002, 2003, 2004, 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;
+with Grt.Types; use Grt.Types;
+with Grt.Stdio; use Grt.Stdio;
+
+package Grt.Astdio is
+   pragma Preelaborate (Grt.Astdio);
+
+   --  Procedures to disp on STREAM.
+   procedure Put (Stream : FILEs; Str : String);
+   procedure Put_I32 (Stream : FILEs; I32 : Ghdl_I32);
+   procedure Put_I64 (Stream : FILEs; I64 : Ghdl_I64);
+   procedure Put_F64 (Stream : FILEs; F64 : Ghdl_F64);
+   procedure Put (Stream : FILEs; Addr : System.Address);
+   procedure Put (Stream : FILEs; Str : Ghdl_C_String);
+   procedure Put (Stream : FILEs; C : Character);
+   procedure New_Line (Stream : FILEs);
+
+   --  Display time with unit, without space.
+   --  Eg: 10ns, 100ms, 97ps...
+   procedure Put_Time (Stream : FILEs; Time : Std_Time);
+
+   --  And on stdout.
+   procedure Put (Str : String);
+   procedure Put (C : Character);
+   procedure New_Line;
+   procedure Put_Line (Str : String);
+   procedure Put (Str : Ghdl_C_String);
+
+   --  Put STR using put procedures.
+   procedure Put_Str_Len (Stream : FILEs; Str : Ghdl_Str_Len_Type);
+
+   --  Put " to " or " downto ".
+   procedure Put_Dir (Stream : FILEs; Dir : Ghdl_Dir_Type);
+end Grt.Astdio;
diff --git a/translate/grt/grt-avhpi.adb b/translate/grt/grt-avhpi.adb
new file mode 100644
index 000000000..fc38f8792
--- /dev/null
+++ b/translate/grt/grt-avhpi.adb
@@ -0,0 +1,868 @@
+--  GHDL Run Time (GRT) - VHPI implementation for Ada.
+--  Copyright (C) 2002, 2003, 2004, 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.Errors; use Grt.Errors;
+with Grt.Vstrings; use Grt.Vstrings;
+with Grt.Rtis_Utils; use Grt.Rtis_Utils;
+
+package body Grt.Avhpi is
+   procedure Get_Root_Inst (Res : out VhpiHandleT)
+   is
+   begin
+      Res := (Kind => VhpiRootInstK,
+              Ctxt => Get_Top_Context);
+   end Get_Root_Inst;
+
+   procedure Get_Package_Inst (Res : out VhpiHandleT) is
+   begin
+      Res := (Kind => VhpiIteratorK,
+              Ctxt => (Base => Null_Address,
+                       Block => To_Ghdl_Rti_Access (Ghdl_Rti_Top_Ptr)),
+              Rel => VhpiPackInsts,
+              It_Cur => 0,
+              It2 => 0,
+              Max2 => 0);
+   end Get_Package_Inst;
+
+   --  Number of elements in an array.
+   function Ranges_To_Length (Rngs : Ghdl_Range_Array;
+                              Indexes : Ghdl_Rti_Arr_Acc)
+                             return Ghdl_Index_Type
+   is
+      Res : Ghdl_Index_Type;
+   begin
+      Res := 1;
+      for I in Rngs'Range loop
+         Res := Res * Range_To_Length
+           (Rngs (I), Get_Base_Type (Indexes (I - Rngs'First)));
+      end loop;
+      return Res;
+   end Ranges_To_Length;
+
+   procedure Vhpi_Iterator (Rel : VhpiOneToManyT;
+                            Ref : VhpiHandleT;
+                            Res : out VhpiHandleT;
+                            Error : out AvhpiErrorT)
+   is
+   begin
+      --  Default value in case of success.
+      Res := (Kind => VhpiIteratorK,
+              Ctxt => Ref.Ctxt,
+              Rel => Rel,
+              It_Cur => 0,
+              It2 => 0,
+              Max2 => 0);
+      Error := AvhpiErrorOk;
+
+      case Rel is
+         when VhpiInternalRegions =>
+            case Ref.Kind is
+               when VhpiRootInstK
+                 | VhpiArchBodyK
+                 | VhpiBlockStmtK
+                 | VhpiIfGenerateK =>
+                  return;
+               when VhpiForGenerateK =>
+                  Res.It2 := 1;
+                  return;
+               when VhpiCompInstStmtK =>
+                  Get_Instance_Context (Ref.Inst, Ref.Ctxt, Res.Ctxt);
+                  return;
+               when others =>
+                  null;
+            end case;
+         when VhpiDecls =>
+            case Ref.Kind is
+               when VhpiArchBodyK
+                 | VhpiBlockStmtK
+                 | VhpiIfGenerateK
+                 | VhpiForGenerateK =>
+                  return;
+               when VhpiRootInstK
+                 | VhpiPackInstK =>
+                  Res.It2 := 1;
+                  return;
+               when VhpiCompInstStmtK =>
+                  Get_Instance_Context (Ref.Inst, Ref.Ctxt, Res.Ctxt);
+                  Res.It2 := 1;
+                  return;
+               when others =>
+                  null;
+            end case;
+         when VhpiIndexedNames =>
+            case Ref.Kind is
+               when VhpiGenericDeclK =>
+                  Res := (Kind => AvhpiNameIteratorK,
+                          Ctxt => Ref.Ctxt,
+                          N_Addr => Loc_To_Addr (Ref.Obj.Common.Depth,
+                                                 Ref.Obj.Loc,
+                                                 Ref.Ctxt),
+                          N_Type => Ref.Obj.Obj_Type,
+                          N_Idx => 0,
+                          N_Obj => Ref.Obj);
+               when others =>
+                  Error := AvhpiErrorNotImplemented;
+                  return;
+            end case;
+            case Res.N_Type.Kind is
+               when Ghdl_Rtik_Subtype_Array =>
+                  declare
+                     St : Ghdl_Rtin_Subtype_Array_Acc :=
+                       To_Ghdl_Rtin_Subtype_Array_Acc (Res.N_Type);
+                     Bt : Ghdl_Rtin_Type_Array_Acc := St.Basetype;
+                     Rngs : Ghdl_Range_Array (0 .. Bt.Nbr_Dim - 1);
+                  begin
+                     Bound_To_Range
+                       (Loc_To_Addr (St.Common.Depth, St.Bounds, Res.Ctxt),
+                        Bt, Rngs);
+                     Res.N_Idx := Ranges_To_Length (Rngs, Bt.Indexes);
+                  end;
+               when others =>
+                  Error := AvhpiErrorBadRel;
+            end case;
+            return;
+         when others =>
+            null;
+      end case;
+      --  Failure.
+      Res := Null_Handle;
+      Error := AvhpiErrorNotImplemented;
+   end Vhpi_Iterator;
+
+   procedure Vhpi_Scan_Indexed_Name (Iterator : in out VhpiHandleT;
+                                     Res : out VhpiHandleT;
+                                     Error : out AvhpiErrorT)
+   is
+      procedure Update (S : Ghdl_Index_Type) is
+      begin
+         Iterator.N_Addr := Iterator.N_Addr + (S / Storage_Unit);
+      end Update;
+
+      Is_Sig : Boolean;
+      El_Type : Ghdl_Rti_Access;
+   begin
+      if Iterator.N_Idx = 0 then
+         Error := AvhpiErrorIteratorEnd;
+         return;
+      end if;
+
+      El_Type := To_Ghdl_Rtin_Type_Array_Acc
+        (Get_Base_Type (Iterator.N_Type)).Element;
+
+      Res := (Kind => VhpiIndexedNameK,
+              Ctxt => Iterator.Ctxt,
+              N_Addr => Iterator.N_Addr,
+              N_Type => El_Type,
+              N_Idx => 0,
+              N_Obj => Iterator.N_Obj);
+
+      --  Increment Address.
+      case Iterator.N_Obj.Common.Kind is
+         when Ghdl_Rtik_Generic =>
+            Is_Sig := False;
+         when others =>
+            Internal_Error ("vhpi_scan_indexed_name(1)");
+      end case;
+
+      case Get_Base_Type (El_Type).Kind is
+         when Ghdl_Rtik_Type_P64 =>
+            if Is_Sig then
+               Update (Address'Size);
+            else
+               Update (Ghdl_I64'Size);
+            end if;
+         when others =>
+            Internal_Error ("vhpi_scan_indexed_name");
+      end case;
+      Iterator.N_Idx := Iterator.N_Idx - 1;
+      Error := AvhpiErrorOk;
+   end Vhpi_Scan_Indexed_Name;
+
+   procedure Vhpi_Scan_Internal_Regions (Iterator : in out VhpiHandleT;
+                                         Res : out VhpiHandleT;
+                                         Error : out AvhpiErrorT)
+   is
+      Blk : Ghdl_Rtin_Block_Acc;
+      Ch : Ghdl_Rti_Access;
+      Nblk : Ghdl_Rtin_Block_Acc;
+   begin
+      Blk := To_Ghdl_Rtin_Block_Acc (Iterator.Ctxt.Block);
+      if Blk = null then
+         Error := AvhpiErrorIteratorEnd;
+         return;
+      end if;
+
+      loop
+         << Again >> null;
+         if Iterator.It_Cur >= Blk.Nbr_Child then
+            Error := AvhpiErrorIteratorEnd;
+            return;
+         end if;
+
+         Ch := Blk.Children (Iterator.It_Cur);
+         Nblk := To_Ghdl_Rtin_Block_Acc (Ch);
+
+         if Iterator.Max2 /= 0 then
+            --  A for generate.
+            Iterator.It2 := Iterator.It2 + 1;
+            if Iterator.It2 >= Iterator.Max2 then
+               --  End of loop.
+               Iterator.Max2 := 0;
+               Iterator.It_Cur := Iterator.It_Cur + 1;
+               goto Again;
+            else
+               declare
+                  Base : Address;
+               begin
+                  Base := To_Addr_Acc (Iterator.Ctxt.Base + Nblk.Loc.Off).all;
+                  Base := Base + Iterator.It2 * Nblk.Size;
+                  Res := (Kind => VhpiForGenerateK,
+                          Ctxt => (Base => Base,
+                                   Block => Ch));
+
+                  Error := AvhpiErrorOk;
+                  return;
+               end;
+            end if;
+         end if;
+
+
+         Iterator.It_Cur := Iterator.It_Cur + 1;
+
+         case Ch.Kind is
+            when Ghdl_Rtik_Process =>
+               Res := (Kind => VhpiProcessStmtK,
+                       Ctxt => (Base => Iterator.Ctxt.Base + Nblk.Loc.Off,
+                                Block => Ch));
+               Error := AvhpiErrorOk;
+               return;
+            when Ghdl_Rtik_Block =>
+               Res := (Kind => VhpiBlockStmtK,
+                       Ctxt => (Base => Iterator.Ctxt.Base + Nblk.Loc.Off,
+                                Block => Ch));
+               Error := AvhpiErrorOk;
+               return;
+            when Ghdl_Rtik_If_Generate =>
+               Res := (Kind => VhpiIfGenerateK,
+                       Ctxt => (Base => To_Addr_Acc (Iterator.Ctxt.Base
+                                                     + Nblk.Loc.Off).all,
+                                Block => Ch));
+               --  Return only if the condition is true.
+               if Res.Ctxt.Base /= Null_Address then
+                  Error := AvhpiErrorOk;
+                  return;
+               end if;
+            when Ghdl_Rtik_For_Generate =>
+               Res := (Kind => VhpiForGenerateK,
+                       Ctxt => (Base => To_Addr_Acc (Iterator.Ctxt.Base
+                                                     + Nblk.Loc.Off).all,
+                                Block => Ch));
+               Iterator.Max2 := Get_For_Generate_Length (Nblk, Iterator.Ctxt);
+               Iterator.It2 := 0;
+               if Iterator.Max2 > 0 then
+                  Iterator.It_Cur := Iterator.It_Cur - 1;
+                  Error := AvhpiErrorOk;
+                  return;
+               end if;
+               --  If the iterator range is nul, then continue to scan.
+            when Ghdl_Rtik_Instance =>
+               Res := (Kind => VhpiCompInstStmtK,
+                       Ctxt => Iterator.Ctxt,
+                       Inst => To_Ghdl_Rtin_Instance_Acc (Ch));
+               Error := AvhpiErrorOk;
+               return;
+            when others =>
+               --  Next one.
+               null;
+         end case;
+      end loop;
+   end Vhpi_Scan_Internal_Regions;
+
+   procedure Rti_To_Handle (Rti : Ghdl_Rti_Access;
+                            Ctxt : Rti_Context;
+                            Res : out VhpiHandleT)
+   is
+   begin
+      case Rti.Kind is
+         when Ghdl_Rtik_Signal =>
+            Res := (Kind => VhpiSigDeclK,
+                    Ctxt => Ctxt,
+                    Obj => To_Ghdl_Rtin_Object_Acc (Rti));
+         when Ghdl_Rtik_Port =>
+            Res := (Kind => VhpiPortDeclK,
+                    Ctxt => Ctxt,
+                    Obj => To_Ghdl_Rtin_Object_Acc (Rti));
+         when Ghdl_Rtik_Generic =>
+            Res := (Kind => VhpiGenericDeclK,
+                    Ctxt => Ctxt,
+                    Obj => To_Ghdl_Rtin_Object_Acc (Rti));
+         when Ghdl_Rtik_Subtype_Array
+           | Ghdl_Rtik_Subtype_Array_Ptr =>
+            declare
+               Atype : Ghdl_Rtin_Subtype_Array_Acc;
+               Bt : Ghdl_Rtin_Type_Array_Acc;
+            begin
+               Atype := To_Ghdl_Rtin_Subtype_Array_Acc (Rti);
+               Bt := Atype.Basetype;
+               if Atype.Name = Bt.Name then
+                  Res := (Kind => VhpiArrayTypeDeclK,
+                          Ctxt => Ctxt,
+                          Atype => Rti);
+               else
+                  Res := (Kind => VhpiSubtypeDeclK,
+                          Ctxt => Ctxt,
+                          Atype => Rti);
+               end if;
+            end;
+         when Ghdl_Rtik_Type_B2
+           | Ghdl_Rtik_Type_E8 =>
+            Res := (Kind => VhpiEnumTypeDeclK,
+                    Ctxt => Ctxt,
+                    Atype => Rti);
+         when others =>
+            Res := (Kind => VhpiUndefined,
+                    Ctxt => Ctxt);
+      end case;
+   end Rti_To_Handle;
+
+   procedure Vhpi_Scan_Decls (Iterator : in out VhpiHandleT;
+                              Res : out VhpiHandleT;
+                              Error : out AvhpiErrorT)
+   is
+      Blk : Ghdl_Rtin_Block_Acc;
+      Ch : Ghdl_Rti_Access;
+      Obj : Ghdl_Rtin_Object_Acc;
+   begin
+      Blk := To_Ghdl_Rtin_Block_Acc (Iterator.Ctxt.Block);
+
+      --  If there is no context, returns now.
+      --  This may happen for a unbound compinststmt.
+      if Blk = null then
+         Error := AvhpiErrorIteratorEnd;
+         return;
+      end if;
+
+      if Iterator.It2 = 1 then
+         case Blk.Common.Kind is
+            when Ghdl_Rtik_Architecture =>
+               --  Iterate on the entity.
+               Blk := To_Ghdl_Rtin_Block_Acc (Blk.Parent);
+            when Ghdl_Rtik_Package_Body =>
+               --  Iterate on the package.
+               Blk := To_Ghdl_Rtin_Block_Acc (Blk.Parent);
+            when Ghdl_Rtik_Package =>
+               --  Only for std.standard.
+               Iterator.It2 := 0;
+            when others =>
+               Internal_Error ("vhpi_scan_decls");
+         end case;
+      end if;
+      loop
+         loop
+            exit when Iterator.It_Cur >= Blk.Nbr_Child;
+
+            Ch := Blk.Children (Iterator.It_Cur);
+            Obj := To_Ghdl_Rtin_Object_Acc (Ch);
+
+            Iterator.It_Cur := Iterator.It_Cur + 1;
+
+            case Ch.Kind is
+               when Ghdl_Rtik_Port
+                 | Ghdl_Rtik_Generic
+                 | Ghdl_Rtik_Signal
+                 | Ghdl_Rtik_Subtype_Array
+                 | Ghdl_Rtik_Subtype_Array_Ptr
+                 | Ghdl_Rtik_Type_E8
+                 | Ghdl_Rtik_Type_B2 =>
+                  Rti_To_Handle (Ch, Iterator.Ctxt, Res);
+                  if Res.Kind /= VhpiUndefined then
+                     Error := AvhpiErrorOk;
+                     return;
+                  else
+                     Internal_Error ("vhpi_handle");
+                  end if;
+               when others =>
+                  null;
+            end case;
+         end loop;
+         case Iterator.It2 is
+            when 1 =>
+               --  Iterate on the architecture/package decl.
+               Iterator.It2 := 0;
+               Blk := To_Ghdl_Rtin_Block_Acc (Iterator.Ctxt.Block);
+               Iterator.It_Cur := 0;
+            when others =>
+               exit;
+         end case;
+      end loop;
+      Error := AvhpiErrorIteratorEnd;
+   end Vhpi_Scan_Decls;
+
+   procedure Vhpi_Scan (Iterator : in out VhpiHandleT;
+                        Res : out VhpiHandleT;
+                        Error : out AvhpiErrorT)
+   is
+   begin
+      if Iterator.Kind = AvhpiNameIteratorK then
+         case Iterator.N_Type.Kind is
+            when Ghdl_Rtik_Subtype_Array =>
+               Vhpi_Scan_Indexed_Name (Iterator, Res, Error);
+            when others =>
+               Error := AvhpiErrorHandle;
+               Res := Null_Handle;
+         end case;
+         return;
+      elsif Iterator.Kind /= VhpiIteratorK then
+         Error := AvhpiErrorHandle;
+         Res := Null_Handle;
+         return;
+      end if;
+
+      case Iterator.Rel is
+         when VhpiPackInsts =>
+            declare
+               Blk : Ghdl_Rtin_Block_Acc;
+            begin
+               Blk := To_Ghdl_Rtin_Block_Acc (Iterator.Ctxt.Block);
+               if Iterator.It_Cur >= Blk.Nbr_Child then
+                  Error := AvhpiErrorIteratorEnd;
+                  return;
+               end if;
+               Res := (Kind => VhpiPackInstK,
+                       Ctxt => (Base => Null_Address,
+                                Block => Blk.Children (Iterator.It_Cur)));
+               Iterator.It_Cur := Iterator.It_Cur + 1;
+               Error := AvhpiErrorOk;
+            end;
+         when VhpiInternalRegions =>
+            Vhpi_Scan_Internal_Regions (Iterator, Res, Error);
+         when VhpiDecls =>
+            Vhpi_Scan_Decls (Iterator, Res, Error);
+         when others =>
+            Res := Null_Handle;
+            Error := AvhpiErrorNotImplemented;
+      end case;
+   end Vhpi_Scan;
+
+   function Avhpi_Get_Base_Name (Obj : VhpiHandleT) return Ghdl_C_String
+   is
+   begin
+      case Obj.Kind is
+         when VhpiEnumTypeDeclK =>
+            return To_Ghdl_Rtin_Type_Enum_Acc (Obj.Atype).Name;
+         when VhpiPackInstK
+           | VhpiArchBodyK
+           | VhpiEntityDeclK
+           | VhpiProcessStmtK
+           | VhpiBlockStmtK
+           | VhpiIfGenerateK
+           | VhpiForGenerateK =>
+            return To_Ghdl_Rtin_Block_Acc (Obj.Ctxt.Block).Name;
+         when VhpiRootInstK =>
+            declare
+               Blk : Ghdl_Rtin_Block_Acc;
+            begin
+               Blk := To_Ghdl_Rtin_Block_Acc (Obj.Ctxt.Block);
+               Blk := To_Ghdl_Rtin_Block_Acc (Blk.Parent);
+               return Blk.Name;
+            end;
+         when VhpiCompInstStmtK =>
+            return Obj.Inst.Name;
+         when VhpiSigDeclK
+           | VhpiPortDeclK
+           | VhpiGenericDeclK =>
+            return Obj.Obj.Name;
+         when VhpiSubtypeDeclK =>
+            return To_Ghdl_Rtin_Subtype_Scalar_Acc (Obj.Atype).Name;
+         when others =>
+            return null;
+      end case;
+   end Avhpi_Get_Base_Name;
+
+   procedure Vhpi_Get_Str (Property : VhpiStrPropertyT;
+                           Obj : VhpiHandleT;
+                           Res : out String;
+                           Len : out Natural)
+   is
+      subtype R_Type is String (1 .. Res'Length);
+      R : R_Type renames Res;
+
+      procedure Add (C : Character) is
+      begin
+         Len := Len + 1;
+         if Len <= R_Type'Last then
+            R (Len) := C;
+         end if;
+      end Add;
+
+      procedure Add (Str : String) is
+      begin
+         for I in Str'Range loop
+            Add (Str (I));
+         end loop;
+      end Add;
+
+      procedure Add (Str : Ghdl_C_String) is
+      begin
+         for I in Str'Range loop
+            exit when Str (I) = NUL;
+            Add (Str (I));
+         end loop;
+      end Add;
+   begin
+      Len := 0;
+
+      case Property is
+         when VhpiNameP =>
+            case Obj.Kind is
+               when VhpiEnumTypeDeclK =>
+                  Add (To_Ghdl_Rtin_Type_Enum_Acc (Obj.Atype).Name);
+               when VhpiPackInstK
+                 | VhpiArchBodyK
+                 | VhpiEntityDeclK
+                 | VhpiProcessStmtK
+                 | VhpiBlockStmtK
+                 | VhpiIfGenerateK =>
+                  Add (To_Ghdl_Rtin_Block_Acc (Obj.Ctxt.Block).Name);
+               when VhpiRootInstK =>
+                  declare
+                     Blk : Ghdl_Rtin_Block_Acc;
+                  begin
+                     Blk := To_Ghdl_Rtin_Block_Acc (Obj.Ctxt.Block);
+                     Blk := To_Ghdl_Rtin_Block_Acc (Blk.Parent);
+                     Add (Blk.Name);
+                  end;
+               when VhpiCompInstStmtK =>
+                  Add (Obj.Inst.Name);
+               when VhpiSigDeclK
+                 | VhpiPortDeclK
+                 | VhpiGenericDeclK =>
+                  Add (Obj.Obj.Name);
+               when VhpiSubtypeDeclK =>
+                  Add (To_Ghdl_Rtin_Subtype_Scalar_Acc (Obj.Atype).Name);
+               when VhpiForGenerateK =>
+                  declare
+                     Blk : Ghdl_Rtin_Block_Acc;
+                     Iter : Ghdl_Rtin_Object_Acc;
+                     Iter_Type : Ghdl_Rti_Access;
+                     Vptr : Ghdl_Value_Ptr;
+                     Buf : String (1 .. 12);
+                     Buf_Len : Natural;
+                  begin
+                     Blk := To_Ghdl_Rtin_Block_Acc (Obj.Ctxt.Block);
+                     Iter := To_Ghdl_Rtin_Object_Acc (Blk.Children (0));
+                     Vptr := To_Ghdl_Value_Ptr
+                       (Loc_To_Addr (Iter.Common.Depth, Iter.Loc, Obj.Ctxt));
+                     Add (Blk.Name);
+                     Add ('(');
+                     Iter_Type := Iter.Obj_Type;
+                     if Iter_Type.Kind = Ghdl_Rtik_Subtype_Scalar then
+                        Iter_Type := To_Ghdl_Rtin_Subtype_Scalar_Acc
+                          (Iter_Type).Basetype;
+                     end if;
+                     case Iter_Type.Kind is
+                        when Ghdl_Rtik_Type_I32 =>
+                           To_String (Buf, Buf_Len, Vptr.I32);
+                           Add (Buf (Buf_Len .. Buf'Last));
+--                         when Ghdl_Rtik_Type_E8 =>
+--                            Disp_Enum_Value
+--                              (Stream, Rti, Ghdl_Index_Type (Vptr.E8));
+--                         when Ghdl_Rtik_Type_B2 =>
+--                            Disp_Enum_Value
+--                              (Stream, Rti,
+--                               Ghdl_Index_Type (Ghdl_B2'Pos (Vptr.B2)));
+                        when others =>
+                           Add ('?');
+                     end case;
+                     --Disp_Value (stdout, Iter.Obj_Type, Ctxt, Addr, False);
+                     Add (')');
+                  end;
+               when others =>
+                  null;
+            end case;
+         when VhpiCompNameP =>
+            case Obj.Kind is
+               when VhpiCompInstStmtK =>
+                  declare
+                     Comp : Ghdl_Rtin_Component_Acc;
+                  begin
+                     Comp := To_Ghdl_Rtin_Component_Acc (Obj.Obj.Obj_Type);
+                     if Comp.Common.Kind = Ghdl_Rtik_Component then
+                        Add (Comp.Name);
+                     end if;
+                  end;
+               when others =>
+                  null;
+            end case;
+         when VhpiLibLogicalNameP =>
+            case Obj.Kind is
+               when VhpiPackInstK
+                 | VhpiArchBodyK
+                 | VhpiEntityDeclK =>
+                  declare
+                     Blk : Ghdl_Rtin_Block_Acc;
+                     Lib : Ghdl_Rtin_Type_Scalar_Acc;
+                  begin
+                     Blk := To_Ghdl_Rtin_Block_Acc (Obj.Ctxt.Block);
+                     if Blk.Common.Kind = Ghdl_Rtik_Package_Body then
+                        Blk := To_Ghdl_Rtin_Block_Acc (Blk.Parent);
+                     end if;
+                     Lib := To_Ghdl_Rtin_Type_Scalar_Acc (Blk.Parent);
+                     if Lib.Common.Kind /= Ghdl_Rtik_Library then
+                        Internal_Error ("VhpiLibLogicalNameP");
+                     end if;
+                     Add (Lib.Name);
+                  end;
+               when others =>
+                  null;
+            end case;
+         when VhpiFullNameP =>
+            declare
+               Rstr : Rstring;
+               Nctxt : Rti_Context;
+            begin
+               if Obj.Kind = VhpiCompInstStmtK then
+                  Get_Instance_Context (Obj.Inst, Obj.Ctxt, Nctxt);
+                  Get_Path_Name (Rstr, Nctxt, ':', False);
+               else
+                  Get_Path_Name (Rstr, Obj.Ctxt, ':', False);
+               end if;
+               Copy (Rstr, R, Len);
+               Free (Rstr);
+               case Obj.Kind is
+                  when VhpiCompInstStmtK =>
+                     null;
+                  when VhpiPortDeclK
+                    | VhpiSigDeclK =>
+                     Add (':');
+                     Add (Obj.Obj.Name);
+                  when others =>
+                     null;
+               end case;
+            end;
+         when others =>
+            null;
+      end case;
+   end Vhpi_Get_Str;
+
+   procedure Vhpi_Handle (Rel : VhpiOneToOneT;
+                          Ref : VhpiHandleT;
+                          Res : out VhpiHandleT;
+                          Error : out AvhpiErrorT)
+   is
+   begin
+      --  Default error.
+      Error := AvhpiErrorNotImplemented;
+
+      case Rel is
+         when VhpiDesignUnit =>
+            case Ref.Kind is
+               when VhpiRootInstK =>
+                  case Ref.Ctxt.Block.Kind is
+                     when Ghdl_Rtik_Architecture =>
+                        Res := (Kind => VhpiArchBodyK,
+                                Ctxt => Ref.Ctxt);
+                        Error := AvhpiErrorOk;
+                        return;
+                     when others =>
+                        return;
+                  end case;
+               when others =>
+                  return;
+            end case;
+         when VhpiPrimaryUnit =>
+            case Ref.Kind is
+               when VhpiArchBodyK =>
+                  declare
+                     Rti : Ghdl_Rti_Access;
+                     Ent : Ghdl_Rtin_Block_Acc;
+                  begin
+                     Rti := To_Ghdl_Rtin_Block_Acc (Ref.Ctxt.Block).Parent;
+                     Ent := To_Ghdl_Rtin_Block_Acc (Rti);
+                     Res := (Kind => VhpiEntityDeclK,
+                             Ctxt => (Base => Ref.Ctxt.Base + Ent.Loc.Off,
+                                      Block => Rti));
+                     Error := AvhpiErrorOk;
+                  end;
+               when others =>
+                  return;
+            end case;
+         when VhpiIterScheme =>
+            case Ref.Kind is
+               when VhpiForGenerateK =>
+                  declare
+                     Blk : Ghdl_Rtin_Block_Acc;
+                     Iter : Ghdl_Rtin_Object_Acc;
+                  begin
+                     Blk := To_Ghdl_Rtin_Block_Acc (Ref.Ctxt.Block);
+                     Iter := To_Ghdl_Rtin_Object_Acc (Blk.Children (0));
+                     Res := (Kind => VhpiConstDeclK,
+                             Ctxt => Ref.Ctxt,
+                             Obj => Iter);
+                     Error := AvhpiErrorOk;
+                  end;
+               when others =>
+                  return;
+            end case;
+         when VhpiSubtype =>
+            case Ref.Kind is
+               when VhpiPortDeclK
+                 | VhpiSigDeclK
+                 | VhpiGenericDeclK
+                 | VhpiConstDeclK =>
+                  Res := (Kind => VhpiSubtypeIndicK,
+                          Ctxt => Ref.Ctxt,
+                          Atype => Ref.Obj.Obj_Type);
+                  Error := AvhpiErrorOk;
+               when others =>
+                  return;
+            end case;
+         when VhpiTypeMark =>
+            case Ref.Kind is
+               when VhpiSubtypeIndicK =>
+                  --  FIXME: if the subtype is anonymous, return the base type.
+                  Rti_To_Handle (Ref.Atype, Ref.Ctxt, Res);
+                  if Res.Kind /= VhpiUndefined then
+                     Error := AvhpiErrorOk;
+                  end if;
+                  return;
+               when others =>
+                  return;
+            end case;
+         when others =>
+            Res := Null_Handle;
+            Error := AvhpiErrorNotImplemented;
+      end case;
+   end Vhpi_Handle;
+
+   function Vhpi_Get_EntityClass (Obj : VhpiHandleT)
+                                 return VhpiEntityClassT
+   is
+   begin
+      case Obj.Kind is
+         when VhpiArchBodyK =>
+            return VhpiArchitectureEC;
+         when others =>
+            return VhpiErrorEC;
+      end case;
+   end Vhpi_Get_EntityClass;
+
+   function Vhpi_Get_Kind (Obj : VhpiHandleT) return VhpiClassKindT is
+   begin
+      return Obj.Kind;
+   end Vhpi_Get_Kind;
+
+   function Vhpi_Get_Mode (Obj : VhpiHandleT) return VhpiModeP is
+   begin
+      case Obj.Kind is
+         when VhpiPortDeclK =>
+            case Obj.Obj.Common.Mode and Ghdl_Rti_Signal_Mode_Mask is
+               when Ghdl_Rti_Signal_Mode_In =>
+                  return VhpiInMode;
+               when Ghdl_Rti_Signal_Mode_Out =>
+                  return VhpiOutMode;
+               when Ghdl_Rti_Signal_Mode_Inout =>
+                  return VhpiInoutMode;
+               when Ghdl_Rti_Signal_Mode_Buffer =>
+                  return VhpiBufferMode;
+               when Ghdl_Rti_Signal_Mode_Linkage =>
+                  return VhpiLinkageMode;
+               when others =>
+                  return VhpiErrorMode;
+            end case;
+         when others =>
+            return VhpiErrorMode;
+      end case;
+   end Vhpi_Get_Mode;
+
+   function Avhpi_Get_Rti (Obj : VhpiHandleT) return Ghdl_Rti_Access is
+   begin
+      case Obj.Kind is
+         when VhpiSubtypeIndicK
+           | VhpiEnumTypeDeclK =>
+            return Obj.Atype;
+         when VhpiSigDeclK
+           | VhpiPortDeclK =>
+            return To_Ghdl_Rti_Access (Obj.Obj);
+         when others =>
+            return null;
+      end case;
+   end Avhpi_Get_Rti;
+
+   function Avhpi_Get_Address (Obj : VhpiHandleT) return Address is
+   begin
+      case Obj.Kind is
+         when VhpiPortDeclK
+           | VhpiSigDeclK
+           | VhpiGenericDeclK
+           | VhpiConstDeclK =>
+            return Loc_To_Addr (Obj.Ctxt.Block.Depth,
+                                Obj.Obj.Loc,
+                                Obj.Ctxt);
+         when others =>
+            return Null_Address;
+      end case;
+   end Avhpi_Get_Address;
+
+   function Avhpi_Get_Context (Obj : VhpiHandleT) return Rti_Context is
+   begin
+      return Obj.Ctxt;
+   end Avhpi_Get_Context;
+
+   function Vhpi_Compare_Handles (Hdl1, Hdl2 : VhpiHandleT)
+                                 return Boolean
+   is
+   begin
+      if Hdl1.Kind /= Hdl2.Kind then
+         return False;
+      end if;
+      case Hdl1.Kind is
+         when VhpiSubtypeIndicK
+           | VhpiSubtypeDeclK
+           | VhpiArrayTypeDeclK =>
+            return Hdl1.Atype = Hdl2.Atype;
+         when others =>
+            -- FIXME: todo
+            Internal_Error ("vhpi_compare_handles");
+      end case;
+   end Vhpi_Compare_Handles;
+
+   function Vhpi_Put_Value (Obj : VhpiHandleT; Val : Ghdl_I64)
+                           return AvhpiErrorT
+   is
+      Vptr : Ghdl_Value_Ptr;
+      Atype : Ghdl_Rti_Access;
+   begin
+      case Obj.Kind is
+         when VhpiIndexedNameK =>
+            Vptr := To_Ghdl_Value_Ptr (Obj.N_Addr);
+            Atype := Obj.N_Type;
+         when others =>
+            return AvhpiErrorNotImplemented;
+      end case;
+      case Get_Base_Type (Atype).Kind is
+         when Ghdl_Rtik_Type_P64 =>
+            null;
+         when others =>
+            return AvhpiErrorHandle;
+      end case;
+      Vptr.I64 := Val;
+      return AvhpiErrorOk;
+   end Vhpi_Put_Value;
+end Grt.Avhpi;
+
+
diff --git a/translate/grt/grt-avhpi.ads b/translate/grt/grt-avhpi.ads
new file mode 100644
index 000000000..8242d5b21
--- /dev/null
+++ b/translate/grt/grt-avhpi.ads
@@ -0,0 +1,455 @@
+--  GHDL Run Time (GRT) - VHPI implementation for Ada.
+--  Copyright (C) 2002, 2003, 2004, 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.
+
+--  Ada oriented implementation of VHPI.
+--  This doesn't follow exactly what VHPI defined, but:
+--  * it should be easy to write a VHPI interface from this implementation.
+--  * this implementation is thread-safe (no global storage).
+--  * this implementation never allocates memory.
+with System; use System;
+with Grt.Types; use Grt.Types;
+with Grt.Rtis; use Grt.Rtis;
+with Grt.Rtis_Addr; use Grt.Rtis_Addr;
+
+package Grt.Avhpi is
+   --  Object Kinds.
+   type VhpiClassKindT is
+     (
+      VhpiUndefined,
+      VhpiAccessTypeDeclK,
+      VhpiAggregateK,
+      VhpiAliasDeclK,
+      VhpiAllLiteralK,
+      VhpiAllocatorK,
+      VhpiAnyCollectionK,
+      VhpiArchBodyK,
+      VhpiArgvK,
+      VhpiArrayTypeDeclK,
+      VhpiAssertStmtK,
+      VhpiAssocElemK,
+      VhpiAttrDeclK,
+      VhpiAttrSpecK,
+      VhpiBinaryExprK,
+      VhpiBitStringLiteralK,
+      VhpiBlockConfigK,
+      VhpiBlockStmtK,
+      VhpiBranchK,
+      VhpiCallbackK,
+      VhpiCaseStmtK,
+      VhpiCharLiteralK,
+      VhpiCompConfigK,
+      VhpiCompDeclK,
+      VhpiCompInstStmtK,
+      VhpiCondSigAssignStmtK,
+      VhpiCondWaveformK,
+      VhpiConfigDeclK,
+      VhpiConstDeclK,
+      VhpiConstParamDeclK,
+      VhpiConvFuncK,
+      VhpiDeRefObjK,
+      VhpiDisconnectSpecK,
+      VhpiDriverK,
+      VhpiDriverCollectionK,
+      VhpiElemAssocK,
+      VhpiElemDeclK,
+      VhpiEntityClassEntryK,
+      VhpiEntityDeclK,
+      VhpiEnumLiteralK,
+      VhpiEnumRangeK,
+      VhpiEnumTypeDeclK,
+      VhpiExitStmtK,
+      VhpiFileDeclK,
+      VhpiFileParamDeclK,
+      VhpiFileTypeDeclK,
+      VhpiFloatRangeK,
+      VhpiFloatTypeDeclK,
+      VhpiForGenerateK,
+      VhpiForLoopK,
+      VhpiForeignfK,
+      VhpiFuncCallK,
+      VhpiFuncDeclK,
+      VhpiGenericDeclK,
+      VhpiGroupDeclK,
+      VhpiGroupTempDeclK,
+      VhpiIfGenerateK,
+      VhpiIfStmtK,
+      VhpiInPortK,
+      VhpiIndexedNameK,
+      VhpiIntLiteralK,
+      VhpiIntRangeK,
+      VhpiIntTypeDeclK,
+      VhpiIteratorK,
+      VhpiLibraryDeclK,
+      VhpiLoopStmtK,
+      VhpiNextStmtK,
+      VhpiNullLiteralK,
+      VhpiNullStmtK,
+      VhpiOperatorK,
+      VhpiOthersLiteralK,
+      VhpiOutPortK,
+      VhpiPackBodyK,
+      VhpiPackDeclK,
+      VhpiPackInstK,
+      VhpiParamAttrNameK,
+      VhpiPhysLiteralK,
+      VhpiPhysRangeK,
+      VhpiPhysTypeDeclK,
+      VhpiPortDeclK,
+      VhpiProcCallStmtK,
+      VhpiProcDeclK,
+      VhpiProcessStmtK,
+      VhpiProtectedTypeK,
+      VhpiProtectedTypeBodyK,
+      VhpiProtectedTypeDeclK,
+      VhpiRealLiteralK,
+      VhpiRecordTypeDeclK,
+      VhpiReportStmtK,
+      VhpiReturnStmtK,
+      VhpiRootInstK,
+      VhpiSelectSigAssignStmtK,
+      VhpiSelectWaveformK,
+      VhpiSelectedNameK,
+      VhpiSigDeclK,
+      VhpiSigParamDeclK,
+      VhpiSimpAttrNameK,
+      VhpiSimpleSigAssignStmtK,
+      VhpiSliceNameK,
+      VhpiStringLiteralK,
+      VhpiSubpBodyK,
+      VhpiSubtypeDeclK,
+      VhpiSubtypeIndicK,
+      VhpiToolK,
+      VhpiTransactionK,
+      VhpiTypeConvK,
+      VhpiUnaryExprK,
+      VhpiUnitDeclK,
+      VhpiUserAttrNameK,
+      VhpiVarAssignStmtK,
+      VhpiVarDeclK,
+      VhpiVarParamDeclK,
+      VhpiWaitStmtK,
+      VhpiWaveformElemK,
+      VhpiWhileLoopK,
+
+      --  Iterator, but on a name.
+      AvhpiNameIteratorK
+     );
+
+   type VhpiOneToOneT is
+     (
+      VhpiAbstractLiteral,
+      VhpiActual,
+      VhpiAllLiteral,
+      VhpiAttrDecl,
+      VhpiAttrSpec,
+      VhpiBaseType,
+      VhpiBaseUnit,
+      VhpiBasicSignal,
+      VhpiBlockConfig,
+      VhpiCaseExpr,
+      VhpiCondExpr,
+      VhpiConfigDecl,
+      VhpiConfigSpec,
+      VhpiConstraint,
+      VhpiContributor,
+      VhpiCurCallback,
+      VhpiCurEqProcess,
+      VhpiCurStackFrame,
+      VhpiDeRefObj,
+      VhpiDecl,
+      VhpiDesignUnit,
+      VhpiDownStack,
+      VhpiElemSubtype,
+      VhpiEntityAspect,
+      VhpiEntityDecl,
+      VhpiEqProcessStmt,
+      VhpiExpr,
+      VhpiFormal,
+      VhpiFuncDecl,
+      VhpiGroupTempDecl,
+      VhpiGuardExpr,
+      VhpiGuardSig,
+      VhpiImmRegion,
+      VhpiInPort,
+      VhpiInitExpr,
+      VhpiIterScheme,
+      VhpiLeftExpr,
+      VhpiLexicalScope,
+      VhpiLhsExpr,
+      VhpiLocal,
+      VhpiLogicalExpr,
+      VhpiName,
+      VhpiOperator,
+      VhpiOthersLiteral,
+      VhpiOutPort,
+      VhpiParamDecl,
+      VhpiParamExpr,
+      VhpiParent,
+      VhpiPhysLiteral,
+      VhpiPrefix,
+      VhpiPrimaryUnit,
+      VhpiProtectedTypeBody,
+      VhpiProtectedTypeDecl,
+      VhpiRejectTime,
+      VhpiReportExpr,
+      VhpiResolFunc,
+      VhpiReturnExpr,
+      VhpiReturnTypeMark,
+      VhpiRhsExpr,
+      VhpiRightExpr,
+      VhpiRootInst,
+      VhpiSelectExpr,
+      VhpiSeverityExpr,
+      VhpiSimpleName,
+      VhpiSubpBody,
+      VhpiSubpDecl,
+      VhpiSubtype,
+      VhpiSuffix,
+      VhpiTimeExpr,
+      VhpiTimeOutExpr,
+      VhpiTool,
+      VhpiTypeMark,
+      VhpiUnitDecl,
+      VhpiUpStack,
+      VhpiUpperRegion,
+      VhpiValExpr,
+      VhpiValSubtype
+     );
+
+   --  Methods used to traverse 1 to many relationships.
+   type VhpiOneToManyT is
+     (
+      VhpiAliasDecls,
+      VhpiArgvs,
+      VhpiAttrDecls,
+      VhpiAttrSpecs,
+      VhpiBasicSignals,
+      VhpiBlockStmts,
+      VhpiBranchs,
+      VhpiCallbacks,
+      VhpiChoices,
+      VhpiCompInstStmts,
+      VhpiCondExprs,
+      VhpiCondWaveforms,
+      VhpiConfigItems,
+      VhpiConfigSpecs,
+      VhpiConstDecls,
+      VhpiConstraints,
+      VhpiContributors,
+      VhpiCurRegions,
+      VhpiDecls,
+      VhpiDepUnits,
+      VhpiDesignUnits,
+      VhpiDrivenSigs,
+      VhpiDrivers,
+      VhpiElemAssocs,
+      VhpiEntityClassEntrys,
+      VhpiEntityDesignators,
+      VhpiEnumLiterals,
+      VhpiForeignfs,
+      VhpiGenericAssocs,
+      VhpiGenericDecls,
+      VhpiIndexExprs,
+      VhpiIndexedNames,
+      VhpiInternalRegions,
+      VhpiMembers,
+      VhpiPackInsts,
+      VhpiParamAssocs,
+      VhpiParamDecls,
+      VhpiPortAssocs,
+      VhpiPortDecls,
+      VhpiRecordElems,
+      VhpiSelectWaveforms,
+      VhpiSelectedNames,
+      VhpiSensitivitys,
+      VhpiSeqStmts,
+      VhpiSigAttrs,
+      VhpiSigDecls,
+      VhpiSigNames,
+      VhpiSignals,
+      VhpiSpecNames,
+      VhpiSpecs,
+      VhpiStmts,
+      VhpiTransactions,
+      VhpiTypeMarks,
+      VhpiUnitDecls,
+      VhpiUses,
+      VhpiVarDecls,
+      VhpiWaveformElems,
+      VhpiLibraryDecls
+     );
+
+   --  String properties.
+   type VhpiStrPropertyT is
+     (
+      VhpiCaseNameP,
+      VhpiCompNameP,
+      VhpiDefNameP,
+      VhpiFileNameP,
+      VhpiFullCaseNameP,
+      VhpiFullNameP,
+      VhpiKindStrP,
+      VhpiLabelNameP,
+      VhpiLibLogicalNameP,
+      VhpiLibPhysicalNameP,
+      VhpiLogicalNameP,
+      VhpiLoopLabelNameP,
+      VhpiNameP,
+      VhpiOpNameP,
+      VhpiStrValP,
+      VhpiToolVersionP,
+      VhpiUnitNameP
+     );
+
+   --  Possible Errors.
+   type AvhpiErrorT is
+     (
+      AvhpiErrorOk,
+      AvhpiErrorBadRel,
+      AvhpiErrorHandle,
+      AvhpiErrorNotImplemented,
+      AvhpiErrorIteratorEnd
+     );
+
+   type VhpiHandleT is private;
+
+   --  A null handle.
+   Null_Handle : constant VhpiHandleT;
+
+   --  Get the root instance.
+   procedure Get_Root_Inst (Res : out VhpiHandleT);
+
+   --  Get the instanciated packages.
+   procedure Get_Package_Inst (Res : out VhpiHandleT);
+
+   procedure Vhpi_Handle (Rel : VhpiOneToOneT;
+                          Ref : VhpiHandleT;
+                          Res : out VhpiHandleT;
+                          Error : out AvhpiErrorT);
+
+   procedure Vhpi_Iterator (Rel : VhpiOneToManyT;
+                            Ref : VhpiHandleT;
+                            Res : out VhpiHandleT;
+                            Error : out AvhpiErrorT);
+   procedure Vhpi_Scan (Iterator : in out VhpiHandleT;
+                        Res : out VhpiHandleT;
+                        Error : out AvhpiErrorT);
+
+   procedure Vhpi_Get_Str (Property : VhpiStrPropertyT;
+                           Obj : VhpiHandleT;
+                           Res : out String;
+                           Len : out Natural);
+
+   --  Almost the same as Vhpi_Get_Str (VhpiName, OBJ), but there is not
+   --  indexes for generate stmt.
+   function Avhpi_Get_Base_Name (Obj : VhpiHandleT) return Ghdl_C_String;
+
+   --  Return TRUE iff HDL1 and HDL2 are equivalent.
+   function Vhpi_Compare_Handles (Hdl1, Hdl2 : VhpiHandleT)
+                                 return Boolean;
+
+--    procedure Vhpi_Handle_By_Simple_Name (Ref : VhpiHandleT;
+--                                          Res : out VhpiHandleT;
+--                                          Error : out AvhpiErrorT);
+
+   type VhpiEntityClassT is
+     (
+      VhpiErrorEC,
+      VhpiEntityEC,
+      VhpiArchitectureEC,
+      VhpiConfigurationEC,
+      VhpiProcedureEC,
+      VhpiFunctionEC,
+      VhpiPackageEC,
+      VhpiTypeEC,
+      VhpiSubtypeEC,
+      VhpiConstantEC,
+      VhpiSignalEC,
+      VhpiVariableEC,
+      VhpiComponentEC,
+      VhpiLabelEC,
+      VhpiLiteralEC,
+      VhpiUnitsEC,
+      VhpiFileEC,
+      VhpiGroupEC
+     );
+
+   function Vhpi_Get_EntityClass (Obj : VhpiHandleT)
+                                 return VhpiEntityClassT;
+
+   type VhpiModeP is
+     (
+      VhpiErrorMode,
+      VhpiInMode,
+      VhpiOutMode,
+      VhpiInoutMode,
+      VhpiBufferMode,
+      VhpiLinkageMode
+     );
+   function Vhpi_Get_Mode (Obj : VhpiHandleT) return VhpiModeP;
+
+   function Avhpi_Get_Rti (Obj : VhpiHandleT) return Ghdl_Rti_Access;
+
+   function Avhpi_Get_Address (Obj : VhpiHandleT) return Address;
+
+   function Avhpi_Get_Context (Obj : VhpiHandleT) return Rti_Context;
+
+   function Vhpi_Get_Kind (Obj : VhpiHandleT) return VhpiClassKindT;
+
+   function Vhpi_Put_Value (Obj : VhpiHandleT; Val : Ghdl_I64)
+                           return AvhpiErrorT;
+private
+   type VhpiHandleT (Kind : VhpiClassKindT := VhpiUndefined) is record
+      --  Context.
+      Ctxt : Rti_Context;
+
+      case Kind is
+         when VhpiIteratorK =>
+            Rel : VhpiOneToManyT;
+            It_Cur : Ghdl_Index_Type;
+            It2 : Ghdl_Index_Type;
+            Max2 : Ghdl_Index_Type;
+         when AvhpiNameIteratorK
+           | VhpiIndexedNameK =>
+            N_Addr : Address;
+            N_Type : Ghdl_Rti_Access;
+            N_Idx : Ghdl_Index_Type;
+            N_Obj : Ghdl_Rtin_Object_Acc;
+         when VhpiSigDeclK
+           | VhpiPortDeclK
+           | VhpiGenericDeclK
+           | VhpiConstDeclK =>
+            Obj : Ghdl_Rtin_Object_Acc;
+         when VhpiSubtypeIndicK
+           | VhpiSubtypeDeclK
+           | VhpiArrayTypeDeclK
+           | VhpiEnumTypeDeclK =>
+            Atype : Ghdl_Rti_Access;
+         when VhpiCompInstStmtK =>
+            Inst : Ghdl_Rtin_Instance_Acc;
+         when others =>
+            null;
+      end case;
+      --  Current Object.
+      --Obj : Ghdl_Rti_Access;
+   end record;
+
+   Null_Handle : constant VhpiHandleT := (Kind => VhpiUndefined,
+                                          Ctxt => (Base => Null_Address,
+                                                   Block => null));
+end Grt.Avhpi;
diff --git a/translate/grt/grt-avls.adb b/translate/grt/grt-avls.adb
new file mode 100644
index 000000000..c44f329f8
--- /dev/null
+++ b/translate/grt/grt-avls.adb
@@ -0,0 +1,242 @@
+--  GHDL Run Time (GRT) - binary balanced tree.
+--  Copyright (C) 2002, 2003, 2004, 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.Errors; use Grt.Errors;
+
+package body Grt.Avls is
+   function Get_Height (Tree: AVL_Tree; N : AVL_Nid) return Ghdl_I32 is
+   begin
+      if N = AVL_Nil then
+         return 0;
+      else
+         return Tree (N).Height;
+      end if;
+   end Get_Height;
+
+   procedure Check_AVL (Tree : AVL_Tree; N : AVL_Nid)
+   is
+      L, R : AVL_Nid;
+      Lh, Rh : Ghdl_I32;
+      H : Ghdl_I32;
+   begin
+      if N = AVL_Nil then
+         return;
+      end if;
+      L := Tree (N).Left;
+      R := Tree (N).Right;
+      H := Get_Height (Tree, N);
+      if L = AVL_Nil and R = AVL_Nil then
+         if Get_Height (Tree, N) /= 1 then
+            Internal_Error ("check_AVL(1)");
+         end if;
+         return;
+      elsif L = AVL_Nil then
+         Check_AVL (Tree, R);
+         if H /= Get_Height (Tree, R) + 1 or H > 2 then
+            Internal_Error ("check_AVL(2)");
+         end if;
+      elsif R = AVL_Nil then
+         Check_AVL (Tree, L);
+         if H /= Get_Height (Tree, L) + 1 or H > 2 then
+            Internal_Error ("check_AVL(3)");
+         end if;
+      else
+         Check_AVL (Tree, L);
+         Check_AVL (Tree, R);
+         Lh := Get_Height (Tree, L);
+         Rh := Get_Height (Tree, R);
+         if Ghdl_I32'Max (Lh, Rh) + 1 /= H then
+            Internal_Error ("check_AVL(4)");
+         end if;
+         if Rh - Lh > 1 or Rh - Lh < -1 then
+            Internal_Error ("check_AVL(5)");
+         end if;
+      end if;
+   end Check_AVL;
+
+   procedure Compute_Height (Tree : in out AVL_Tree; N : AVL_Nid)
+   is
+   begin
+      Tree (N).Height :=
+        Ghdl_I32'Max (Get_Height (Tree, Tree (N).Left),
+                      Get_Height (Tree, Tree (N).Right)) + 1;
+   end Compute_Height;
+
+   procedure Simple_Rotate_Right (Tree : in out AVL_Tree; N : AVL_Nid)
+   is
+      R : AVL_Nid;
+      V : AVL_Value;
+   begin
+      --  Rotate nodes.
+      R := Tree (N).Right;
+      Tree (N).Right := Tree (R).Right;
+      Tree (R).Right := Tree (R).Left;
+      Tree (R).Left := Tree (N).Left;
+      Tree (N).Left := R;
+      --  Swap vals.
+      V := Tree (N).Val;
+      Tree (N).Val := Tree (R).Val;
+      Tree (R).Val := V;
+      --  Adjust bal.
+      Compute_Height (Tree, R);
+      Compute_Height (Tree, N);
+   end Simple_Rotate_Right;
+
+   procedure Simple_Rotate_Left (Tree : in out AVL_Tree; N : AVL_Nid)
+   is
+      L : AVL_Nid;
+      V : AVL_Value;
+   begin
+      L := Tree (N).Left;
+      Tree (N).Left := Tree (L).Left;
+      Tree (L).Left := Tree (L).Right;
+      Tree (L).Right := Tree (N).Right;
+      Tree (N).Right := L;
+      V := Tree (N).Val;
+      Tree (N).Val := Tree (L).Val;
+      Tree (L).Val := V;
+      Compute_Height (Tree, L);
+      Compute_Height (Tree, N);
+   end Simple_Rotate_Left;
+
+   procedure Double_Rotate_Right (Tree : in out AVL_Tree; N : AVL_Nid)
+   is
+      R : AVL_Nid;
+   begin
+      R := Tree (N).Right;
+      Simple_Rotate_Left (Tree, R);
+      Simple_Rotate_Right (Tree, N);
+   end Double_Rotate_Right;
+
+   procedure Double_Rotate_Left (Tree : in out AVL_Tree; N : AVL_Nid)
+   is
+      L : AVL_Nid;
+   begin
+      L := Tree (N).Left;
+      Simple_Rotate_Right (Tree, L);
+      Simple_Rotate_Left (Tree, N);
+   end Double_Rotate_Left;
+
+   procedure Insert (Tree : in out AVL_Tree;
+                    Cmp : AVL_Compare_Func;
+                    Val : AVL_Nid;
+                    N : AVL_Nid;
+                    Res : out AVL_Nid)
+   is
+      Diff : Integer;
+      Op_Ch, Ch : AVL_Nid;
+   begin
+      Diff := Cmp.all (Tree (Val).Val, Tree (N).Val);
+      if Diff = 0 then
+         Res := N;
+         return;
+      end if;
+      if Diff < 0 then
+         if Tree (N).Left = AVL_Nil then
+            Tree (N).Left := Val;
+            Compute_Height (Tree, N);
+            --  N is balanced.
+            Res := Val;
+         else
+            Ch := Tree (N).Left;
+            Op_Ch := Tree (N).Right;
+            Insert (Tree, Cmp, Val, Ch, Res);
+            if Res /= Val then
+               return;
+            end if;
+            if Get_Height (Tree, Ch) - Get_Height (Tree, Op_Ch) = 2 then
+               --  Rotate
+               if Get_Height (Tree, Tree (Ch).Left)
+                 > Get_Height (Tree, Tree (Ch).Right)
+               then
+                  Simple_Rotate_Left (Tree, N);
+               else
+                  Double_Rotate_Left (Tree, N);
+               end if;
+            else
+               Compute_Height (Tree, N);
+            end if;
+         end if;
+      else
+         if Tree (N).Right = AVL_Nil then
+            Tree (N).Right := Val;
+            Compute_Height (Tree, N);
+            --  N is balanced.
+            Res := Val;
+         else
+            Ch := Tree (N).Right;
+            Op_Ch := Tree (N).Left;
+            Insert (Tree, Cmp, Val, Ch, Res);
+            if Res /= Val then
+               return;
+            end if;
+            if Get_Height (Tree, Ch) - Get_Height (Tree, Op_Ch) = 2 then
+               --  Rotate
+               if Get_Height (Tree, Tree (Ch).Right)
+                 > Get_Height (Tree, Tree (Ch).Left)
+               then
+                  Simple_Rotate_Right (Tree, N);
+               else
+                  Double_Rotate_Right (Tree, N);
+               end if;
+            else
+               Compute_Height (Tree, N);
+            end if;
+         end if;
+      end if;
+   end Insert;
+
+   procedure Get_Node (Tree : in out AVL_Tree;
+                       Cmp : AVL_Compare_Func;
+                       N : AVL_Nid;
+                       Res : out AVL_Nid)
+   is
+   begin
+      if Tree'First /= AVL_Root or N /= Tree'Last then
+         Internal_Error ("avls.get_node");
+      end if;
+      Insert (Tree, Cmp, N, AVL_Root, Res);
+      Check_AVL (Tree, AVL_Root);
+   end Get_Node;
+
+   function Find_Node (Tree : AVL_Tree;
+                       Cmp : AVL_Compare_Func;
+                       Val : AVL_Value) return AVL_Nid
+   is
+      N : AVL_Nid;
+      Diff : Integer;
+   begin
+      N := AVL_Root;
+      if Tree'Last < AVL_Root then
+         return AVL_Nil;
+      end if;
+      loop
+         Diff := Cmp.all (Val, Tree (N).Val);
+         if Diff = 0 then
+            return N;
+         end if;
+         if Diff < 0 then
+            N := Tree (N).Left;
+         else
+            N := Tree (N).Right;
+         end if;
+         if N = AVL_Nil then
+            return AVL_Nil;
+         end if;
+      end loop;
+   end Find_Node;
+end Grt.Avls;
diff --git a/translate/grt/grt-avls.ads b/translate/grt/grt-avls.ads
new file mode 100644
index 000000000..e2688f64f
--- /dev/null
+++ b/translate/grt/grt-avls.ads
@@ -0,0 +1,77 @@
+--  GHDL Run Time (GRT) - binary balanced tree.
+--  Copyright (C) 2002, 2003, 2004, 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 Grt.Avls is
+   --  Implementation of a binary balanced tree.
+   --  This package is very generic, and provides only the algorithm.
+   --  The user must provide the storage of the tree.
+   --  The basic types of this implementation ares:
+   --  * AVL_Value: the value stored in the tree.  This is an integer on 32
+   --    bits.  However, they may either really represent integers or an index
+   --    into another table.  To compare two values, a user function is always
+   --    provided.
+   --  * AVL_Nid: a node id or an index into the tree.
+   --  * AVL_Node: a node, indexed by AVL_Nid.
+   --  * AVL_Tree: an array of AVL_Node, indexed by AVL_Nid.  This represents
+   --    the tree.  The root of the tree is always AVL_Root, which is the
+   --    first element of the array.
+   --
+   --  As a choice, this package never allocate nodes.  So, to insert a value
+   --  in the tree, the user must allocate an (empty) node, set the value of
+   --  the node and try to insert this node into the tree.  If the value is
+   --  already in the tree, Get_Node will returns the node id which contains
+   --  the value.  Otherwise, Get_Node returns the node just created by the
+   --  user.
+
+   --  The value in an AVL tree.
+   --  This is fixed.
+   type AVL_Value is new Ghdl_I32;
+
+   --  An AVL node id.
+   type AVL_Nid is new Ghdl_I32;
+   AVL_Nil : constant AVL_Nid := 0;
+   AVL_Root : constant AVL_Nid := 1;
+
+   type AVL_Node is record
+      Val : AVL_Value;
+      Left : AVL_Nid;
+      Right : AVL_Nid;
+      Height : Ghdl_I32;
+   end record;
+
+   type AVL_Tree is array (AVL_Nid range <>) of AVL_Node;
+
+   --  Compare two values.
+   --  Returns < 0 if L < R, 0 if L = R, > 0 if L > R.
+   type AVL_Compare_Func is access function (L, R : AVL_Value) return Integer;
+
+   --  Try to insert node N into TREE.
+   --  Returns either N or the node id of a node containing already the value.
+   procedure Get_Node (Tree : in out AVL_Tree;
+                       Cmp : AVL_Compare_Func;
+                       N : AVL_Nid;
+                       Res : out AVL_Nid);
+
+   function Find_Node (Tree : AVL_Tree;
+                       Cmp : AVL_Compare_Func;
+                       Val : AVL_Value) return AVL_Nid;
+
+end Grt.Avls;
+
+
diff --git a/translate/grt/grt-cbinding.c b/translate/grt/grt-cbinding.c
new file mode 100644
index 000000000..bb0bd17be
--- /dev/null
+++ b/translate/grt/grt-cbinding.c
@@ -0,0 +1,90 @@
+/*  GRT C bindings.
+    Copyright (C) 2002, 2003, 2004, 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.
+*/
+#include <stdio.h>
+#include <stdlib.h>
+#include <setjmp.h>
+
+FILE *
+__ghdl_get_stdout (void)
+{
+  return stdout;
+}
+
+FILE *
+__ghdl_get_stdin (void)
+{
+  return stdin;
+}
+
+FILE *
+__ghdl_get_stderr (void)
+{
+  return stderr;
+}
+
+static int run_env_en;
+static jmp_buf run_env;
+
+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;
+  res = setjmp (run_env);
+  if (res == 0)
+    res = (*func)();
+  run_env_en = 0;
+  return res;
+}
+
+#if 1
+void
+__gnat_last_chance_handler (void)
+{
+  abort ();
+}
+
+void *
+__gnat_malloc (size_t size)
+{
+  void *res;
+  res = malloc (size);
+  return res;
+}
+
+void
+__gnat_free (void *ptr)
+{
+  free (ptr);
+}
+
+void *
+__gnat_realloc (void *ptr, size_t size)
+{
+  return realloc (ptr, size);
+}
+#endif
diff --git a/translate/grt/grt-cvpi.c b/translate/grt/grt-cvpi.c
new file mode 100644
index 000000000..51edd678f
--- /dev/null
+++ b/translate/grt/grt-cvpi.c
@@ -0,0 +1,277 @@
+/*  GRT VPI C helpers.
+    Copyright (C) 2003, 2004, 2005 Tristan Gingold & Felix Bertram
+
+    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.
+*/
+//-----------------------------------------------------------------------------
+// Description: VPI interface for GRT runtime, "C" helpers
+//              the main purpose of this code is to interface with the
+//              Icarus Verilog Interactive (IVI) simulator GUI
+//-----------------------------------------------------------------------------
+
+#include <stdio.h>
+#include <stdlib.h>
+
+//-----------------------------------------------------------------------------
+// VPI callback functions
+typedef void *vpiHandle, *p_vpi_time, *p_vpi_value;
+typedef struct t_cb_data {
+      int reason;
+      int (*cb_rtn)(struct t_cb_data*cb);
+      vpiHandle obj;
+      p_vpi_time time;
+      p_vpi_value value;
+      int index;
+      char*user_data;
+} s_cb_data, *p_cb_data;
+
+//-----------------------------------------------------------------------------
+// vpi thunking a la Icarus Verilog
+#include <stdarg.h>
+typedef void *s_vpi_time, *p_vpi_vlog_info, *p_vpi_error_info;
+#define VPI_THUNK_MAGIC  (0x87836BA5)
+struct t_vpi_systf_data;
+void         vpi_register_systf  (const struct t_vpi_systf_data*ss);
+void         vpi_vprintf         (const char*fmt, va_list ap);
+unsigned int vpi_mcd_close       (unsigned int mcd);
+char *       vpi_mcd_name        (unsigned int mcd);
+unsigned int vpi_mcd_open        (char *name);
+unsigned int vpi_mcd_open_x      (char *name, char *mode);
+int          vpi_mcd_vprintf     (unsigned int mcd, const char*fmt, va_list ap);
+int          vpi_mcd_fputc       (unsigned int mcd, unsigned char x);
+int          vpi_mcd_fgetc       (unsigned int mcd);
+vpiHandle    vpi_register_cb     (p_cb_data data);
+int          vpi_remove_cb       (vpiHandle ref);
+void         vpi_sim_vcontrol    (int operation, va_list ap);
+vpiHandle    vpi_handle          (int type, vpiHandle ref);
+vpiHandle    vpi_iterate         (int type, vpiHandle ref);
+vpiHandle    vpi_scan            (vpiHandle iter);
+vpiHandle    vpi_handle_by_index (vpiHandle ref, int index);
+void         vpi_get_time        (vpiHandle obj, s_vpi_time*t);
+int          vpi_get             (int property, vpiHandle ref);
+char*        vpi_get_str         (int property, vpiHandle ref);
+void         vpi_get_value       (vpiHandle expr, p_vpi_value value);
+vpiHandle    vpi_put_value       (vpiHandle obj, p_vpi_value value,
+                                  p_vpi_time when, int flags);
+int          vpi_free_object     (vpiHandle ref);
+int          vpi_get_vlog_info   (p_vpi_vlog_info vlog_info_p);
+int          vpi_chk_error       (p_vpi_error_info info);
+vpiHandle    vpi_handle_by_name  (char *name, vpiHandle scope);
+
+typedef struct {
+	int magic;
+	void         (*vpi_register_systf) (const struct t_vpi_systf_data*ss);
+	void         (*vpi_vprintf)        (const char*fmt, va_list ap);
+	unsigned int (*vpi_mcd_close)      (unsigned int mcd);
+	char*        (*vpi_mcd_name)       (unsigned int mcd);
+	unsigned int (*vpi_mcd_open)       (char *name);
+	unsigned int (*vpi_mcd_open_x)     (char *name, char *mode);
+	int          (*vpi_mcd_vprintf)    (unsigned int mcd, const char*fmt, va_list ap);
+	int          (*vpi_mcd_fputc)      (unsigned int mcd, unsigned char x);
+	int          (*vpi_mcd_fgetc)      (unsigned int mcd);
+	vpiHandle    (*vpi_register_cb)    (p_cb_data data);
+	int          (*vpi_remove_cb)      (vpiHandle ref);
+	void         (*vpi_sim_vcontrol)   (int operation, va_list ap);
+	vpiHandle    (*vpi_handle)         (int type, vpiHandle ref);
+	vpiHandle    (*vpi_iterate)        (int type, vpiHandle ref);
+	vpiHandle    (*vpi_scan)           (vpiHandle iter);
+	vpiHandle    (*vpi_handle_by_index)(vpiHandle ref, int index);
+	void         (*vpi_get_time)       (vpiHandle obj, s_vpi_time*t);
+	int          (*vpi_get)            (int property, vpiHandle ref);
+	char*        (*vpi_get_str)        (int property, vpiHandle ref);
+	void         (*vpi_get_value)      (vpiHandle expr, p_vpi_value value);
+	vpiHandle    (*vpi_put_value)      (vpiHandle obj, p_vpi_value value,
+	                                    p_vpi_time when, int flags);
+	int          (*vpi_free_object)    (vpiHandle ref);
+	int          (*vpi_get_vlog_info)  (p_vpi_vlog_info vlog_info_p);
+	int          (*vpi_chk_error)      (p_vpi_error_info info);
+	vpiHandle    (*vpi_handle_by_name) (char *name, vpiHandle scope);
+} vpi_thunk, *p_vpi_thunk;
+
+int vpi_register_sim(p_vpi_thunk tp);
+
+static vpi_thunk thunkTable = 
+{	VPI_THUNK_MAGIC,
+	vpi_register_systf,
+	vpi_vprintf,
+	vpi_mcd_close,
+	vpi_mcd_name,
+	vpi_mcd_open,
+	0, //vpi_mcd_open_x,
+	0, //vpi_mcd_vprintf,
+	0, //vpi_mcd_fputc,
+	0, //vpi_mcd_fgetc,
+	vpi_register_cb,
+	vpi_remove_cb,
+	0, //vpi_sim_vcontrol,
+	vpi_handle,
+	vpi_iterate,
+	vpi_scan,
+	vpi_handle_by_index,
+	vpi_get_time,
+	vpi_get,
+	vpi_get_str,
+	vpi_get_value,
+	vpi_put_value,
+	vpi_free_object,
+	vpi_get_vlog_info,
+	0, //vpi_chk_error,
+	0 //vpi_handle_by_name
+};
+
+//-----------------------------------------------------------------------------
+// VPI module load & startup
+static void * module_open (const char *path);
+static void * module_symbol (void *handle, const char *symbol);
+static const char *module_error (void);
+
+#if defined(__WIN32__)
+#include <windows.h>
+static void *
+module_open (const char *path)
+{
+  return (void *)LoadLibrary (path);
+}
+
+static void *
+module_symbol (void *handle, const char *symbol)
+{
+  return (void *)GetProcAddress ((HMODULE)handle, symbol);
+}
+
+static const char *
+module_error (void)
+{
+  static char msg[256];
+
+  FormatMessage
+    (FORMAT_MESSAGE_FROM_SYSTEM | FORMAT_MESSAGE_IGNORE_INSERTS,
+     NULL,
+     GetLastError (),
+     MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT),
+     (LPTSTR) &msg,
+     sizeof (msg) - 1,
+     NULL);
+  return msg;
+}
+#else
+#include <dlfcn.h>
+static void *
+module_open (const char *path)
+{
+  return dlopen (path, RTLD_LAZY);
+}
+
+static void *
+module_symbol (void *handle, const char *symbol)
+{
+  return dlsym (handle, symbol);
+}
+
+static const char *
+module_error (void)
+{
+  return dlerror ();
+}
+#endif
+
+int
+loadVpiModule (const char* modulename)
+{
+  static const char * const vpitablenames[] =
+    {
+      "_vlog_startup_routines", // with leading underscore: MacOSX
+      "vlog_startup_routines"   // w/o  leading underscore: Linux
+    };
+  static const char * const vpithunknames[] =
+    {
+      "_vpi_register_sim",      // with leading underscore: MacOSX
+      "vpi_register_sim"        // w/o  leading underscore: Linux
+    };
+
+  int i;	
+  void* vpimod;
+
+  fprintf (stderr, "loading VPI module '%s'\n", modulename);
+
+  vpimod = module_open (modulename);
+
+  if (vpimod == NULL)
+    {
+      const char *msg;
+
+      msg = module_error ();
+
+      fprintf (stderr, "%s\n", msg == NULL ? "unknown dlopen error" : msg);
+      return -1;
+    }
+
+  for (i = 0; i < 2; i++) // try with and w/o leading underscores
+    {
+      void* vpithunk;
+      void* vpitable;
+	  
+      vpitable = module_symbol (vpimod, vpitablenames[i]);
+      vpithunk = module_symbol (vpimod, vpithunknames[i]);
+	  
+      if (vpithunk)
+	{
+	  typedef int (*funT)(p_vpi_thunk tp);
+	  funT regsim;
+	  
+	  regsim = (funT)vpithunk;
+	  regsim (&thunkTable);
+	}
+      else
+	{
+	  // this is not an error, as the register-mechanism
+	  // is not standardized
+	}
+      
+      if (vpitable)
+	{
+	  unsigned int tmp;
+	  //extern void (*vlog_startup_routines[])();
+	  typedef void (*vlog_startup_routines_t)(void);
+	  vlog_startup_routines_t *vpifuns;
+				
+	  vpifuns = (vlog_startup_routines_t*)vpitable;
+	  for (tmp = 0; vpifuns[tmp]; tmp++)
+	    {
+	      vpifuns[tmp]();
+	    }
+	  
+	  fprintf (stderr, "VPI module loaded!\n");
+	  return 0; // successfully registered VPI module
+	}
+    }
+  fprintf (stderr, "vlog_startup_routines not found\n");
+  return -1; // failed to register VPI module
+}
+
+void
+vpi_printf (const char *fmt, ...)
+{
+  va_list params;
+
+  va_start (params, fmt);
+  vprintf (fmt, params);
+  va_end (params);
+}
+
+//-----------------------------------------------------------------------------
+// end of file
+
diff --git a/translate/grt/grt-disp.adb b/translate/grt/grt-disp.adb
new file mode 100644
index 000000000..9bd803534
--- /dev/null
+++ b/translate/grt/grt-disp.adb
@@ -0,0 +1,203 @@
+--  GHDL Run Time (GRT) - Common display subprograms.
+--  Copyright (C) 2002, 2003, 2004, 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;
+with Grt.Signals; use Grt.Signals;
+with Grt.Astdio; use Grt.Astdio;
+with Grt.Stdio; use Grt.Stdio;
+--with Grt.Errors; use Grt.Errors;
+
+package body Grt.Disp is
+
+--    procedure Put_Trim (Stream : FILEs; Str : String)
+--    is
+--       Start : Natural;
+--    begin
+--       Start := Str'First;
+--       while Start <= Str'Last and then Str (Start) = ' ' loop
+--          Start := Start + 1;
+--       end loop;
+--       Put (Stream, Str (Start .. Str'Last));
+--    end Put_Trim;
+
+--   procedure Put_E8 (Stream : FILEs; E8 : Ghdl_E8; Type_Desc : Ghdl_Desc_Ptr)
+--    is
+--    begin
+--       Put_Str_Len (Stream, Type_Desc.E8.Values (Natural (E8)));
+--    end Put_E8;
+
+   --procedure Put_E32
+   --  (Stream : FILEs; E32 : Ghdl_E32; Type_Desc : Ghdl_Desc_Ptr)
+   --is
+   --begin
+   --   Put_Str_Len (Stream, Type_Desc.E32.Values (Natural (E32)));
+   --end Put_E32;
+
+   procedure Put_Sig_Index (Sig : Sig_Table_Index)
+   is
+   begin
+      Put_I32 (stdout, Ghdl_I32 (Sig));
+   end Put_Sig_Index;
+
+   procedure Put_Sig_Range (Sig : Sig_Table_Range)
+   is
+   begin
+      Put_Sig_Index (Sig.First);
+      if Sig.Last /= Sig.First then
+         Put ("-");
+         Put_Sig_Index (Sig.Last);
+      end if;
+   end Put_Sig_Range;
+
+   procedure Disp_Now
+   is
+   begin
+      Put ("Now is ");
+      Put_Time (stdout, Current_Time);
+      Put (" +");
+      Put_I32 (stdout, Ghdl_I32 (Current_Delta));
+      New_Line;
+   end Disp_Now;
+
+   procedure Disp_Propagation_Kind (Kind : Propagation_Kind_Type)
+   is
+   begin
+      case Kind is
+         when Drv_One_Driver =>
+            Put ("Drv (1 drv) ");
+         when Eff_One_Driver =>
+            Put ("Eff (1 drv) ");
+         when Drv_One_Port =>
+            Put ("Drv (1 prt) ");
+         when Eff_One_Port =>
+            Put ("Eff (1 prt) ");
+         when Imp_Guard =>
+            Put ("Guard ");
+         when Imp_Stable =>
+            Put ("Stable ");
+         when Imp_Quiet =>
+            Put ("imp quiet ");
+         when Imp_Transaction =>
+            Put ("imp transaction ");
+         when Imp_Delayed =>
+            Put ("imp delayed ");
+         when Eff_Actual =>
+            Put ("Eff Actual ");
+         when Eff_Multiple =>
+            Put ("Eff multiple ");
+         when Drv_One_Resolved =>
+            Put ("Drv 1 resolved ");
+         when Eff_One_Resolved =>
+            Put ("Eff 1 resolved ");
+         when In_Conversion =>
+            Put ("In conv ");
+         when Out_Conversion =>
+            Put ("Out conv ");
+         when Drv_Error =>
+            Put ("Drv error ");
+         when Drv_Multiple =>
+            Put ("Drv multiple ");
+         when Prop_End =>
+            Put ("end ");
+      end case;
+   end Disp_Propagation_Kind;
+
+   procedure Disp_Signals_Order is
+   begin
+      for I in Propagation.First .. Propagation.Last loop
+         Put_I32 (stdout, Ghdl_I32 (I));
+         Put (": ");
+         Disp_Propagation_Kind (Propagation.Table (I).Kind);
+         case Propagation.Table (I).Kind is
+            when Drv_One_Driver
+              | Eff_One_Driver
+              | Drv_One_Port
+              | Eff_One_Port
+              | Drv_One_Resolved
+              | Eff_One_Resolved
+              | Imp_Guard
+              | Imp_Stable
+              | Eff_Actual =>
+               Put_Sig_Index (Signal_Ptr_To_Index (Propagation.Table (I).Sig));
+               New_Line;
+            when Eff_Multiple
+              | Drv_Multiple =>
+               Put_Sig_Range (Propagation.Table (I).Resolv.Sig_Range);
+               New_Line;
+            when In_Conversion
+              | Out_Conversion =>
+               declare
+                  Conv : Sig_Conversion_Acc;
+               begin
+                  Conv := Propagation.Table (I).Conv;
+                  Put_Sig_Range (Conv.Src);
+                  Put (" -> ");
+                  Put_Sig_Range (Conv.Dest);
+                  New_Line;
+               end;
+            when Imp_Quiet
+              | Imp_Transaction
+              | Imp_Delayed
+              | Prop_End =>
+               New_Line;
+            when Drv_Error =>
+               null;
+         end case;
+      end loop;
+   end Disp_Signals_Order;
+
+   procedure Disp_Mode (Mode : Mode_Type)
+   is
+   begin
+      case Mode is
+         when Mode_B2 =>
+            Put (" b2");
+         when Mode_E8 =>
+            Put (" e8");
+         when Mode_E32 =>
+            Put ("e32");
+         when Mode_I32 =>
+            Put ("i32");
+         when Mode_I64 =>
+            Put ("i64");
+         when Mode_F64 =>
+            Put ("f64");
+      end case;
+   end Disp_Mode;
+
+   procedure Disp_Value (Value : Value_Union; Mode : Mode_Type) is
+   begin
+      case Mode is
+         when Mode_B2 =>
+            if Value.B2 then
+               Put ("T");
+            else
+               Put ("F");
+            end if;
+         when Mode_E8 =>
+            Put_I32 (stdout, Ghdl_I32 (Value.E8));
+         when Mode_E32 =>
+            Put_I32 (stdout, Ghdl_I32 (Value.E32));
+         when Mode_I32 =>
+            Put_I32 (stdout, Value.I32);
+         when Mode_I64 =>
+            Put_I64 (stdout, Value.I64);
+         when Mode_F64 =>
+            Put_F64 (stdout, Value.F64);
+      end case;
+   end Disp_Value;
+end Grt.Disp;
diff --git a/translate/grt/grt-disp.ads b/translate/grt/grt-disp.ads
new file mode 100644
index 000000000..4d3781cba
--- /dev/null
+++ b/translate/grt/grt-disp.ads
@@ -0,0 +1,39 @@
+--  GHDL Run Time (GRT) - Common display subprograms.
+--  Copyright (C) 2002, 2003, 2004, 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.Signals; use Grt.Signals;
+with Grt.Types; use Grt.Types;
+
+package Grt.Disp is
+   --  Display SIG number.
+   procedure Put_Sig_Index (Sig : Sig_Table_Index);
+
+   --  Disp current time and current delta.
+   procedure Disp_Now;
+
+   procedure Disp_Propagation_Kind (Kind : Propagation_Kind_Type);
+
+   --  Disp signals propagation order.
+   procedure Disp_Signals_Order;
+
+   --  Disp mode.
+   procedure Disp_Mode (Mode : Mode_Type);
+
+   --  Disp value (numeric).
+   procedure Disp_Value (Value : Value_Union; Mode : Mode_Type);
+
+end Grt.Disp;
diff --git a/translate/grt/grt-disp_rti.adb b/translate/grt/grt-disp_rti.adb
new file mode 100644
index 000000000..47e5ac6ce
--- /dev/null
+++ b/translate/grt/grt-disp_rti.adb
@@ -0,0 +1,1369 @@
+--  GHDL Run Time (GRT) - RTI dumper.
+--  Copyright (C) 2002, 2003, 2004, 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; use System;
+with Grt.Rtis; use Grt.Rtis;
+with Grt.Stdio; use Grt.Stdio;
+with Grt.Astdio; use Grt.Astdio;
+with Grt.Types; use Grt.Types;
+with Grt.Errors; use Grt.Errors;
+--with Grt.Typedesc; use Grt.Typedesc;
+with Grt.Rtis_Addr; use Grt.Rtis_Addr;
+with Grt.Options; use Grt.Options;
+
+package body Grt.Disp_Rti is
+   procedure Disp_Kind (Kind : Ghdl_Rtik);
+
+   procedure Disp_Name (Name : Ghdl_C_String) is
+   begin
+      if Name = null then
+         Put (stdout, "<anonymous>");
+      else
+         Put (stdout, Name);
+      end if;
+   end Disp_Name;
+
+   --  Disp value stored at ADDR and whose type is described by RTI.
+   procedure Disp_Enum_Value
+     (Stream : FILEs; Rti : Ghdl_Rti_Access; Val : Ghdl_Index_Type)
+   is
+      Enum_Rti : Ghdl_Rtin_Type_Enum_Acc;
+   begin
+      Enum_Rti := To_Ghdl_Rtin_Type_Enum_Acc (Rti);
+      Put (Stream, Enum_Rti.Names (Val));
+   end Disp_Enum_Value;
+
+   procedure Disp_Scalar_Value
+     (Stream : FILEs;
+      Rti : Ghdl_Rti_Access;
+      Addr : in out Address;
+      Is_Sig : Boolean)
+   is
+      procedure Update (S : Ghdl_Index_Type) is
+      begin
+         Addr := Addr + (S / Storage_Unit);
+      end Update;
+
+      Vptr : Ghdl_Value_Ptr;
+   begin
+      if Is_Sig then
+         Vptr := To_Ghdl_Value_Ptr (To_Addr_Acc (Addr).all);
+         Update (Address'Size);
+      else
+         Vptr := To_Ghdl_Value_Ptr (Addr);
+      end if;
+
+      case Rti.Kind is
+         when Ghdl_Rtik_Type_I32 =>
+            Put_I32 (Stream, Vptr.I32);
+            if not Is_Sig then
+               Update (32);
+            end if;
+         when Ghdl_Rtik_Type_E8 =>
+            Disp_Enum_Value (Stream, Rti, Ghdl_Index_Type (Vptr.E8));
+            if not Is_Sig then
+               Update (8);
+            end if;
+         when Ghdl_Rtik_Type_B2 =>
+            Disp_Enum_Value (Stream, Rti,
+                             Ghdl_Index_Type (Ghdl_B2'Pos (Vptr.B2)));
+            if not Is_Sig then
+               Update (8);
+            end if;
+         when Ghdl_Rtik_Type_F64 =>
+            Put_F64 (Stream, Vptr.F64);
+            if not Is_Sig then
+               Update (64);
+            end if;
+         when Ghdl_Rtik_Type_P64 =>
+            Put_I64 (Stream, Vptr.I64);
+            Put (Stream, " ");
+            Put (Stream,
+                 To_Ghdl_Rtin_Unit_Acc
+                 (To_Ghdl_Rtin_Type_Physical_Acc (Rti).Units (0)).Name);
+            if not Is_Sig then
+               Update (64);
+            end if;
+         when others =>
+            Internal_Error ("disp_rti.disp_scalar_value");
+      end case;
+   end Disp_Scalar_Value;
+
+--    function Get_Scalar_Type_Kind (Rti : Ghdl_Rti_Access) return Ghdl_Rtik
+--    is
+--       Ndef : Ghdl_Rti_Access;
+--    begin
+--       if Rti.Kind = Ghdl_Rtik_Subtype_Scalar then
+--          Ndef := To_Ghdl_Rtin_Subtype_Scalar_Acc (Rti).Basetype;
+--       else
+--          Ndef := Rti;
+--       end if;
+--       case Ndef.Kind is
+--          when Ghdl_Rtik_Type_I32 =>
+--             return Ndef.Kind;
+--          when others =>
+--             return Ghdl_Rtik_Error;
+--       end case;
+--    end Get_Scalar_Type_Kind;
+
+   procedure Disp_Value (Stream : FILEs;
+                         Rti : Ghdl_Rti_Access;
+                         Ctxt : Rti_Context;
+                         Obj : in out Address;
+                         Is_Sig : Boolean);
+
+   procedure Disp_Array_Value_1 (Stream : FILEs;
+                                 El_Rti : Ghdl_Rti_Access;
+                                 Ctxt : Rti_Context;
+                                 Rngs : Ghdl_Range_Array;
+                                 Rtis : Ghdl_Rti_Arr_Acc;
+                                 Index : Ghdl_Index_Type;
+                                 Obj : in out Address;
+                                 Is_Sig : Boolean)
+   is
+      Length : Ghdl_Index_Type;
+   begin
+      Length := Range_To_Length (Rngs (Index), Get_Base_Type (Rtis (Index)));
+      Put (Stream, "(");
+      for I in 1 .. Length loop
+         if I /= 1 then
+            Put (Stream, ", ");
+         end if;
+         if Index = Rngs'Last then
+            Disp_Value (Stream, El_Rti, Ctxt, Obj, Is_Sig);
+         else
+            Disp_Array_Value_1
+              (Stream, El_Rti, Ctxt, Rngs, Rtis, Index + 1, Obj, Is_Sig);
+         end if;
+      end loop;
+      Put (Stream, ")");
+   end Disp_Array_Value_1;
+
+   procedure Disp_Array_Value (Stream : FILEs;
+                               Rti : Ghdl_Rtin_Type_Array_Acc;
+                               Ctxt : Rti_Context;
+                               Vals : Ghdl_Uc_Array_Acc;
+                               Is_Sig : Boolean)
+   is
+      Nbr_Dim : Ghdl_Index_Type := Rti.Nbr_Dim;
+      Rngs : Ghdl_Range_Array (0 .. Nbr_Dim - 1);
+      Obj : Address;
+   begin
+      Bound_To_Range (Vals.Bounds, Rti, Rngs);
+      Obj := Vals.Base;
+      Disp_Array_Value_1
+        (Stream, Rti.Element, Ctxt, Rngs, Rti.Indexes, 0, Obj, Is_Sig);
+   end Disp_Array_Value;
+
+   procedure Disp_Record_Value (Stream : FILEs;
+                                Rti : Ghdl_Rtin_Type_Record_Acc;
+                                Ctxt : Rti_Context;
+                                Obj : in out Address;
+                                Is_Sig : Boolean)
+   is
+      El : Ghdl_Rtin_Element_Acc;
+      El_Addr : Address;
+   begin
+      Put (Stream, "(");
+      for I in 1 .. Rti.Nbrel loop
+         El := To_Ghdl_Rtin_Element_Acc (Rti.Elements (I - 1));
+         if I /= 1 then
+            Put (", ");
+         end if;
+         Put (Stream, El.Name);
+         Put (" => ");
+         if Is_Sig then
+            El_Addr := Obj + El.Sig_Off;
+         else
+            El_Addr := Obj + El.Val_Off;
+         end if;
+         Disp_Value (Stream, El.Eltype, Ctxt, El_Addr, Is_Sig);
+      end loop;
+      Put (")");
+      --  FIXME: update ADDR.
+   end Disp_Record_Value;
+
+   procedure Disp_Value
+     (Stream : FILEs;
+      Rti : Ghdl_Rti_Access;
+      Ctxt : Rti_Context;
+      Obj : in out Address;
+      Is_Sig : Boolean)
+   is
+   begin
+      case Rti.Kind is
+         when Ghdl_Rtik_Subtype_Scalar =>
+            Disp_Scalar_Value
+              (Stream, To_Ghdl_Rtin_Subtype_Scalar_Acc (Rti).Basetype,
+               Obj, Is_Sig);
+         when Ghdl_Rtik_Type_I32
+           | Ghdl_Rtik_Type_E8
+           | Ghdl_Rtik_Type_B2 =>
+            Disp_Scalar_Value (Stream, Rti, Obj, Is_Sig);
+         when Ghdl_Rtik_Type_Array =>
+            Disp_Array_Value (Stream, To_Ghdl_Rtin_Type_Array_Acc (Rti), Ctxt,
+                              To_Ghdl_Uc_Array_Acc (Obj), Is_Sig);
+         when Ghdl_Rtik_Subtype_Array =>
+            declare
+               St : Ghdl_Rtin_Subtype_Array_Acc :=
+                 To_Ghdl_Rtin_Subtype_Array_Acc (Rti);
+               Bt : Ghdl_Rtin_Type_Array_Acc := St.Basetype;
+               Rngs : Ghdl_Range_Array (0 .. Bt.Nbr_Dim - 1);
+               B : Address;
+            begin
+               Bound_To_Range
+                 (Loc_To_Addr (St.Common.Depth, St.Bounds, Ctxt), Bt, Rngs);
+               B := Obj;
+               Disp_Array_Value_1
+                 (Stream, Bt.Element, Ctxt, Rngs, Bt.Indexes, 0, B, Is_Sig);
+            end;
+         when Ghdl_Rtik_Subtype_Array_Ptr =>
+            declare
+               St : Ghdl_Rtin_Subtype_Array_Acc :=
+                 To_Ghdl_Rtin_Subtype_Array_Acc (Rti);
+               Bt : Ghdl_Rtin_Type_Array_Acc := St.Basetype;
+               Rngs : Ghdl_Range_Array (0 .. Bt.Nbr_Dim - 1);
+               B : Address;
+            begin
+               Bound_To_Range
+                 (Loc_To_Addr (St.Common.Depth, St.Bounds, Ctxt), Bt, Rngs);
+               B := To_Addr_Acc (Obj).all;
+               Disp_Array_Value_1
+                 (Stream, Bt.Element, Ctxt, Rngs, Bt.Indexes, 0, B, Is_Sig);
+            end;
+         when Ghdl_Rtik_Type_File =>
+            declare
+               Vptr : Ghdl_Value_Ptr;
+            begin
+               Vptr := To_Ghdl_Value_Ptr (Obj);
+               Put (Stream, "File#");
+               Put_I32 (Stream, Vptr.I32);
+               --  FIXME: update OBJ (not very useful since never in a
+               --   composite type).
+            end;
+         when Ghdl_Rtik_Type_Record =>
+            Disp_Record_Value
+              (Stream, To_Ghdl_Rtin_Type_Record_Acc (Rti), Ctxt, Obj, Is_Sig);
+         when others =>
+            Put (Stream, "??");
+      end case;
+   end Disp_Value;
+
+   procedure Disp_Kind (Kind : Ghdl_Rtik) is
+   begin
+      case Kind is
+         when Ghdl_Rtik_Top =>
+            Put ("ghdl_rtik_top");
+         when Ghdl_Rtik_Package =>
+            Put ("ghdl_rtik_package");
+         when Ghdl_Rtik_Package_Body =>
+            Put ("ghdl_rtik_package_body");
+         when Ghdl_Rtik_Entity =>
+            Put ("ghdl_rtik_entity");
+         when Ghdl_Rtik_Architecture =>
+            Put ("ghdl_rtik_architecture");
+
+         when Ghdl_Rtik_Port =>
+            Put ("ghdl_rtik_port");
+         when Ghdl_Rtik_Generic =>
+            Put ("ghdl_rtik_generic");
+         when Ghdl_Rtik_Process =>
+            Put ("ghdl_rtik_process");
+         when Ghdl_Rtik_Component =>
+            Put ("ghdl_rtik_component");
+         when Ghdl_Rtik_Attribute =>
+            Put ("ghdl_rtik_attribute");
+
+         when Ghdl_Rtik_Attribute_Quiet =>
+            Put ("ghdl_rtik_attribute_quiet");
+         when Ghdl_Rtik_Attribute_Stable =>
+            Put ("ghdl_rtik_attribute_stable");
+         when Ghdl_Rtik_Attribute_Transaction =>
+            Put ("ghdl_rtik_attribute_transaction");
+
+         when Ghdl_Rtik_Constant =>
+            Put ("ghdl_rtik_constant");
+         when Ghdl_Rtik_Iterator =>
+            Put ("ghdl_rtik_iterator");
+         when Ghdl_Rtik_Signal =>
+            Put ("ghdl_rtik_signal");
+         when Ghdl_Rtik_Variable =>
+            Put ("ghdl_rtik_variable");
+         when Ghdl_Rtik_Guard =>
+            Put ("ghdl_rtik_guard");
+         when Ghdl_Rtik_File =>
+            Put ("ghdl_rtik_file");
+
+         when Ghdl_Rtik_Instance =>
+            Put ("ghdl_rtik_instance");
+         when Ghdl_Rtik_Block =>
+            Put ("ghdl_rtik_block");
+         when Ghdl_Rtik_If_Generate =>
+            Put ("ghdl_rtik_if_generate");
+         when Ghdl_Rtik_For_Generate =>
+            Put ("ghdl_rtik_for_generate");
+
+         when Ghdl_Rtik_Type_B2 =>
+            Put ("ghdl_rtik_type_b2");
+         when Ghdl_Rtik_Type_E8 =>
+            Put ("ghdl_rtik_type_e8");
+         when Ghdl_Rtik_Type_P64 =>
+            Put ("ghdl_rtik_type_p64");
+         when Ghdl_Rtik_Type_I32 =>
+            Put ("ghdl_rtik_type_i32");
+
+         when Ghdl_Rtik_Type_Array =>
+            Put ("ghdl_rtik_type_array");
+         when Ghdl_Rtik_Subtype_Array =>
+            Put ("ghdl_rtik_subtype_array");
+         when Ghdl_Rtik_Subtype_Array_Ptr =>
+            Put ("ghdl_rtik_subtype_array_ptr");
+         when Ghdl_Rtik_Type_Record =>
+            Put ("ghdl_rtik_type_record");
+
+         when Ghdl_Rtik_Type_Access =>
+            Put ("ghdl_rtik_type_access");
+         when Ghdl_Rtik_Type_File =>
+            Put ("ghdl_rtik_type_file");
+
+         when Ghdl_Rtik_Subtype_Scalar =>
+            Put ("ghdl_rtik_subtype_scalar");
+
+         when Ghdl_Rtik_Element =>
+            Put ("ghdl_rtik_element");
+         when Ghdl_Rtik_Unit =>
+            Put ("ghdl_rtik_unit");
+
+         when others =>
+            Put ("ghdl_rtik_#");
+            Put_I32 (stdout, Ghdl_Rtik'Pos (Kind));
+      end case;
+   end Disp_Kind;
+
+   procedure Disp_Depth (Depth : Ghdl_Rti_Depth) is
+   begin
+      Put (", D=");
+      Put_I32 (stdout, Ghdl_I32 (Depth));
+   end Disp_Depth;
+
+   procedure Disp_Indent (Indent : Natural) is
+   begin
+      for I in 1 .. Indent loop
+         Put (' ');
+      end loop;
+   end Disp_Indent;
+
+   --  Disp a subtype_indication.
+   --  OBJ may be necessary when the subtype is an unconstrained array type,
+   --  whose bounds are stored with the object.
+   procedure Disp_Subtype_Indication
+     (Def : Ghdl_Rti_Access; Ctxt : Rti_Context; Obj : Address);
+
+   procedure Disp_Range
+     (Stream : FILEs; Kind : Ghdl_Rtik; Rng : Ghdl_Range_Ptr)
+   is
+   begin
+      case Kind is
+         when Ghdl_Rtik_Type_I32
+           | Ghdl_Rtik_Type_P32 =>
+            Put_I32 (Stream, Rng.I32.Left);
+            Put_Dir (Stream, Rng.I32.Dir);
+            Put_I32 (Stream, Rng.I32.Right);
+         when Ghdl_Rtik_Type_F64 =>
+            Put_F64 (Stream, Rng.F64.Left);
+            Put_Dir (Stream, Rng.F64.Dir);
+            Put_F64 (Stream, Rng.F64.Right);
+         when Ghdl_Rtik_Type_P64 =>
+            Put_I64 (Stream, Rng.P64.Left);
+            Put_Dir (Stream, Rng.P64.Dir);
+            Put_I64 (Stream, Rng.P64.Right);
+         when others =>
+            Put ("?Scal");
+      end case;
+   end Disp_Range;
+
+   procedure Disp_Scalar_Type_Name (Def : Ghdl_Rti_Access) is
+   begin
+      case Def.Kind is
+         when Ghdl_Rtik_Subtype_Scalar =>
+            declare
+               Rti : Ghdl_Rtin_Subtype_Scalar_Acc;
+            begin
+               Rti := To_Ghdl_Rtin_Subtype_Scalar_Acc (Def);
+               if Rti.Name /= null then
+                  Disp_Name (Rti.Name);
+               else
+                  Disp_Scalar_Type_Name (Rti.Basetype);
+               end if;
+            end;
+         when Ghdl_Rtik_Type_B2
+           | Ghdl_Rtik_Type_E8
+           | Ghdl_Rtik_Type_E32 =>
+            Disp_Name (To_Ghdl_Rtin_Type_Enum_Acc (Def).Name);
+         when Ghdl_Rtik_Type_I32
+           | Ghdl_Rtik_Type_I64 =>
+            Disp_Name (To_Ghdl_Rtin_Type_Scalar_Acc (Def).Name);
+         when others =>
+            Put ("#disp_scalar_type_name#");
+      end case;
+   end Disp_Scalar_Type_Name;
+
+   procedure Disp_Type_Array_Name (Def : Ghdl_Rtin_Type_Array_Acc;
+                                   Bounds_Ptr : Address)
+   is
+      Bounds : Address;
+
+      procedure Align (A : Ghdl_Index_Type) is
+      begin
+         Bounds := Align (Bounds, A);
+      end Align;
+
+      procedure Update (S : Ghdl_Index_Type) is
+      begin
+         Bounds := Bounds + (S / Storage_Unit);
+      end Update;
+
+      procedure Disp_Bounds (Def : Ghdl_Rti_Access)
+      is
+         Ndef : Ghdl_Rti_Access;
+      begin
+         if Bounds = Null_Address then
+            Put ("?");
+         else
+            if Def.Kind = Ghdl_Rtik_Subtype_Scalar then
+               Ndef := To_Ghdl_Rtin_Subtype_Scalar_Acc (Def).Basetype;
+            else
+               Ndef := Def;
+            end if;
+            case Ndef.Kind is
+               when Ghdl_Rtik_Type_I32 =>
+                  Align (Ghdl_Range_I32'Alignment);
+                  Disp_Range (stdout, Ndef.Kind, To_Ghdl_Range_Ptr (Bounds));
+                  Update (Ghdl_Range_I32'Size);
+               when others =>
+                  Disp_Kind (Ndef.Kind);
+                  --  Bounds are not known anymore.
+                  Bounds := Null_Address;
+            end case;
+         end if;
+      end Disp_Bounds;
+   begin
+      Disp_Name (Def.Name);
+      if Bounds_Ptr = Null_Address then
+         return;
+      end if;
+      Put (" (");
+      Bounds := Bounds_Ptr;
+      for I in 0 .. Def.Nbr_Dim - 1 loop
+         if I /= 0 then
+            Put (", ");
+         end if;
+         Disp_Scalar_Type_Name (Def.Indexes (I));
+         Put (" range ");
+         Disp_Bounds (Def.Indexes (I));
+      end loop;
+      Put (")");
+   end Disp_Type_Array_Name;
+
+   procedure Disp_Subtype_Scalar_Range
+     (Stream : FILEs; Def : Ghdl_Rtin_Subtype_Scalar_Acc; Ctxt : Rti_Context)
+   is
+      Range_Addr : Address;
+      Rng : Ghdl_Range_Ptr;
+   begin
+      Range_Addr := Loc_To_Addr (Def.Common.Depth,
+                                 Def.Range_Loc, Ctxt);
+      Rng := To_Ghdl_Range_Ptr (Range_Addr);
+      Disp_Range (Stream, Def.Basetype.Kind, Rng);
+   end Disp_Subtype_Scalar_Range;
+
+   procedure Disp_Subtype_Indication
+     (Def : Ghdl_Rti_Access; Ctxt : Rti_Context; Obj : Address)
+   is
+   begin
+      case Def.Kind is
+         when Ghdl_Rtik_Subtype_Scalar =>
+            declare
+               Rti : Ghdl_Rtin_Subtype_Scalar_Acc;
+            begin
+               Rti := To_Ghdl_Rtin_Subtype_Scalar_Acc (Def);
+               if Rti.Name /= null then
+                  Disp_Name (Rti.Name);
+               else
+                  Disp_Subtype_Indication
+                    (Rti.Basetype, Null_Context, Null_Address);
+                  Put (" range ");
+                  Disp_Subtype_Scalar_Range (stdout, Rti, Ctxt);
+               end if;
+            end;
+            --Disp_Scalar_Subtype_Name (To_Ghdl_Rtin_Scalsubtype_Acc (Def),
+            --                          Base);
+         when Ghdl_Rtik_Type_B2
+           | Ghdl_Rtik_Type_E8
+           | Ghdl_Rtik_Type_E32 =>
+            Disp_Name (To_Ghdl_Rtin_Type_Enum_Acc (Def).Name);
+         when Ghdl_Rtik_Type_I32
+           | Ghdl_Rtik_Type_I64 =>
+            Disp_Name (To_Ghdl_Rtin_Type_Scalar_Acc (Def).Name);
+         when Ghdl_Rtik_Type_File
+           | Ghdl_Rtik_Type_Access =>
+            Disp_Name (To_Ghdl_Rtin_Type_Fileacc_Acc (Def).Name);
+         when Ghdl_Rtik_Type_Record =>
+            Disp_Name (To_Ghdl_Rtin_Type_Record_Acc (Def).Name);
+         when Ghdl_Rtik_Type_Array =>
+            declare
+               Bounds : Address;
+            begin
+               if Obj = Null_Address then
+                  Bounds := Null_Address;
+               else
+                  Bounds := To_Ghdl_Uc_Array_Acc (Obj).Bounds;
+               end if;
+               Disp_Type_Array_Name (To_Ghdl_Rtin_Type_Array_Acc (Def),
+                                     Bounds);
+            end;
+         when Ghdl_Rtik_Subtype_Array
+           | Ghdl_Rtik_Subtype_Array_Ptr =>
+            declare
+               Sdef : Ghdl_Rtin_Subtype_Array_Acc;
+            begin
+               Sdef := To_Ghdl_Rtin_Subtype_Array_Acc (Def);
+               if Sdef.Name /= null then
+                  Disp_Name (Sdef.Name);
+               else
+                  Disp_Type_Array_Name
+                    (Sdef.Basetype,
+                     Loc_To_Addr (Sdef.Common.Depth, Sdef.Bounds, Ctxt));
+               end if;
+            end;
+         when others =>
+            Disp_Kind (Def.Kind);
+            Put (' ');
+      end case;
+   end Disp_Subtype_Indication;
+
+
+   procedure Disp_Rti (Rti : Ghdl_Rti_Access;
+                       Ctxt : Rti_Context;
+                       Indent : Natural);
+
+   procedure Disp_Rti_Arr (Nbr : Ghdl_Index_Type;
+                           Arr : Ghdl_Rti_Arr_Acc;
+                           Ctxt : Rti_Context;
+                           Indent : Natural)
+   is
+   begin
+      for I in 1 .. Nbr loop
+         Disp_Rti (Arr (I - 1), Ctxt, Indent);
+      end loop;
+   end Disp_Rti_Arr;
+
+   procedure Disp_Block (Blk : Ghdl_Rtin_Block_Acc;
+                         Ctxt : Rti_Context;
+                         Indent : Natural)
+   is
+      Nctxt : Rti_Context;
+   begin
+      Disp_Indent (Indent);
+      Disp_Kind (Blk.Common.Kind);
+      Disp_Depth (Blk.Common.Depth);
+      Put (": ");
+      Disp_Name (Blk.Name);
+      New_Line;
+      if Blk.Parent /= null then
+         case Blk.Common.Kind is
+            when Ghdl_Rtik_Architecture =>
+               --  Disp entity.
+               Disp_Rti (Blk.Parent, Ctxt, Indent + 1);
+            when others =>
+               null;
+         end case;
+      end if;
+      case Blk.Common.Kind is
+         when Ghdl_Rtik_Package
+           | Ghdl_Rtik_Package_Body
+           | Ghdl_Rtik_Entity
+           | Ghdl_Rtik_Architecture
+           | Ghdl_Rtik_Block
+           | Ghdl_Rtik_Process =>
+            Nctxt := (Base => Ctxt.Base + Blk.Loc.Off,
+                      Block => To_Ghdl_Rti_Access (Blk));
+            Disp_Rti_Arr (Blk.Nbr_Child, Blk.Children,
+                          Nctxt, Indent + 1);
+         when Ghdl_Rtik_For_Generate =>
+            declare
+               Length : Ghdl_Index_Type;
+            begin
+               Nctxt := (Base => To_Addr_Acc (Ctxt.Base + Blk.Loc.Off).all,
+                         Block => To_Ghdl_Rti_Access (Blk));
+               Length := Get_For_Generate_Length (Blk, Ctxt);
+               for I in 1 .. Length loop
+                  Disp_Rti_Arr (Blk.Nbr_Child, Blk.Children,
+                                Nctxt, Indent + 1);
+                  Nctxt.Base := Nctxt.Base + Blk.Size;
+               end loop;
+            end;
+         when Ghdl_Rtik_If_Generate =>
+            Nctxt := (Base => To_Addr_Acc (Ctxt.Base + Blk.Loc.Off).all,
+                      Block => To_Ghdl_Rti_Access (Blk));
+            if Nctxt.Base /= Null_Address then
+               Disp_Rti_Arr (Blk.Nbr_Child, Blk.Children,
+                             Nctxt, Indent + 1);
+            end if;
+         when others =>
+            Internal_Error ("disp_block");
+      end case;
+   end Disp_Block;
+
+   procedure Disp_Object (Obj : Ghdl_Rtin_Object_Acc;
+                          Is_Sig : Boolean;
+                          Ctxt : Rti_Context;
+                          Indent : Natural)
+   is
+      Addr : Address;
+      Obj_Type : Ghdl_Rti_Access;
+   begin
+      Disp_Indent (Indent);
+      Disp_Kind (Obj.Common.Kind);
+      Disp_Depth (Obj.Common.Depth);
+      Put ("; ");
+      Disp_Name (Obj.Name);
+      Put (": ");
+      Addr := Loc_To_Addr (Obj.Common.Depth, Obj.Loc, Ctxt);
+      Obj_Type := Obj.Obj_Type;
+      Disp_Subtype_Indication (Obj_Type, Ctxt, Addr);
+      Put (" := ");
+
+      --  FIXME: put this into a function.
+      if Obj_Type.Kind = Ghdl_Rtik_Subtype_Array
+        and then Obj_Type.Mode = 1
+      then
+         Addr := To_Addr_Acc (Addr).all;
+      end if;
+      Disp_Value (stdout, Obj_Type, Ctxt, Addr, Is_Sig);
+      New_Line;
+   end Disp_Object;
+
+   procedure Disp_Attribute (Obj : Ghdl_Rtin_Object_Acc;
+                             Ctxt : Rti_Context;
+                             Indent : Natural)
+   is
+   begin
+      Disp_Indent (Indent);
+      Disp_Kind (Obj.Common.Kind);
+      Disp_Depth (Obj.Common.Depth);
+      Put ("; ");
+      Disp_Name (Obj.Name);
+      Put (": ");
+      Disp_Subtype_Indication (Obj.Obj_Type, Ctxt, Null_Address);
+      New_Line;
+   end Disp_Attribute;
+
+   procedure Disp_Component (Comp : Ghdl_Rtin_Component_Acc;
+                             Indent : Natural)
+   is
+   begin
+      Disp_Indent (Indent);
+      Disp_Kind (Comp.Common.Kind);
+      Disp_Depth (Comp.Common.Depth);
+      Put (": ");
+      Disp_Name (Comp.Name);
+      New_Line;
+      --Disp_Rti_Arr (Comp.Nbr_Child, Comp.Children, Base, Ident + 1);
+   end Disp_Component;
+
+   procedure Disp_Instance (Inst : Ghdl_Rtin_Instance_Acc;
+                            Ctxt : Rti_Context;
+                            Indent : Natural)
+   is
+      Inst_Addr : Address;
+      Inst_Base : Address;
+      Inst_Rti : Ghdl_Rti_Access;
+      Nindent : Natural;
+      Nctxt : Rti_Context;
+   begin
+      Disp_Indent (Indent);
+      Disp_Kind (Inst.Common.Kind);
+      Put (": ");
+      Disp_Name (Inst.Name);
+      New_Line;
+
+      Inst_Addr := Ctxt.Base + Inst.Loc.Off;
+      --  Read sub instance.
+      Inst_Base := To_Addr_Acc (Inst_Addr).all;
+
+      Nindent := Indent + 1;
+
+      case Inst.Instance.Kind is
+         when Ghdl_Rtik_Component =>
+            declare
+               Comp : Ghdl_Rtin_Component_Acc;
+            begin
+               Comp := To_Ghdl_Rtin_Component_Acc (Inst.Instance);
+               Disp_Indent (Nindent);
+               Disp_Kind (Comp.Common.Kind);
+               Put (": ");
+               Disp_Name (Comp.Name);
+               New_Line;
+               --  Disp components generics and ports.
+               --  FIXME: the data to disp are at COMP_BASE.
+               Nctxt := (Base => Inst_Addr,
+                         Block => Inst.Instance);
+               Nindent := Nindent + 1;
+               Disp_Rti_Arr (Comp.Nbr_Child, Comp.Children, Nctxt, Nindent);
+               Nindent := Nindent + 1;
+            end;
+         when Ghdl_Rtik_Entity =>
+            null;
+         when others =>
+            null;
+      end case;
+
+      --  Read instance RTI.
+      if Inst_Base /= Null_Address then
+         Inst_Rti := To_Ghdl_Rti_Acc_Acc (Inst_Base).all;
+         Nctxt := (Base => Inst_Base,
+                   Block => Inst_Rti);
+         Disp_Block (To_Ghdl_Rtin_Block_Acc (Inst_Rti),
+                     Nctxt, Nindent);
+      end if;
+   end Disp_Instance;
+
+   procedure Disp_Type_Enum_Decl (Enum : Ghdl_Rtin_Type_Enum_Acc;
+                                  Indent : Natural)
+   is
+   begin
+      Disp_Indent (Indent);
+      Disp_Kind (Enum.Common.Kind);
+      Put (": ");
+      Disp_Name (Enum.Name);
+      Put (" is (");
+      Disp_Name (Enum.Names (0));
+      for I in 1 .. Enum.Nbr - 1 loop
+         Put (", ");
+         Disp_Name (Enum.Names (I));
+      end loop;
+      Put (")");
+      New_Line;
+   end Disp_Type_Enum_Decl;
+
+   procedure Disp_Subtype_Scalar_Decl (Def : Ghdl_Rtin_Subtype_Scalar_Acc;
+                                       Ctxt : Rti_Context;
+                                       Indent : Natural)
+   is
+      Bt : Ghdl_Rti_Access;
+   begin
+      Disp_Indent (Indent);
+      Disp_Kind (Def.Common.Kind);
+      Disp_Depth (Def.Common.Depth);
+      Put (": ");
+      Disp_Name (Def.Name);
+      Put (" is ");
+      Bt := Def.Basetype;
+      case Bt.Kind is
+         when Ghdl_Rtik_Type_I32
+           | Ghdl_Rtik_Type_F64 =>
+            declare
+               Bdef : Ghdl_Rtin_Type_Scalar_Acc;
+            begin
+               Bdef := To_Ghdl_Rtin_Type_Scalar_Acc (Bt);
+               if Bdef.Name /= Def.Name then
+                  Disp_Name (Bdef.Name);
+                  Put (" range ");
+               end if;
+               --  This is the type definition.
+               Disp_Subtype_Scalar_Range (stdout, Def, Ctxt);
+            end;
+         when Ghdl_Rtik_Type_P64
+           | Ghdl_Rtik_Type_P32 =>
+            declare
+               Bdef : Ghdl_Rtin_Type_Physical_Acc;
+               Unit : Ghdl_Rtin_Unit_Acc;
+            begin
+               Bdef := To_Ghdl_Rtin_Type_Physical_Acc (Bt);
+               if Bdef.Name /= Def.Name then
+                  Disp_Name (Bdef.Name);
+                  Put (" range ");
+               end if;
+               --  This is the type definition.
+               Disp_Subtype_Scalar_Range (stdout, Def, Ctxt);
+               if Bdef.Name = Def.Name then
+                  for I in 0 .. Bdef.Nbr - 1 loop
+                     Unit := To_Ghdl_Rtin_Unit_Acc (Bdef.Units (I));
+                     New_Line;
+                     Disp_Indent (Indent + 1);
+                     Disp_Kind (Unit.Common.Kind);
+                     Put (": ");
+                     Disp_Name (Unit.Name);
+                     Put (" = ");
+                     case Bt.Kind is
+                        when Ghdl_Rtik_Type_P64 =>
+                           if Bt.Mode = 0 then
+                              Put_I64 (stdout, Unit.Value.Unit_64);
+                           else
+                              Put_I64 (stdout, Unit.Value.Unit_Addr.I64);
+                           end if;
+                        when Ghdl_Rtik_Type_P32 =>
+                           if Bt.Mode = 0 then
+                              Put_I32 (stdout, Unit.Value.Unit_32);
+                           else
+                              Put_I32 (stdout, Unit.Value.Unit_Addr.I32);
+                           end if;
+                        when others =>
+                           null;
+                     end case;
+                  end loop;
+               end if;
+            end;
+         when others =>
+            Disp_Subtype_Indication
+              (To_Ghdl_Rti_Access (Def), Ctxt, Null_Address);
+      end case;
+      New_Line;
+   end Disp_Subtype_Scalar_Decl;
+
+   procedure Disp_Type_Array_Decl (Def : Ghdl_Rtin_Type_Array_Acc;
+                                   Ctxt : Rti_Context;
+                                   Indent : Natural)
+   is
+   begin
+      Disp_Indent (Indent);
+      Disp_Kind (Def.Common.Kind);
+      Put (": ");
+      Disp_Name (Def.Name);
+      Put (" is array (");
+      for I in 0 .. Def.Nbr_Dim - 1 loop
+         if I /= 0 then
+            Put (", ");
+         end if;
+         Disp_Subtype_Indication (Def.Indexes (I), Ctxt, Null_Address);
+         Put (" range <>");
+      end loop;
+      Put (") of ");
+      Disp_Subtype_Indication (Def.Element, Ctxt, Null_Address);
+      New_Line;
+   end Disp_Type_Array_Decl;
+
+   procedure Disp_Subtype_Array_Decl (Def : Ghdl_Rtin_Subtype_Array_Acc;
+                                      Ctxt : Rti_Context;
+                                      Indent : Natural)
+   is
+   begin
+      Disp_Indent (Indent);
+      Disp_Kind (Def.Common.Kind);
+      Put (": ");
+      Disp_Name (Def.Name);
+      Put (" is ");
+      Disp_Type_Array_Name
+        (Def.Basetype, Loc_To_Addr (Def.Common.Depth, Def.Bounds, Ctxt));
+      --  FIXME: If the subtype array contains a type array, then the
+      --  definition is not complete: display the element type.
+      New_Line;
+   end Disp_Subtype_Array_Decl;
+
+   procedure Disp_Type_File_Or_Access (Def : Ghdl_Rtin_Type_Fileacc_Acc;
+                                       Ctxt : Rti_Context;
+                                       Indent : Natural)
+   is
+   begin
+      Disp_Indent (Indent);
+      Disp_Kind (Def.Common.Kind);
+      Put (": ");
+      Disp_Name (Def.Name);
+      Put (" is ");
+      case Def.Common.Kind is
+         when Ghdl_Rtik_Type_Access =>
+            Put ("access ");
+         when Ghdl_Rtik_Type_File =>
+            Put ("file ");
+         when others =>
+            Put ("?? ");
+      end case;
+      Disp_Subtype_Indication (Def.Base, Ctxt, Null_Address);
+      New_Line;
+   end Disp_Type_File_Or_Access;
+
+   procedure Disp_Type_Record (Def : Ghdl_Rtin_Type_Record_Acc;
+                               Ctxt : Rti_Context;
+                               Indent : Natural)
+   is
+      El : Ghdl_Rtin_Element_Acc;
+   begin
+      Disp_Indent (Indent);
+      Disp_Kind (Def.Common.Kind);
+      Put (": ");
+      Disp_Name (Def.Name);
+      Put (" is record");
+      New_Line;
+      for I in 1 .. Def.Nbrel loop
+         El := To_Ghdl_Rtin_Element_Acc (Def.Elements (I - 1));
+         Disp_Indent (Indent + 1);
+         Disp_Kind (El.Common.Kind);
+         Put (": ");
+         Disp_Name (El.Name);
+         Put (": ");
+         Disp_Subtype_Indication (El.Eltype, Ctxt, Null_Address);
+         New_Line;
+      end loop;
+   end Disp_Type_Record;
+
+   procedure Disp_Rti (Rti : Ghdl_Rti_Access;
+                       Ctxt : Rti_Context;
+                       Indent : Natural)
+   is
+   begin
+      if Rti = null then
+         return;
+      end if;
+
+      case Rti.Kind is
+         when Ghdl_Rtik_Entity
+           | Ghdl_Rtik_Architecture
+           | Ghdl_Rtik_Package
+           | Ghdl_Rtik_Process
+           | Ghdl_Rtik_Block
+           | Ghdl_Rtik_If_Generate
+           | Ghdl_Rtik_For_Generate =>
+            Disp_Block (To_Ghdl_Rtin_Block_Acc (Rti), Ctxt, Indent);
+         when Ghdl_Rtik_Package_Body =>
+            Disp_Rti (To_Ghdl_Rtin_Block_Acc (Rti).Parent, Ctxt, Indent);
+            Disp_Block (To_Ghdl_Rtin_Block_Acc (Rti), Ctxt, Indent);
+         when Ghdl_Rtik_Port
+           | Ghdl_Rtik_Signal
+           | Ghdl_Rtik_Guard
+           | Ghdl_Rtik_Attribute_Quiet
+           | Ghdl_Rtik_Attribute_Stable
+           | Ghdl_Rtik_Attribute_Transaction =>
+            Disp_Object (To_Ghdl_Rtin_Object_Acc (Rti), True, Ctxt, Indent);
+         when Ghdl_Rtik_Generic
+           | Ghdl_Rtik_Constant
+           | Ghdl_Rtik_Variable
+           | Ghdl_Rtik_Iterator
+           | Ghdl_Rtik_File =>
+            Disp_Object (To_Ghdl_Rtin_Object_Acc (Rti), False, Ctxt, Indent);
+         when Ghdl_Rtik_Component =>
+            Disp_Component (To_Ghdl_Rtin_Component_Acc (Rti), Indent);
+         when Ghdl_Rtik_Attribute =>
+            Disp_Attribute (To_Ghdl_Rtin_Object_Acc (Rti), Ctxt, Indent);
+         when Ghdl_Rtik_Instance =>
+            Disp_Instance (To_Ghdl_Rtin_Instance_Acc (Rti), Ctxt, Indent);
+         when Ghdl_Rtik_Type_B2
+           | Ghdl_Rtik_Type_E8
+           | Ghdl_Rtik_Type_E32 =>
+            Disp_Type_Enum_Decl (To_Ghdl_Rtin_Type_Enum_Acc (Rti), Indent);
+         when Ghdl_Rtik_Subtype_Scalar =>
+            Disp_Subtype_Scalar_Decl (To_Ghdl_Rtin_Subtype_Scalar_Acc (Rti),
+                                      Ctxt, Indent);
+         when Ghdl_Rtik_Type_Array =>
+            Disp_Type_Array_Decl
+              (To_Ghdl_Rtin_Type_Array_Acc (Rti), Ctxt, Indent);
+         when Ghdl_Rtik_Subtype_Array
+           | Ghdl_Rtik_Subtype_Array_Ptr =>
+            Disp_Subtype_Array_Decl
+              (To_Ghdl_Rtin_Subtype_Array_Acc (Rti), Ctxt, Indent);
+         when Ghdl_Rtik_Type_Access
+           | Ghdl_Rtik_Type_File =>
+            Disp_Type_File_Or_Access
+              (To_Ghdl_Rtin_Type_Fileacc_Acc (Rti), Ctxt, Indent);
+         when Ghdl_Rtik_Type_Record =>
+            Disp_Type_Record
+              (To_Ghdl_Rtin_Type_Record_Acc (Rti), Ctxt, Indent);
+         when others =>
+            Disp_Indent (Indent);
+            Disp_Kind (Rti.Kind);
+            Put_Line (" ? ");
+      end case;
+   end Disp_Rti;
+
+   procedure Disp_All
+   is
+      Ctxt : Rti_Context;
+   begin
+      Put ("DISP_RTI.Disp_All: ");
+      Disp_Kind (Ghdl_Rti_Top_Ptr.Common.Kind);
+      New_Line;
+      Ctxt := (Base => To_Address (Ghdl_Rti_Top_Instance),
+               Block => Ghdl_Rti_Top_Ptr.Parent);
+      Disp_Rti_Arr (Ghdl_Rti_Top_Ptr.Nbr_Child,
+                    Ghdl_Rti_Top_Ptr.Children,
+                    Ctxt, 0);
+      Disp_Rti (Ghdl_Rti_Top_Ptr.Parent, Ctxt, 0);
+
+      --Disp_Hierarchy;
+   end Disp_All;
+
+   --  Get next interesting child.
+   procedure Get_Tree_Child (Parent : Ghdl_Rtin_Block_Acc;
+                             Index : in out Ghdl_Index_Type;
+                             Child : out Ghdl_Rti_Access)
+   is
+   begin
+      --  Exit if no more children.
+      while Index < Parent.Nbr_Child loop
+         Child := Parent.Children (Index);
+         Index := Index + 1;
+         case Child.Kind is
+            when Ghdl_Rtik_Package
+              | Ghdl_Rtik_Entity
+              | Ghdl_Rtik_Architecture
+              | Ghdl_Rtik_Block
+              | Ghdl_Rtik_For_Generate
+              | Ghdl_Rtik_If_Generate
+              | Ghdl_Rtik_Instance =>
+               return;
+            when Ghdl_Rtik_Signal
+              | Ghdl_Rtik_Port
+              | Ghdl_Rtik_Guard =>
+               if Disp_Tree >= Disp_Tree_Port then
+                  return;
+               end if;
+            when Ghdl_Rtik_Process =>
+               if Disp_Tree >= Disp_Tree_Proc then
+                  return;
+               end if;
+            when others =>
+               null;
+         end case;
+      end loop;
+      Child := null;
+   end Get_Tree_Child;
+
+   procedure Disp_Tree_Child (Rti : Ghdl_Rti_Access; Ctxt : Rti_Context)
+   is
+   begin
+      case Rti.Kind is
+         when Ghdl_Rtik_Entity
+           | Ghdl_Rtik_Process
+           | Ghdl_Rtik_Architecture
+           | Ghdl_Rtik_Block
+           | Ghdl_Rtik_If_Generate =>
+            declare
+               Blk : Ghdl_Rtin_Block_Acc := To_Ghdl_Rtin_Block_Acc (Rti);
+            begin
+               Disp_Name (Blk.Name);
+            end;
+         when Ghdl_Rtik_Package_Body
+           | Ghdl_Rtik_Package =>
+            declare
+               Blk : Ghdl_Rtin_Block_Acc;
+               Lib : Ghdl_Rtin_Type_Scalar_Acc;
+            begin
+               Blk := To_Ghdl_Rtin_Block_Acc (Rti);
+               if Rti.Kind = Ghdl_Rtik_Package_Body then
+                  Blk := To_Ghdl_Rtin_Block_Acc (Blk.Parent);
+               end if;
+               Lib := To_Ghdl_Rtin_Type_Scalar_Acc (Blk.Parent);
+               Disp_Name (Lib.Name);
+               Put ('.');
+               Disp_Name (Blk.Name);
+            end;
+         when Ghdl_Rtik_For_Generate =>
+            declare
+               Blk : Ghdl_Rtin_Block_Acc := To_Ghdl_Rtin_Block_Acc (Rti);
+               Iter : Ghdl_Rtin_Object_Acc;
+               Addr : Address;
+            begin
+               Disp_Name (Blk.Name);
+               Iter := To_Ghdl_Rtin_Object_Acc (Blk.Children (0));
+               Addr := Loc_To_Addr (Iter.Common.Depth, Iter.Loc, Ctxt);
+               Put ('(');
+               Disp_Value (stdout, Iter.Obj_Type, Ctxt, Addr, False);
+               Put (')');
+            end;
+         when Ghdl_Rtik_Signal
+           | Ghdl_Rtik_Port
+           | Ghdl_Rtik_Guard
+           | Ghdl_Rtik_Iterator =>
+            Disp_Name (To_Ghdl_Rtin_Object_Acc (Rti).Name);
+         when Ghdl_Rtik_Instance =>
+            Disp_Name (To_Ghdl_Rtin_Instance_Acc (Rti).Name);
+         when others =>
+            null;
+      end case;
+
+      case Rti.Kind is
+         when Ghdl_Rtik_Package
+           | Ghdl_Rtik_Package_Body =>
+            Put (" [package]");
+         when Ghdl_Rtik_Entity =>
+            Put (" [entity]");
+         when Ghdl_Rtik_Architecture =>
+            Put (" [arch]");
+         when Ghdl_Rtik_Process =>
+            Put (" [process]");
+         when Ghdl_Rtik_Block =>
+            Put (" [block]");
+         when Ghdl_Rtik_For_Generate =>
+            Put (" [for-generate]");
+         when Ghdl_Rtik_If_Generate =>
+            Put (" [if-generate ");
+            if Ctxt.Base = Null_Address then
+               Put ("false]");
+            else
+               Put ("true]");
+            end if;
+         when Ghdl_Rtik_Signal =>
+            Put (" [signal]");
+         when Ghdl_Rtik_Port =>
+            Put (" [port ");
+            case Rti.Mode and Ghdl_Rti_Signal_Mode_Mask is
+               when Ghdl_Rti_Signal_Mode_In =>
+                  Put ("in");
+               when Ghdl_Rti_Signal_Mode_Out =>
+                  Put ("out");
+               when Ghdl_Rti_Signal_Mode_Inout =>
+                  Put ("inout");
+               when Ghdl_Rti_Signal_Mode_Buffer =>
+                  Put ("buffer");
+               when Ghdl_Rti_Signal_Mode_Linkage =>
+                  Put ("linkage");
+               when others =>
+                  Put ("?");
+            end case;
+            Put ("]");
+         when Ghdl_Rtik_Guard =>
+            Put (" [guard]");
+         when Ghdl_Rtik_Iterator =>
+            Put (" [iterator]");
+         when Ghdl_Rtik_Instance =>
+            Put (" [instance]");
+         when others =>
+            null;
+      end case;
+   end Disp_Tree_Child;
+
+   procedure Disp_Tree_Block
+     (Blk : Ghdl_Rtin_Block_Acc; Ctxt : Rti_Context; Pfx : String);
+
+   procedure Disp_Tree_Block1
+     (Blk : Ghdl_Rtin_Block_Acc; Ctxt : Rti_Context; Pfx : String)
+   is
+      Child : Ghdl_Rti_Access;
+      Child2 : Ghdl_Rti_Access;
+      Index : Ghdl_Index_Type;
+
+      procedure Disp_Header (Nctxt : Rti_Context;
+                             Force_Cont : Boolean := False)
+      is
+      begin
+         Put (Pfx);
+
+         if Blk.Common.Kind /= Ghdl_Rtik_Entity
+           and Child2 = null
+           and Force_Cont = False
+         then
+            Put ("`-");
+         else
+            Put ("+-");
+         end if;
+
+         Disp_Tree_Child (Child, Nctxt);
+         New_Line;
+      end Disp_Header;
+
+      procedure Disp_Sub_Block
+        (Sub_Blk : Ghdl_Rtin_Block_Acc; Nctxt : Rti_Context)
+      is
+         Npfx : String (1 .. Pfx'Length + 2);
+      begin
+         Npfx (1 .. Pfx'Length) := Pfx;
+         Npfx (Pfx'Length + 2) := ' ';
+         if Child2 = null then
+            Npfx (Pfx'Length + 1) := ' ';
+         else
+            Npfx (Pfx'Length + 1) := '|';
+         end if;
+         Disp_Tree_Block (Sub_Blk, Nctxt, Npfx);
+      end Disp_Sub_Block;
+
+   begin
+      Index := 0;
+      Get_Tree_Child (Blk, Index, Child);
+      while Child /= null loop
+         Get_Tree_Child (Blk, Index, Child2);
+
+         case Child.Kind is
+            when Ghdl_Rtik_Process
+              | Ghdl_Rtik_Block =>
+               declare
+                  Nblk : Ghdl_Rtin_Block_Acc := To_Ghdl_Rtin_Block_Acc (Child);
+                  Nctxt : Rti_Context;
+               begin
+                  Nctxt := (Base => Ctxt.Base + Nblk.Loc.Off,
+                            Block => Child);
+                  Disp_Header (Nctxt, False);
+                  Disp_Sub_Block (Nblk, Nctxt);
+               end;
+            when Ghdl_Rtik_For_Generate =>
+               declare
+                  Nblk : Ghdl_Rtin_Block_Acc := To_Ghdl_Rtin_Block_Acc (Child);
+                  Nctxt : Rti_Context;
+                  Length : Ghdl_Index_Type;
+                  Old_Child2 : Ghdl_Rti_Access;
+               begin
+                  Nctxt := (Base => To_Addr_Acc (Ctxt.Base + Nblk.Loc.Off).all,
+                            Block => Child);
+                  Length := Get_For_Generate_Length (Nblk, Ctxt);
+                  Disp_Header (Nctxt, Length > 1);
+                  Old_Child2 := Child2;
+                  if Length > 1 then
+                     Child2 := Child;
+                  end if;
+                  for I in 1 .. Length loop
+                     Disp_Sub_Block (Nblk, Nctxt);
+                     if I /= Length then
+                        Nctxt.Base := Nctxt.Base + Nblk.Size;
+                        if I = Length - 1 then
+                           Child2 := Old_Child2;
+                        end if;
+                        Disp_Header (Nctxt);
+                     end if;
+                  end loop;
+                  Child2 := Old_Child2;
+               end;
+            when Ghdl_Rtik_If_Generate =>
+               declare
+                  Nblk : Ghdl_Rtin_Block_Acc := To_Ghdl_Rtin_Block_Acc (Child);
+                  Nctxt : Rti_Context;
+               begin
+                  Nctxt := (Base => To_Addr_Acc (Ctxt.Base + Nblk.Loc.Off).all,
+                            Block => Child);
+                  Disp_Header (Nctxt);
+                  if Nctxt.Base /= Null_Address then
+                     Disp_Sub_Block (Nblk, Nctxt);
+                  end if;
+               end;
+            when Ghdl_Rtik_Instance =>
+               declare
+                  Inst : Ghdl_Rtin_Instance_Acc;
+                  Sub_Ctxt : Rti_Context;
+                  Sub_Blk : Ghdl_Rtin_Block_Acc;
+                  Npfx : String (1 .. Pfx'Length + 4);
+                  Comp : Ghdl_Rtin_Component_Acc;
+                  Ch : Ghdl_Rti_Access;
+               begin
+                  Disp_Header (Ctxt);
+                  Inst := To_Ghdl_Rtin_Instance_Acc (Child);
+                  Get_Instance_Context (Inst, Ctxt, Sub_Ctxt);
+                  Sub_Blk := To_Ghdl_Rtin_Block_Acc (Sub_Ctxt.Block);
+                  if Inst.Instance.Kind = Ghdl_Rtik_Component
+                    and then Disp_Tree >= Disp_Tree_Port
+                  then
+                     --  Disp generics and ports of the component.
+                     Comp := To_Ghdl_Rtin_Component_Acc (Inst.Instance);
+                     for I in 1 .. Comp.Nbr_Child loop
+                        Ch := Comp.Children (I - 1);
+                        if Ch.Kind = Ghdl_Rtik_Port then
+                           --  Disp only port (and not generics).
+                           Put (Pfx);
+                           if Child2 = null then
+                              Put ("  ");
+                           else
+                              Put ("| ");
+                           end if;
+                           if I = Comp.Nbr_Child and then Sub_Blk = null then
+                              Put ("`-");
+                           else
+                              Put ("+-");
+                           end if;
+                           Disp_Tree_Child (Ch, Sub_Ctxt);
+                           New_Line;
+                        end if;
+                     end loop;
+                  end if;
+                  if Sub_Blk /= null then
+                     Npfx (1 .. Pfx'Length) := Pfx;
+                     if Child2 = null then
+                        Npfx (Pfx'Length + 1) := ' ';
+                     else
+                        Npfx (Pfx'Length + 1) := '|';
+                     end if;
+                     Npfx (Pfx'Length + 2) := ' ';
+                     Npfx (Pfx'Length + 3) := '`';
+                     Npfx (Pfx'Length + 4) := '-';
+                     Put (Npfx);
+                     Disp_Tree_Child (Sub_Blk.Parent, Sub_Ctxt);
+                     New_Line;
+                     Npfx (Pfx'Length + 3) := ' ';
+                     Npfx (Pfx'Length + 4) := ' ';
+                     Disp_Tree_Block (Sub_Blk, Sub_Ctxt, Npfx);
+                  end if;
+               end;
+            when others =>
+               Disp_Header (Ctxt);
+         end case;
+
+         Child := Child2;
+      end loop;
+   end Disp_Tree_Block1;
+
+   procedure Disp_Tree_Block
+     (Blk : Ghdl_Rtin_Block_Acc; Ctxt : Rti_Context; Pfx : String)
+   is
+   begin
+      case Blk.Common.Kind is
+         when Ghdl_Rtik_Architecture =>
+            declare
+               Npfx : String (1 .. Pfx'Length + 2);
+               Nctxt : Rti_Context;
+            begin
+               --  The entity.
+               Nctxt := (Base => Ctxt.Base,
+                         Block => Blk.Parent);
+               Disp_Tree_Block1
+                 (To_Ghdl_Rtin_Block_Acc (Blk.Parent), Nctxt, Pfx);
+               --  Then the architecture.
+               Put (Pfx);
+               Put ("`-");
+               Disp_Tree_Child (To_Ghdl_Rti_Access (Blk), Ctxt);
+               New_Line;
+               Npfx (1 .. Pfx'Length) := Pfx;
+               Npfx (Pfx'Length + 1) := ' ';
+               Npfx (Pfx'Length + 2) := ' ';
+               Disp_Tree_Block1 (Blk, Ctxt, Npfx);
+            end;
+         when Ghdl_Rtik_Package_Body =>
+            Disp_Tree_Block1
+              (To_Ghdl_Rtin_Block_Acc (Blk.Parent), Ctxt, Pfx);
+         when others =>
+            Disp_Tree_Block1 (Blk, Ctxt, Pfx);
+      end case;
+   end Disp_Tree_Block;
+
+   procedure Disp_Hierarchy
+   is
+      Ctxt : Rti_Context;
+      Parent : Ghdl_Rtin_Block_Acc;
+      Child : Ghdl_Rti_Access;
+   begin
+      Ctxt := Get_Top_Context;
+      Parent := To_Ghdl_Rtin_Block_Acc (Ctxt.Block);
+
+      Disp_Tree_Child (Parent.Parent, Ctxt);
+      New_Line;
+      Disp_Tree_Block (Parent, Ctxt, "");
+
+      for I in 1 .. Ghdl_Rti_Top_Ptr.Nbr_Child loop
+         Child := Ghdl_Rti_Top_Ptr.Children (I - 1);
+         Ctxt := (Base => Null_Address,
+                  Block => Child);
+         Disp_Tree_Child (Child, Ctxt);
+         New_Line;
+         Disp_Tree_Block (To_Ghdl_Rtin_Block_Acc (Child), Ctxt, "");
+      end loop;
+   end Disp_Hierarchy;
+end Grt.Disp_Rti;
diff --git a/translate/grt/grt-disp_rti.ads b/translate/grt/grt-disp_rti.ads
new file mode 100644
index 000000000..890c5e1ff
--- /dev/null
+++ b/translate/grt/grt-disp_rti.ads
@@ -0,0 +1,22 @@
+--  GHDL Run Time (GRT) - RTI dumper.
+--  Copyright (C) 2002, 2003, 2004, 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.
+package Grt.Disp_Rti is
+   procedure Disp_All;
+
+   procedure Disp_Hierarchy;
+end Grt.Disp_Rti;
diff --git a/translate/grt/grt-disp_signals.adb b/translate/grt/grt-disp_signals.adb
new file mode 100644
index 000000000..ab73b2d24
--- /dev/null
+++ b/translate/grt/grt-disp_signals.adb
@@ -0,0 +1,456 @@
+--  GHDL Run Time (GRT) - Display subprograms for signals.
+--  Copyright (C) 2002, 2003, 2004, 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; use System;
+with Ada.Unchecked_Conversion;
+with Grt.Types; use Grt.Types;
+with Grt.Rtis; use Grt.Rtis;
+with Grt.Rtis_Addr; use Grt.Rtis_Addr;
+with Grt.Rtis_Utils; use Grt.Rtis_Utils;
+with Grt.Rtis; use Grt.Rtis;
+with Grt.Astdio; use Grt.Astdio;
+with Grt.Errors; use Grt.Errors;
+pragma Elaborate_All (Grt.Rtis_Utils);
+with Grt.Vstrings; use Grt.Vstrings;
+with Grt.Stdio; use Grt.Stdio;
+with Grt.Signals; use Grt.Signals;
+with Grt.Options;
+with Grt.Disp; use Grt.Disp;
+
+package body Grt.Disp_Signals is
+   procedure Disp_Context (Ctxt : Rti_Context)
+   is
+      Blk : Ghdl_Rtin_Block_Acc;
+      Nctxt : Rti_Context;
+   begin
+      Blk := To_Ghdl_Rtin_Block_Acc (Ctxt.Block);
+      case Blk.Common.Kind is
+         when Ghdl_Rtik_Block
+           | Ghdl_Rtik_Process =>
+            Nctxt := Get_Parent_Context (Ctxt);
+            Disp_Context (Nctxt);
+            Put ('.');
+            Put (Blk.Name);
+         when Ghdl_Rtik_Entity =>
+            Put (Blk.Name);
+         when Ghdl_Rtik_Architecture =>
+            Nctxt := Get_Parent_Context (Ctxt);
+            Disp_Context (Nctxt);
+            Put ('(');
+            Put (Blk.Name);
+            Put (')');
+         when others =>
+            Internal_Error ("disp_context");
+      end case;
+   end Disp_Context;
+
+   --  Option --trace-signals.
+
+   --  Disp transaction TRANS from signal SIG.
+   procedure Disp_Transaction (Trans : Transaction_Acc;
+                               Sig_Type : Ghdl_Rti_Access;
+                               Mode : Mode_Type)
+   is
+      T : Transaction_Acc;
+   begin
+      T := Trans;
+      loop
+         case T.Kind is
+            when Trans_Value =>
+               if Sig_Type /= null then
+                  Disp_Value (stdout, T.Val, Sig_Type);
+               else
+                  Disp_Value (T.Val, Mode);
+               end if;
+            when Trans_Null =>
+               Put ("NULL");
+            when Trans_Error =>
+               Put ("ERROR");
+         end case;
+         Put ("@");
+         Put_Time (stdout, T.Time);
+         T := T.Next;
+         exit when T = null;
+         Put (", ");
+      end loop;
+   end Disp_Transaction;
+
+   procedure Disp_Simple_Signal
+     (Sig : Ghdl_Signal_Ptr; Sig_Type : Ghdl_Rti_Access; Sources : Boolean)
+   is
+   begin
+      Put (' ');
+      Put (stdout, Sig.all'Address);
+      Put (' ');
+      Disp_Mode (Sig.Mode);
+      Put (' ');
+      if Sig.Active then
+         Put ('A');
+      else
+         Put ('-');
+      end if;
+      if Sig.Event then
+         Put ('E');
+      else
+         Put ('-');
+      end if;
+      if Sig.S.Effective /= null then
+         Put ('e');
+      else
+         Put ('-');
+      end if;
+      if Boolean'(True) then
+         Put (" last_event=");
+         Put_Time (stdout, Sig.Last_Event);
+         Put (" last_active=");
+         Put_Time (stdout, Sig.Last_Active);
+      end if;
+      Put (" val=");
+      if Sig_Type /= null then
+         Disp_Value (stdout, Sig.Value, Sig_Type);
+      else
+         Disp_Value (Sig.Value, Sig.Mode);
+      end if;
+      Put ("; drv=");
+      if Sig_Type /= null then
+         Disp_Value (stdout, Sig.Driving_Value, Sig_Type);
+      else
+         Disp_Value (Sig.Driving_Value, Sig.Mode);
+      end if;
+      if Sources then
+         if Sig.Nbr_Ports > 0 then
+            Put (';');
+            Put_I32 (stdout, Ghdl_I32 (Sig.Nbr_Ports));
+            Put (" ports");
+         end if;
+         if Sig.S.Mode_Sig in Mode_Signal_User then
+            if Sig.S.Nbr_Drivers = 0 then
+               Put ("; no driver");
+            elsif Sig.S.Nbr_Drivers = 1 then
+               Put ("; trans=");
+               Disp_Transaction
+                 (Sig.S.Drivers (0).First_Trans, Sig_Type, Sig.Mode);
+            else
+               for I in 0 .. Sig.S.Nbr_Drivers - 1 loop
+                  New_Line;
+                  Put ("   ");
+                  Disp_Transaction
+                    (Sig.S.Drivers (I).First_Trans, Sig_Type, Sig.Mode);
+               end loop;
+            end if;
+         end if;
+      end if;
+      New_Line;
+   end Disp_Simple_Signal;
+
+   procedure Disp_Scalar_Signal (Val_Addr : Address;
+                                 Val_Name : Vstring;
+                                 Val_Type : Ghdl_Rti_Access)
+   is
+   begin
+      Put (stdout, Val_Name);
+      Disp_Simple_Signal (To_Ghdl_Signal_Ptr (To_Addr_Acc (Val_Addr).all),
+                          Val_Type, Options.Disp_Sources);
+   end Disp_Scalar_Signal;
+
+   procedure Foreach_Scalar_Signal is new
+     Foreach_Scalar (Process => Disp_Scalar_Signal);
+
+   procedure Disp_Signal_Name (Stream : FILEs; Sig : Ghdl_Rtin_Object_Acc) is
+   begin
+      case Sig.Common.Kind is
+         when Ghdl_Rtik_Signal
+           | Ghdl_Rtik_Port
+           | Ghdl_Rtik_Guard =>
+            Put (Stream, Sig.Name);
+         when Ghdl_Rtik_Attribute_Quiet =>
+            Put (Stream, " 'quiet");
+         when Ghdl_Rtik_Attribute_Stable =>
+            Put (Stream, " 'stable");
+         when Ghdl_Rtik_Attribute_Transaction =>
+            Put (Stream, " 'quiet");
+         when others =>
+            null;
+      end case;
+   end Disp_Signal_Name;
+
+   function Disp_Signal (Ctxt : Rti_Context;
+                         Obj : Ghdl_Rti_Access)
+                        return Traverse_Result
+   is
+      Sig : Ghdl_Rtin_Object_Acc;
+   begin
+      case Obj.Kind is
+         when Ghdl_Rtik_Signal
+           | Ghdl_Rtik_Port
+           | Ghdl_Rtik_Guard
+           | Ghdl_Rtik_Attribute_Quiet
+           | Ghdl_Rtik_Attribute_Stable
+           | Ghdl_Rtik_Attribute_Transaction =>
+            Sig := To_Ghdl_Rtin_Object_Acc (Obj);
+            Put (stdout, Ctxt);
+            Put (".");
+            Disp_Signal_Name (stdout, Sig);
+            Foreach_Scalar_Signal
+              (Ctxt, Sig.Obj_Type,
+               Loc_To_Addr (Sig.Common.Depth, Sig.Loc, Ctxt), True);
+         when others =>
+            null;
+      end case;
+      return Traverse_Ok;
+   end Disp_Signal;
+
+   function Disp_All_Signals is new Traverse_Blocks (Process => Disp_Signal);
+
+   procedure Disp_All_Signals
+   is
+      Res : Traverse_Result;
+   begin
+      if Boolean'(False) then
+         for I in Sig_Table.First .. Sig_Table.Last loop
+            Disp_Simple_Signal
+              (Sig_Table.Table (I), null, Options.Disp_Sources);
+         end loop;
+      else
+         Res := Disp_All_Signals (Get_Top_Context);
+      end if;
+   end Disp_All_Signals;
+
+
+
+   --  Option disp-signals-map
+
+   Cur_Signals_Map_Ctxt : Rti_Context;
+   Cur_Signals_Map_Obj : Ghdl_Rtin_Object_Acc;
+
+   procedure Disp_Signals_Map_Scalar (Val_Addr : Address;
+                                      Val_Name : Vstring;
+                                      Val_Type : Ghdl_Rti_Access)
+   is
+      pragma Unreferenced (Val_Type);
+
+      function To_Ghdl_Signal_Ptr is new Ada.Unchecked_Conversion
+        (Source => Address, Target => Ghdl_Signal_Ptr);
+
+      S : Ghdl_Signal_Ptr;
+   begin
+      Put (stdout, Cur_Signals_Map_Ctxt);
+      Put (".");
+      Disp_Signal_Name (stdout, Cur_Signals_Map_Obj);
+      Put (stdout, Val_Name);
+      Put (": ");
+      S := To_Ghdl_Signal_Ptr (To_Addr_Acc (Val_Addr).all);
+      Put (stdout, S.all'Address);
+      Put (" net: ");
+      Put_I32 (stdout, Ghdl_I32 (S.Net));
+      if S.Flags.Has_Active then
+         Put (" +A");
+      end if;
+      New_Line;
+   end Disp_Signals_Map_Scalar;
+
+   procedure Foreach_Disp_Signals_Map_Scalar is new
+     Foreach_Scalar (Process => Disp_Signals_Map_Scalar);
+
+   function Disp_Signals_Map_Signal (Ctxt : Rti_Context;
+                                     Obj : Ghdl_Rti_Access)
+                                    return Traverse_Result
+   is
+      Sig : Ghdl_Rtin_Object_Acc renames Cur_Signals_Map_Obj;
+   begin
+      case Obj.Kind is
+         when Ghdl_Rtik_Signal
+           | Ghdl_Rtik_Port
+           | Ghdl_Rtik_Guard
+           | Ghdl_Rtik_Attribute_Stable
+           | Ghdl_Rtik_Attribute_Quiet
+           | Ghdl_Rtik_Attribute_Transaction =>
+            Cur_Signals_Map_Ctxt := Ctxt;
+            Cur_Signals_Map_Obj := To_Ghdl_Rtin_Object_Acc (Obj);
+            Foreach_Disp_Signals_Map_Scalar
+              (Ctxt, Sig.Obj_Type,
+               Loc_To_Addr (Sig.Common.Depth, Sig.Loc, Ctxt), True);
+         when others =>
+            null;
+      end case;
+      return Traverse_Ok;
+   end Disp_Signals_Map_Signal;
+
+   function Disp_Signals_Map_Blocks is new Traverse_Blocks
+     (Process => Disp_Signals_Map_Signal);
+
+   procedure Disp_Signals_Map
+   is
+      Res : Traverse_Result;
+   begin
+      Res := Disp_Signals_Map_Blocks (Get_Top_Context);
+      Grt.Stdio.fflush (stdout);
+   end Disp_Signals_Map;
+
+   --  Option --disp-signals-table
+   procedure Disp_Mode_Signal (Mode : Mode_Signal_Type)
+   is
+   begin
+      case Mode is
+         when Mode_Signal =>
+            Put ("signal");
+         when Mode_Linkage =>
+            Put ("linkage");
+         when Mode_Buffer =>
+            Put ("buffer");
+         when Mode_Out =>
+            Put ("out");
+         when Mode_Inout =>
+            Put ("inout");
+         when Mode_In =>
+            Put ("in");
+         when Mode_Stable =>
+            Put ("stable");
+         when Mode_Quiet =>
+            Put ("quiet");
+         when Mode_Transaction =>
+            Put ("transaction");
+         when Mode_Delayed =>
+            Put ("delayed");
+         when Mode_Guard =>
+            Put ("guard");
+         when Mode_Conv_In =>
+            Put ("conv_in");
+         when Mode_Conv_Out =>
+            Put ("conv_out");
+         when Mode_End =>
+            Put ("end");
+      end case;
+   end Disp_Mode_Signal;
+
+   procedure Disp_Signals_Table
+   is
+      use Grt.Disp;
+      Sig : Ghdl_Signal_Ptr;
+   begin
+      for I in Sig_Table.First .. Sig_Table.Last loop
+         Sig := Sig_Table.Table (I);
+         Put_Sig_Index (I);
+         Put (": ");
+         Put (stdout, Sig.all'Address);
+         if Sig.Flags.Has_Active then
+            Put (" +A");
+         end if;
+         Put (" net: ");
+         Put_I32 (stdout,  Ghdl_I32 (Sig.Net));
+         Put (" smode: ");
+         Disp_Mode_Signal (Sig.S.Mode_Sig);
+         Put (" #prt: ");
+         Put_I32 (stdout, Ghdl_I32 (Sig.Nbr_Ports));
+         if Sig.S.Mode_Sig in Mode_Signal_User then
+            Put (" #drv: ");
+            Put_I32 (stdout, Ghdl_I32 (Sig.S.Nbr_Drivers));
+            if Sig.S.Effective /= null then
+               Put (" eff: ");
+               Put (stdout, Sig.S.Effective.all'Address);
+            end if;
+            if Sig.S.Resolv /= null then
+               Put (" resolved");
+            end if;
+         end if;
+         if Boolean'(False) then
+            Put (" link: ");
+            Put (stdout, Sig.Link.all'Address);
+         end if;
+         New_Line;
+         if Sig.Nbr_Ports /= 0 then
+            for J in 1 .. Sig.Nbr_Ports loop
+               Put ("  ");
+               Put (stdout, Sig.Ports (J - 1).all'Address);
+            end loop;
+            New_Line;
+         end if;
+      end loop;
+      Grt.Stdio.fflush (stdout);
+   end Disp_Signals_Table;
+
+   procedure Disp_A_Signal (Sig : Ghdl_Signal_Ptr)
+   is
+   begin
+      Disp_Simple_Signal (Sig, null, True);
+   end Disp_A_Signal;
+
+   procedure Put_Signal_Name (Stream : FILEs; Sig : Ghdl_Signal_Ptr)
+   is
+      Found : Boolean := False;
+      Cur_Ctxt : Rti_Context;
+      Cur_Sig : Ghdl_Rtin_Object_Acc;
+
+      procedure Process_Scalar  (Val_Addr : Address;
+                                 Val_Name : Vstring;
+                                 Val_Type : Ghdl_Rti_Access)
+      is
+         pragma Unreferenced (Val_Type);
+         Sig1 : Ghdl_Signal_Ptr;
+      begin
+         --  Read the signal.
+         Sig1 := To_Ghdl_Signal_Ptr (To_Addr_Acc (Val_Addr).all);
+         if Sig1 = Sig and not Found then
+            Put (Stream, Cur_Ctxt);
+            Put (Stream, ".");
+            Disp_Signal_Name (Stream, Cur_Sig);
+            Put (Stream, Val_Name);
+            Found := True;
+         end if;
+      end Process_Scalar;
+
+      procedure Foreach_Scalar is new Grt.Rtis_Utils.Foreach_Scalar
+        (Process_Scalar);
+
+      function Process_Block (Ctxt : Rti_Context;
+                              Obj : Ghdl_Rti_Access)
+                             return Traverse_Result
+      is
+      begin
+         case Obj.Kind is
+            when Ghdl_Rtik_Signal
+              | Ghdl_Rtik_Port
+              | Ghdl_Rtik_Guard
+              | Ghdl_Rtik_Attribute_Stable
+              | Ghdl_Rtik_Attribute_Quiet
+              | Ghdl_Rtik_Attribute_Transaction =>
+               Cur_Ctxt := Ctxt;
+               Cur_Sig := To_Ghdl_Rtin_Object_Acc (Obj);
+               Foreach_Scalar
+                 (Ctxt, Cur_Sig.Obj_Type,
+                  Loc_To_Addr (Cur_Sig.Common.Depth, Cur_Sig.Loc, Ctxt), True);
+               if Found then
+                  return Traverse_Stop;
+               end if;
+            when others =>
+               null;
+         end case;
+         return Traverse_Ok;
+      end Process_Block;
+
+      function Foreach_Block is new Grt.Rtis_Utils.Traverse_Blocks
+        (Process_Block);
+
+      Res_Status : Traverse_Result;
+   begin
+      Res_Status := Foreach_Block (Get_Top_Context);
+      if not Found then
+         Put (Stream, "(unknown signal)");
+      end if;
+   end Put_Signal_Name;
+
+end Grt.Disp_Signals;
diff --git a/translate/grt/grt-disp_signals.ads b/translate/grt/grt-disp_signals.ads
new file mode 100644
index 000000000..fd84fe036
--- /dev/null
+++ b/translate/grt/grt-disp_signals.ads
@@ -0,0 +1,39 @@
+--  GHDL Run Time (GRT) - Display subprograms for signals.
+--  Copyright (C) 2002, 2003, 2004, 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;
+with Grt.Signals; use Grt.Signals;
+with Grt.Stdio; use Grt.Stdio;
+
+package Grt.Disp_Signals is
+   procedure Disp_All_Signals;
+
+   procedure Disp_Signals_Map;
+
+   procedure Disp_Signals_Table;
+
+   procedure Disp_Mode_Signal (Mode : Mode_Signal_Type);
+
+   --  Disp informations on signal SIG.
+   --  To be used inside the debugger.
+   procedure Disp_A_Signal (Sig : Ghdl_Signal_Ptr);
+
+   --  Put the full name of signal SIG.
+   --  This operation is really expensive, since the whole hierarchy is
+   --  traversed.
+   procedure Put_Signal_Name (Stream : FILEs; Sig : Ghdl_Signal_Ptr);
+end Grt.Disp_Signals;
diff --git a/translate/grt/grt-errors.adb b/translate/grt/grt-errors.adb
new file mode 100644
index 000000000..4a6aca83c
--- /dev/null
+++ b/translate/grt/grt-errors.adb
@@ -0,0 +1,225 @@
+--  GHDL Run Time (GRT) - Error handling.
+--  Copyright (C) 2002, 2003, 2004, 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.Stdio; use Grt.Stdio;
+with Grt.Astdio; use Grt.Astdio;
+with Grt.Types; use Grt.Types;
+with Grt.Options; use Grt.Options;
+
+package body Grt.Errors is
+   procedure Fatal_Error;
+   pragma No_Return (Fatal_Error);
+   pragma Export (C, Fatal_Error, "__ghdl_fatal");
+
+   --  Called in case of premature exit.
+   --  CODE is 0 for success, 1 for failure.
+   procedure Ghdl_Exit (Code : Integer);
+   pragma No_Return (Ghdl_Exit);
+
+   procedure Ghdl_Exit (Code : Integer)
+   is
+      procedure C_Exit (Status : Integer);
+      pragma Import (C, C_Exit, "exit");
+      pragma No_Return (C_Exit);
+   begin
+      if Ghdl_Exit_Cb1 /= null then
+         Ghdl_Exit_Cb1.all (Code);
+      end if;
+
+      if Ghdl_Exit_Cb /= null then
+         Ghdl_Exit_Cb.all (Code);
+      end if;
+      C_Exit (Code);
+   end Ghdl_Exit;
+
+   procedure Maybe_Return_Via_Longjump (Val : Integer);
+   pragma Import (C, Maybe_Return_Via_Longjump,
+                  "__ghdl_maybe_return_via_longjump");
+
+   procedure Fatal_Error is
+   begin
+      Maybe_Return_Via_Longjump (-1);
+      if Expect_Failure then
+         Ghdl_Exit (0);
+      else
+         Ghdl_Exit (1);
+      end if;
+   end Fatal_Error;
+
+   procedure Put_Err (Str : String) is
+   begin
+      Put (stderr, Str);
+   end Put_Err;
+
+   procedure Put_Err (Str : Ghdl_C_String) is
+   begin
+      Put (stderr, Str);
+   end Put_Err;
+
+   procedure Put_Err (N : Integer) is
+   begin
+      Put_I32 (stderr, Ghdl_I32 (N));
+   end Put_Err;
+
+   procedure Newline_Err is
+   begin
+      New_Line (stderr);
+   end Newline_Err;
+
+--    procedure Put_Err (Str : Ghdl_Str_Len_Type)
+--    is
+--       S : String (1 .. 3);
+--    begin
+--       if Str.Str = null then
+--          S (1) := ''';
+--          S (2) := Character'Val (Str.Len);
+--          S (3) := ''';
+--          Put_Err (S);
+--       else
+--          Put_Err (Str.Str (1 .. Str.Len));
+--       end if;
+--    end Put_Err;
+
+   procedure Report_H (Str : String := "") is
+   begin
+      Put_Err (Str);
+   end Report_H;
+
+   procedure Report_C (Str : String) is
+   begin
+      Put_Err (Str);
+   end Report_C;
+
+   procedure Report_C (Str : Ghdl_C_String)
+   is
+      Len : Natural := strlen (Str);
+   begin
+      Put_Err (Str (1 .. Len));
+   end Report_C;
+
+   procedure Report_C (N : Integer)
+     renames Put_Err;
+
+   procedure Report_Now_C is
+   begin
+      Put_Time (stderr, Grt.Types.Current_Time);
+   end Report_Now_C;
+
+   procedure Report_E (Str : String) is
+   begin
+      Put_Err (Str);
+      Newline_Err;
+   end Report_E;
+
+   procedure Error_H is
+   begin
+      Put_Err (Progname);
+      Put_Err (":error: ");
+   end Error_H;
+
+   Cont : Boolean := False;
+
+   procedure Error_C (Str : String) is
+   begin
+      if not Cont then
+         Error_H;
+         Cont := True;
+      end if;
+      Put_Err (Str);
+   end Error_C;
+
+   procedure Error_C (Str : Ghdl_C_String)
+   is
+      Len : Natural := strlen (Str);
+   begin
+      if not Cont then
+         Error_H;
+         Cont := True;
+      end if;
+      Put_Err (Str (1 .. Len));
+   end Error_C;
+
+   procedure Error_C (N : Integer) is
+   begin
+      if not Cont then
+         Error_H;
+         Cont := True;
+      end if;
+      Put_Err (N);
+   end Error_C;
+
+--    procedure Error_C (Inst : Ghdl_Instance_Name_Acc)
+--    is
+--    begin
+--       if not Cont then
+--          Error_H;
+--          Cont := True;
+--       end if;
+--       if Inst.Parent /= null then
+--          Error_C (Inst.Parent);
+--          Put_Err (".");
+--       end if;
+--       case Inst.Kind is
+--          when Ghdl_Name_Architecture =>
+--             Put_Err ("(");
+--             Put_Err (Inst.Name.all);
+--             Put_Err (")");
+--          when others =>
+--             if Inst.Name /= null then
+--                Put_Err (Inst.Name.all);
+--             end if;
+--       end case;
+--    end Error_C;
+
+   procedure Error_E (Str : String) is
+   begin
+      Put_Err (Str);
+      Newline_Err;
+      Cont := False;
+      Fatal_Error;
+   end Error_E;
+
+   procedure Error (Str : String) is
+   begin
+      Error_H;
+      Put_Err (Str);
+      Newline_Err;
+      Fatal_Error;
+   end Error;
+
+   procedure Info (Str : String) is
+   begin
+      Put_Err (Progname);
+      Put_Err (":info: ");
+      Put_Err (Str);
+      Newline_Err;
+   end Info;
+
+   procedure Internal_Error (Msg : String) is
+   begin
+      Put_Err (Progname);
+      Put_Err (":internal error: ");
+      Put_Err (Msg);
+      Newline_Err;
+      Fatal_Error;
+   end Internal_Error;
+
+   procedure Grt_Overflow_Error is
+   begin
+      Error ("overflow detected");
+   end Grt_Overflow_Error;
+end Grt.Errors;
diff --git a/translate/grt/grt-errors.ads b/translate/grt/grt-errors.ads
new file mode 100644
index 000000000..b531aef11
--- /dev/null
+++ b/translate/grt/grt-errors.ads
@@ -0,0 +1,70 @@
+--  GHDL Run Time (GRT) - Error handling.
+--  Copyright (C) 2002, 2003, 2004, 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 Grt.Errors is
+   pragma Preelaborate (Grt.Errors);
+
+   --  Multi-call error procedure.
+   --  Start and continue with Error_C, finish by an Error_E.
+   procedure Error_C (Str : String);
+   procedure Error_C (N : Integer);
+   procedure Error_C (Str : Ghdl_C_String);
+   --procedure Error_C (Inst : Ghdl_Instance_Name_Acc);
+   procedure Error_E (Str : String);
+   pragma No_Return (Error_E);
+
+   --  Multi-call report procedure.  Do not exit at end.
+   procedure Report_H (Str : String := "");
+   procedure Report_C (Str : Ghdl_C_String);
+   procedure Report_C (Str : String);
+   procedure Report_C (N : Integer);
+   procedure Report_Now_C;
+   procedure Report_E (Str : String);
+
+   --  Complete error message.
+   procedure Error (Str : String);
+
+   --  Internal error.  The message must contain the subprogram name which
+   --  has called this procedure.
+   procedure Internal_Error (Msg : String);
+   pragma No_Return (Internal_Error);
+
+   --  Display a message which is not an error.
+   procedure Info (Str : String);
+
+   --  Display an error message for an overflow.
+   procedure Grt_Overflow_Error;
+
+   type Exit_Cb_Type is access procedure (Code : Integer);
+   pragma Convention (C, Exit_Cb_Type);
+
+   Ghdl_Exit_Cb : Exit_Cb_Type := null;
+   Ghdl_Exit_Cb1 : Exit_Cb_Type := null;
+
+   --  If true, an error is expected and the exit status is inverted.
+   Expect_Failure : Boolean := False;
+
+private
+   pragma Export (C, Ghdl_Exit_Cb, "__ghdl_exit_cb");
+
+   pragma Export (C, Grt_Overflow_Error, "grt_overflow_error");
+
+   pragma No_Return (Error);
+end Grt.Errors;
+
diff --git a/translate/grt/grt-files.adb b/translate/grt/grt-files.adb
new file mode 100644
index 000000000..d0063226a
--- /dev/null
+++ b/translate/grt/grt-files.adb
@@ -0,0 +1,429 @@
+--  GHDL Run Time (GRT) -  VHDL files subprograms.
+--  Copyright (C) 2002, 2003, 2004, 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.Errors; use Grt.Errors;
+with Grt.Stdio; use Grt.Stdio;
+with GNAT.Table;
+with System; use System;
+
+package body Grt.Files is
+   subtype C_Files is Grt.Stdio.FILEs;
+
+   type File_Entry_Type is record
+      Stream : C_Files;
+      Signature : Ghdl_C_String;
+      Is_Text : Boolean;
+      Is_Alive : Boolean;
+   end record;
+
+   package Files_Table is new GNAT.Table
+     (Table_Component_Type => File_Entry_Type,
+      Table_Index_Type => Ghdl_File_Index,
+      Table_Low_Bound => 1,
+      Table_Initial => 2,
+      Table_Increment => 100);
+
+   function Get_File (Index : Ghdl_File_Index) return C_Files
+   is
+   begin
+      if Index not in Files_Table.First .. Files_Table.Last then
+         Internal_Error ("get_file: bad file index");
+      end if;
+      return Files_Table.Table (Index).Stream;
+   end Get_File;
+
+   procedure Check_File_Mode (Index : Ghdl_File_Index; Is_Text : Boolean)
+   is
+   begin
+      if Files_Table.Table (Index).Is_Text /= Is_Text then
+         Internal_Error ("check_file_mode: bad file mode");
+      end if;
+   end Check_File_Mode;
+
+   function Create_File (Is_Text : Boolean; Sig : Ghdl_C_String)
+                        return Ghdl_File_Index
+   is
+      Res : Ghdl_File_Index;
+   begin
+      Files_Table.Increment_Last;
+      Res := Files_Table.Last;
+      Files_Table.Table (Res) := (Stream => NULL_Stream,
+                                  Signature => Sig,
+                                  Is_Text => Is_Text,
+                                  Is_Alive => True);
+      return Res;
+   end Create_File;
+
+   procedure Destroy_File (Is_Text : Boolean; Index : Ghdl_File_Index) is
+   begin
+      if Get_File (Index) /= NULL_Stream then
+         Internal_Error ("destroy_file");
+      end if;
+      Check_File_Mode (Index, Is_Text);
+      Files_Table.Table (Index).Is_Alive := False;
+      if Index = Files_Table.Last then
+         while Files_Table.Last >= Files_Table.First
+           and then Files_Table.Table (Files_Table.Last).Is_Alive = False
+         loop
+            Files_Table.Decrement_Last;
+         end loop;
+      end if;
+   end Destroy_File;
+
+   procedure File_Error (File : Ghdl_File_Index)
+   is
+      pragma Unreferenced (File);
+   begin
+      Internal_Error ("file: IO error");
+   end File_Error;
+
+   function Ghdl_Text_File_Elaborate return Ghdl_File_Index is
+   begin
+      return Create_File (True, null);
+   end Ghdl_Text_File_Elaborate;
+
+   function Ghdl_File_Elaborate (Sig : Ghdl_C_String) return Ghdl_File_Index
+   is
+   begin
+      return Create_File (False, Sig);
+   end Ghdl_File_Elaborate;
+
+   procedure Ghdl_Text_File_Finalize (File : Ghdl_File_Index) is
+   begin
+      Destroy_File (True, File);
+   end Ghdl_Text_File_Finalize;
+
+   procedure Ghdl_File_Finalize (File : Ghdl_File_Index) is
+   begin
+      Destroy_File (False, File);
+   end Ghdl_File_Finalize;
+
+   function Ghdl_File_Endfile (File : Ghdl_File_Index) return Boolean
+   is
+      Stream : C_Files;
+      C : int;
+   begin
+      Stream := Get_File (File);
+      if feof (Stream) /= 0 then
+         return True;
+      end if;
+      C := fgetc (Stream);
+      if C < 0 then
+         return True;
+      end if;
+      if ungetc (C, Stream) /= C then
+         Error ("internal error: ungetc");
+      end if;
+      return False;
+   end Ghdl_File_Endfile;
+
+   Sig_Header : constant String := "#GHDL-BINARY-FILE-0.0" & Nl;
+
+   function File_Open (File : Ghdl_File_Index;
+                       Mode : Ghdl_I32;
+                       Str : Std_String_Ptr)
+     return Ghdl_I32
+   is
+      Name : String (1 .. Integer (Str.Bounds.Dim_1.Length) + 1);
+      Str_Mode : String (1 .. 3);
+      F : C_Files;
+      Sig : Ghdl_C_String;
+      Sig_Len : Natural;
+   begin
+      F := Get_File (File);
+
+      if F /= NULL_Stream then
+         --  File was already open.
+         return Status_Error;
+      end if;
+
+      --  Copy file name and convert it to a C string (NUL terminated).
+      for I in 0 .. Str.Bounds.Dim_1.Length - 1 loop
+         Name (1 + Natural (I)) := Str.Base (I);
+      end loop;
+      Name (Name'Last) := NUL;
+
+      if Name = "STD_INPUT" & NUL then
+         if Mode /= Read_Mode then
+            return Mode_Error;
+         end if;
+         F := stdin;
+      elsif Name = "STD_OUTPUT" & NUL then
+         if Mode /= Write_Mode then
+            return Mode_Error;
+         end if;
+         F := stdout;
+      else
+         case Mode is
+            when Read_Mode =>
+               Str_Mode (1) := 'r';
+            when Write_Mode =>
+               Str_Mode (1) := 'w';
+            when Append_Mode =>
+               Str_Mode (1) := 'a';
+            when others =>
+               --  Bad mode, cannot happen.
+               Internal_Error ("file_open: bad open mode");
+         end case;
+         if Files_Table.Table (File).Is_Text then
+            Str_Mode (2) := NUL;
+         else
+            Str_Mode (2) := 'b';
+            Str_Mode (3) := NUL;
+         end if;
+         F := fopen (Name'Address, Str_Mode'Address);
+         if F = NULL_Stream then
+            return Name_Error;
+         end if;
+      end if;
+      Sig := Files_Table.Table (File).Signature;
+      if Sig /= null then
+         Sig_Len := strlen (Sig);
+         case Mode is
+            when Write_Mode =>
+               if fwrite (Sig_Header'Address, 1, Sig_Header'Length, F)
+                 /= Sig_Header'Length
+               then
+                  File_Error (File);
+               end if;
+               if fwrite (Sig (1)'Address, 1, size_t (Sig_Len), F)
+                 /= size_t (Sig_Len)
+               then
+                  File_Error (File);
+               end if;
+            when Read_Mode =>
+               declare
+                  Hdr : String (1 .. Sig_Header'Length);
+                  Sig_Buf : String (1 .. Sig_Len);
+               begin
+                  if fread (Hdr'Address, 1, Hdr'Length, F) /= Hdr'Length then
+                     File_Error (File);
+                  end if;
+                  if Hdr /= Sig_Header then
+                     File_Error (File);
+                  end if;
+                  if fread (Sig_Buf'Address, 1, Sig_Buf'Length, F)
+                    /= Sig_Buf'Length
+                  then
+                     File_Error (File);
+                  end if;
+                  if Sig_Buf /= Sig (1 .. Sig_Len) then
+                     File_Error (File);
+                  end if;
+               end;
+            when Append_Mode =>
+               null;
+            when others =>
+               null;
+         end case;
+      end if;
+      Files_Table.Table (File).Stream := F;
+      return Open_Ok;
+   end File_Open;
+
+   procedure Ghdl_Text_File_Open
+     (File : Ghdl_File_Index; Mode : Ghdl_I32; Str : Std_String_Ptr)
+   is
+      Res : Ghdl_I32;
+   begin
+      Check_File_Mode (File, True);
+
+      Res := File_Open (File, Mode, Str);
+
+      if Res /= Open_Ok then
+         Error_C ("open: cannot open text file ");
+         Error_E (String (Str.Base (0 .. Str.Bounds.Dim_1.Length - 1)));
+      end if;
+   end Ghdl_Text_File_Open;
+
+   procedure Ghdl_File_Open
+     (File : Ghdl_File_Index; Mode : Ghdl_I32; Str : Std_String_Ptr)
+   is
+      Res : Ghdl_I32;
+   begin
+      Check_File_Mode (File, False);
+
+      Res := File_Open (File, Mode, Str);
+
+      if Res /= Open_Ok then
+         Error_C ("open: cannot open file ");
+         Error_E (String (Str.Base (0 .. Str.Bounds.Dim_1.Length - 1)));
+      end if;
+   end Ghdl_File_Open;
+
+   function Ghdl_Text_File_Open_Status
+     (File : Ghdl_File_Index; Mode : Ghdl_I32; Str : Std_String_Ptr)
+     return Ghdl_I32
+   is
+   begin
+      Check_File_Mode (File, True);
+      return File_Open (File, Mode, Str);
+   end Ghdl_Text_File_Open_Status;
+
+   function Ghdl_File_Open_Status
+     (File : Ghdl_File_Index; Mode : Ghdl_I32; Str : Std_String_Ptr)
+     return Ghdl_I32
+   is
+   begin
+      Check_File_Mode (File, False);
+      return File_Open (File, Mode, Str);
+   end Ghdl_File_Open_Status;
+
+   procedure Ghdl_Text_Write (File : Ghdl_File_Index; Str : Std_String_Ptr)
+   is
+      Res : C_Files;
+      R : size_t;
+      R1 : int;
+   begin
+      Res := Get_File (File);
+      Check_File_Mode (File, True);
+      if Res = NULL_Stream then
+         Error ("write to a non-opened file");
+      end if;
+      --  FIXME: check mode.
+      R := fwrite (Str.Base (0)'Address,
+                   size_t (Str.Bounds.Dim_1.Length), 1, Res);
+      --  FIXME: check r
+      --  Write '\n'.
+      R1 := fputc (Character'Pos (Nl), Res);
+      R1 := fflush (Res);
+   end Ghdl_Text_Write;
+
+   procedure Ghdl_Write_Scalar (File : Ghdl_File_Index;
+                                Ptr : Ghdl_Ptr;
+                                Length : Ghdl_Index_Type)
+   is
+      Res : C_Files;
+      R : size_t;
+      R1 : int;
+   begin
+      Res := Get_File (File);
+      Check_File_Mode (File, False);
+      if Res = NULL_Stream then
+         Error ("write to a non-opened file");
+      end if;
+      --  FIXME: check mode.
+      R := fwrite (System.Address (Ptr), size_t (Length), 1, Res);
+      if R /= 1 then
+         Error ("write_scalar failed");
+      end if;
+      R1 := fflush (Res);
+   end Ghdl_Write_Scalar;
+
+   procedure Ghdl_Read_Scalar (File : Ghdl_File_Index;
+                               Ptr : Ghdl_Ptr;
+                               Length : Ghdl_Index_Type)
+   is
+      Res : C_Files;
+      R : size_t;
+   begin
+      Res := Get_File (File);
+      Check_File_Mode (File, False);
+      if Res = NULL_Stream then
+         Error ("write to a non-opened file");
+      end if;
+      --  FIXME: check mode.
+      R := fread (System.Address (Ptr), size_t (Length), 1, Res);
+      if R /= 1 then
+         Error ("read_scalar failed");
+      end if;
+   end Ghdl_Read_Scalar;
+
+   function Ghdl_Text_Read_Length (File : Ghdl_File_Index;
+                                   Str : Std_String_Ptr)
+     return Std_Integer
+   is
+      Stream : C_Files;
+      C : int;
+      Len : Ghdl_Index_Type;
+   begin
+      Stream := Get_File (File);
+      Check_File_Mode (File, True);
+      Len := Str.Bounds.Dim_1.Length;
+      --  Read until EOL (or EOF).
+      --  Store as much as possible.
+      for I in Ghdl_Index_Type loop
+         C := fgetc (Stream);
+         if C < 0 then
+            Error ("read: end of file reached");
+            return Std_Integer (I);
+         end if;
+         if I < Len then
+            Str.Base (I) := Character'Val (C);
+         end if;
+         --  End of line is '\n' or LF or character # 10.
+         if C = 10 then
+            return Std_Integer (I + 1);
+         end if;
+      end loop;
+      return 0;
+   end Ghdl_Text_Read_Length;
+
+   procedure Ghdl_Untruncated_Text_Read
+     (Res : Ghdl_Untruncated_Text_Read_Result_Acc;
+      File : Ghdl_File_Index;
+      Str : Std_String_Ptr)
+   is
+      Stream : C_Files;
+      Len : int;
+      Idx : Ghdl_Index_Type;
+   begin
+      Stream := Get_File (File);
+      Check_File_Mode (File, True);
+      Len := int (Str.Bounds.Dim_1.Length);
+      if fgets (Str.Base (0)'Address, Len, Stream) = Null_Address then
+         Internal_Error ("ghdl_untruncated_text_read: end of file");
+      end if;
+      --  Compute the length.
+      for I in Ghdl_Index_Type loop
+         if Str.Base (I) = NUL then
+            Idx := I;
+            exit;
+         end if;
+      end loop;
+      Res.Len :=  Std_Integer (Idx);
+   end Ghdl_Untruncated_Text_Read;
+
+   procedure File_Close (File : Ghdl_File_Index; Is_Text : Boolean)
+   is
+      Stream : C_Files;
+   begin
+      Stream := Get_File (File);
+      Check_File_Mode (File, Is_Text);
+      --  LRM 3.4.1  File Operations
+      --  If F is not associated with an external file, then FILE_CLOSE has
+      --  no effect.
+      if Stream = NULL_Stream then
+         return;
+      end if;
+      if fclose (Stream) /= 0 then
+         Internal_Error ("file_close: fclose error");
+      end if;
+      Files_Table.Table (File).Stream := NULL_Stream;
+   end File_Close;
+
+   procedure Ghdl_Text_File_Close (File : Ghdl_File_Index) is
+   begin
+      File_Close (File, True);
+   end Ghdl_Text_File_Close;
+
+   procedure Ghdl_File_Close (File : Ghdl_File_Index) is
+   begin
+      File_Close (File, False);
+   end Ghdl_File_Close;
+end Grt.Files;
+
diff --git a/translate/grt/grt-files.ads b/translate/grt/grt-files.ads
new file mode 100644
index 000000000..1fcce3cd4
--- /dev/null
+++ b/translate/grt/grt-files.ads
@@ -0,0 +1,112 @@
+--  GHDL Run Time (GRT) -  VHDL files subprograms.
+--  Copyright (C) 2002, 2003, 2004, 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;
+with Interfaces;
+
+package Grt.Files is
+   type Ghdl_File_Index is new Interfaces.Integer_32;
+
+   --  File open mode.
+   Read_Mode   : constant Ghdl_I32 := 0;
+   Write_Mode  : constant Ghdl_I32 := 1;
+   Append_Mode : constant Ghdl_I32 := 2;
+
+   --  file_open_status.
+   Open_Ok      : constant Ghdl_I32 := 0;
+   Status_Error : constant Ghdl_I32 := 1;
+   Name_Error   : constant Ghdl_I32 := 2;
+   Mode_Error   : constant Ghdl_I32 := 3;
+
+   --  General files.
+   function Ghdl_File_Endfile (File : Ghdl_File_Index) return Boolean;
+
+   --  Elaboration.
+   function Ghdl_Text_File_Elaborate return Ghdl_File_Index;
+   function Ghdl_File_Elaborate (Sig : Ghdl_C_String) return Ghdl_File_Index;
+
+   --  Finalization.
+   procedure Ghdl_Text_File_Finalize (File : Ghdl_File_Index);
+   procedure Ghdl_File_Finalize (File : Ghdl_File_Index);
+
+   --  Subprograms.
+   procedure Ghdl_Text_File_Open
+     (File : Ghdl_File_Index; Mode : Ghdl_I32; Str : Std_String_Ptr);
+   function Ghdl_Text_File_Open_Status
+     (File : Ghdl_File_Index; Mode : Ghdl_I32; Str : Std_String_Ptr)
+     return Ghdl_I32;
+
+   procedure Ghdl_File_Open
+     (File : Ghdl_File_Index; Mode : Ghdl_I32; Str : Std_String_Ptr);
+   function Ghdl_File_Open_Status
+     (File : Ghdl_File_Index; Mode : Ghdl_I32; Str : Std_String_Ptr)
+     return Ghdl_I32;
+
+   procedure Ghdl_Text_Write (File : Ghdl_File_Index; Str : Std_String_Ptr);
+   procedure Ghdl_Write_Scalar (File : Ghdl_File_Index;
+                                Ptr : Ghdl_Ptr;
+                                Length : Ghdl_Index_Type);
+
+   procedure Ghdl_Read_Scalar (File : Ghdl_File_Index;
+                               Ptr : Ghdl_Ptr;
+                               Length : Ghdl_Index_Type);
+
+   function Ghdl_Text_Read_Length
+     (File : Ghdl_File_Index; Str : Std_String_Ptr) return Std_Integer;
+
+   type Ghdl_Untruncated_Text_Read_Result is record
+      Len : Std_Integer;
+   end record;
+
+   type Ghdl_Untruncated_Text_Read_Result_Acc is
+     access Ghdl_Untruncated_Text_Read_Result;
+
+   procedure Ghdl_Untruncated_Text_Read
+     (Res : Ghdl_Untruncated_Text_Read_Result_Acc;
+      File : Ghdl_File_Index;
+      Str : Std_String_Ptr);
+
+   procedure Ghdl_Text_File_Close (File : Ghdl_File_Index);
+   procedure Ghdl_File_Close (File : Ghdl_File_Index);
+private
+   pragma Export (C, Ghdl_File_Endfile, "__ghdl_file_endfile");
+
+   pragma Export (C, Ghdl_Text_File_Elaborate, "__ghdl_text_file_elaborate");
+   pragma Export (C, Ghdl_File_Elaborate, "__ghdl_file_elaborate");
+
+   pragma Export (C, Ghdl_Text_File_Finalize, "__ghdl_text_file_finalize");
+   pragma Export (C, Ghdl_File_Finalize, "__ghdl_file_finalize");
+
+   pragma Export (C, Ghdl_Text_File_Open, "__ghdl_text_file_open");
+   pragma Export (C, Ghdl_Text_File_Open_Status,
+                  "__ghdl_text_file_open_status");
+
+   pragma Export (C, Ghdl_File_Open, "__ghdl_file_open");
+   pragma Export (C, Ghdl_File_Open_Status, "__ghdl_file_open_status");
+
+   pragma Export (C, Ghdl_Text_Write, "__ghdl_text_write");
+   pragma Export (C, Ghdl_Write_Scalar, "__ghdl_write_scalar");
+
+   pragma Export (C, Ghdl_Read_Scalar, "__ghdl_read_scalar");
+
+   pragma Export (C, Ghdl_Text_Read_Length, "__ghdl_text_read_length");
+   pragma Export (C, Ghdl_Untruncated_Text_Read,
+                  "std__textio__untruncated_text_read");
+
+   pragma Export (C, Ghdl_Text_File_Close, "__ghdl_text_file_close");
+   pragma Export (C, Ghdl_File_Close, "__ghdl_file_close");
+end Grt.Files;
diff --git a/translate/grt/grt-hooks.adb b/translate/grt/grt-hooks.adb
new file mode 100644
index 000000000..3f79b5747
--- /dev/null
+++ b/translate/grt/grt-hooks.adb
@@ -0,0 +1,154 @@
+--  GHDL Run Time (GRT) -  Hooks.
+--  Copyright (C) 2002, 2003, 2004, 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.
+
+package body Grt.Hooks is
+   type Hooks_Cell;
+   type Hooks_Cell_Acc is access Hooks_Cell;
+   type Hooks_Cell is record
+      Hooks : Hooks_Acc;
+      Next : Hooks_Cell_Acc;
+   end record;
+
+   First_Hooks : Hooks_Cell_Acc := null;
+   Last_Hooks : Hooks_Cell_Acc := null;
+
+   procedure Register_Hooks (Hooks : Hooks_Acc)
+   is
+      Cell : Hooks_Cell_Acc;
+   begin
+      Cell := new Hooks_Cell'(Hooks => Hooks,
+                              Next => null);
+      if Last_Hooks = null then
+         First_Hooks := Cell;
+      else
+         Last_Hooks.Next := Cell;
+      end if;
+      Last_Hooks := Cell;
+   end Register_Hooks;
+
+   type Hook_Cell;
+   type Hook_Cell_Acc is access Hook_Cell;
+   type Hook_Cell is record
+      Hook : Proc_Hook_Type;
+      Next : Hook_Cell_Acc;
+   end record;
+
+   --  Chain of cycle hooks.
+   Cycle_Hook : Hook_Cell_Acc := null;
+   Last_Cycle_Hook : Hook_Cell_Acc := null;
+
+   procedure Register_Cycle_Hook (Proc : Proc_Hook_Type)
+   is
+      Cell : Hook_Cell_Acc;
+   begin
+      Cell := new Hook_Cell'(Hook => Proc,
+                             Next => null);
+      if Cycle_Hook = null then
+         Cycle_Hook := Cell;
+      else
+         Last_Cycle_Hook.Next := Cell;
+      end if;
+      Last_Cycle_Hook := Cell;
+   end Register_Cycle_Hook;
+
+   procedure Call_Cycle_Hooks
+   is
+      Cell : Hook_Cell_Acc;
+   begin
+      Cell := Cycle_Hook;
+      while Cell /= null loop
+         Cell.Hook.all;
+         Cell := Cell.Next;
+      end loop;
+   end Call_Cycle_Hooks;
+
+   function Call_Option_Hooks (Opt : String) return Boolean
+   is
+      Cell : Hooks_Cell_Acc;
+   begin
+      Cell := First_Hooks;
+      while Cell /= null loop
+         if Cell.Hooks.Option /= null
+           and then Cell.Hooks.Option.all (Opt)
+         then
+            return True;
+         end if;
+         Cell := Cell.Next;
+      end loop;
+      return False;
+   end Call_Option_Hooks;
+
+   procedure Call_Help_Hooks
+   is
+      Cell : Hooks_Cell_Acc;
+   begin
+      Cell := First_Hooks;
+      while Cell /= null loop
+         if Cell.Hooks.Help /= null then
+            Cell.Hooks.Help.all;
+         end if;
+         Cell := Cell.Next;
+      end loop;
+   end Call_Help_Hooks;
+
+   procedure Call_Init_Hooks
+   is
+      Cell : Hooks_Cell_Acc;
+   begin
+      Cell := First_Hooks;
+      while Cell /= null loop
+         if Cell.Hooks.Init /= null then
+            Cell.Hooks.Init.all;
+         end if;
+         Cell := Cell.Next;
+      end loop;
+   end Call_Init_Hooks;
+
+   procedure Call_Start_Hooks
+   is
+      Cell : Hooks_Cell_Acc;
+   begin
+      Cell := First_Hooks;
+      while Cell /= null loop
+         if Cell.Hooks.Start /= null then
+            Cell.Hooks.Start.all;
+         end if;
+         Cell := Cell.Next;
+      end loop;
+   end Call_Start_Hooks;
+
+   procedure Call_Finish_Hooks
+   is
+      Cell : Hooks_Cell_Acc;
+   begin
+      Cell := First_Hooks;
+      while Cell /= null loop
+         if Cell.Hooks.Finish /= null then
+            Cell.Hooks.Finish.all;
+         end if;
+         Cell := Cell.Next;
+      end loop;
+   end Call_Finish_Hooks;
+
+   procedure Proc_Hook_Nil is
+   begin
+      null;
+   end Proc_Hook_Nil;
+end Grt.Hooks;
+
+
diff --git a/translate/grt/grt-hooks.ads b/translate/grt/grt-hooks.ads
new file mode 100644
index 000000000..fbab743dc
--- /dev/null
+++ b/translate/grt/grt-hooks.ads
@@ -0,0 +1,63 @@
+--  GHDL Run Time (GRT) -  Hooks.
+--  Copyright (C) 2002, 2003, 2004, 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.
+package Grt.Hooks is
+   pragma Preelaborate (Grt.Hooks);
+
+   type Option_Hook_Type is access function (Opt : String) return Boolean;
+   type Proc_Hook_Type is access procedure;
+
+   type Hooks_Type is record
+      --  Called for every unknown command line argument.
+      --  Return TRUE if handled.
+      Option : Option_Hook_Type;
+
+      --  Display command line help.
+      Help : Proc_Hook_Type;
+
+      --  Called at initialization (after decoding options).
+      Init : Proc_Hook_Type;
+
+      --  Called just after elaboration.
+      Start : Proc_Hook_Type;
+
+      --  Called at the end of execution.
+      Finish : Proc_Hook_Type;
+   end record;
+
+   type Hooks_Acc is access constant Hooks_Type;
+
+   --  Registers hook.
+   procedure Register_Hooks (Hooks : Hooks_Acc);
+
+   --  Register an hook which will call PROC after every non-delta cycles.
+   procedure Register_Cycle_Hook (Proc : Proc_Hook_Type);
+
+   --  Call hooks.
+   function Call_Option_Hooks (Opt : String) return Boolean;
+   procedure Call_Help_Hooks;
+   procedure Call_Init_Hooks;
+   procedure Call_Start_Hooks;
+   procedure Call_Finish_Hooks;
+
+   --  Call non-delta cycles hooks.
+   procedure Call_Cycle_Hooks;
+   pragma Inline_Always (Call_Cycle_Hooks);
+
+   --  Nil procedure.
+   procedure Proc_Hook_Nil;
+end Grt.Hooks;
diff --git a/translate/grt/grt-images.adb b/translate/grt/grt-images.adb
new file mode 100644
index 000000000..8b85d59ec
--- /dev/null
+++ b/translate/grt/grt-images.adb
@@ -0,0 +1,233 @@
+--  GHDL Run Time (GRT) -  'image subprograms.
+--  Copyright (C) 2002, 2003, 2004, 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; use System;
+with Ada.Unchecked_Conversion;
+with Grt.Processes; use Grt.Processes;
+with Grt.Vstrings; use Grt.Vstrings;
+
+package body Grt.Images is
+   function To_Std_String_Basep is new Ada.Unchecked_Conversion
+     (Source => System.Address, Target => Std_String_Basep);
+
+   function To_Std_String_Boundp is new Ada.Unchecked_Conversion
+     (Source => System.Address, Target => Std_String_Boundp);
+
+   procedure Return_String (Res : Std_String_Ptr; Str : String)
+   is
+   begin
+      Res.Base := To_Std_String_Basep (Ghdl_Stack2_Allocate (Str'Length));
+      Res.Bounds := To_Std_String_Boundp
+        (Ghdl_Stack2_Allocate (Std_String_Bound'Size / System.Storage_Unit));
+      for I in 0 .. Str'Length - 1 loop
+         Res.Base (Ghdl_Index_Type (I)) := Str (Str'First + I);
+      end loop;
+      Res.Bounds.Dim_1 := (Left => 1,
+                           Right => Str'Length,
+                           Dir => Dir_To,
+                           Length => Str'Length);
+   end Return_String;
+
+   procedure Return_Enum
+     (Res : Std_String_Ptr; Rti : Ghdl_Rti_Access; Index : Ghdl_Index_Type)
+   is
+      Enum_Rti : Ghdl_Rtin_Type_Enum_Acc;
+      Str : Ghdl_C_String;
+   begin
+      Enum_Rti := To_Ghdl_Rtin_Type_Enum_Acc (Rti);
+      Str := Enum_Rti.Names (Index);
+      Return_String (Res, Str (1 .. strlen (Str)));
+   end Return_Enum;
+
+   procedure Ghdl_Image_B2
+     (Res : Std_String_Ptr; Val : Ghdl_B2; Rti : Ghdl_Rti_Access)
+   is
+   begin
+      Return_Enum (Res, Rti, Ghdl_B2'Pos (Val));
+   end Ghdl_Image_B2;
+
+   procedure Ghdl_Image_E8
+     (Res : Std_String_Ptr; Val : Ghdl_E8; Rti : Ghdl_Rti_Access)
+   is
+   begin
+      Return_Enum (Res, Rti, Ghdl_E8'Pos (Val));
+   end Ghdl_Image_E8;
+
+   procedure Ghdl_Image_I32 (Res : Std_String_Ptr; Val : Ghdl_I32)
+   is
+      Str : String (1 .. 11);
+      First : Natural;
+   begin
+      To_String (Str, First, Val);
+      Return_String (Res, Str (First .. Str'Last));
+   end Ghdl_Image_I32;
+
+   procedure Ghdl_Image_P64
+     (Res : Std_String_Ptr; Val : Ghdl_I64; Rti : Ghdl_Rti_Access)
+   is
+      Str : String (1 .. 21);
+      First : Natural;
+      Unit : Ghdl_C_String;
+      Phys : Ghdl_Rtin_Type_Physical_Acc;
+      Unit_Len : Natural;
+   begin
+      To_String (Str, First, Val);
+      Phys := To_Ghdl_Rtin_Type_Physical_Acc (Rti);
+      Unit := To_Ghdl_Rtin_Unit_Acc (Phys.Units (0)).Name;
+      Unit_Len := strlen (Unit);
+      declare
+         L : Natural := Str'Last + 1 - First;
+         Str2 : String (1 .. L + 1 + Unit_Len);
+      begin
+         Str2 (1 .. L) := Str (First .. Str'Last);
+         Str2 (L + 1) := ' ';
+         Str2 (L + 2 .. Str2'Last) := Unit (1 .. Unit_Len);
+         Return_String (Res, Str2);
+      end;
+   end Ghdl_Image_P64;
+
+   procedure Ghdl_Image_P32
+     (Res : Std_String_Ptr; Val : Ghdl_I32; Rti : Ghdl_Rti_Access)
+   is
+      Str : String (1 .. 11);
+      First : Natural;
+      Unit : Ghdl_C_String;
+      Phys : Ghdl_Rtin_Type_Physical_Acc;
+      Unit_Len : Natural;
+   begin
+      To_String (Str, First, Val);
+      Phys := To_Ghdl_Rtin_Type_Physical_Acc (Rti);
+      Unit := To_Ghdl_Rtin_Unit_Acc (Phys.Units (0)).Name;
+      Unit_Len := strlen (Unit);
+      declare
+         L : Natural := Str'Last + 1 - First;
+         Str2 : String (1 .. L + 1 + Unit_Len);
+      begin
+         Str2 (1 .. L) := Str (First .. Str'Last);
+         Str2 (L + 1) := ' ';
+         Str2 (L + 2 .. Str2'Last) := Unit (1 .. Unit_Len);
+         Return_String (Res, Str2);
+      end;
+   end Ghdl_Image_P32;
+
+--    procedure Ghdl_Image_F64 (Res : Std_String_Ptr; Val : Ghdl_F64)
+--    is
+--       --  Sign (1) + digit (1) + dot (1) + digits (15) + exp (1) + sign (1)
+--       --  + exp_digits (4) -> 24.
+--       Str : String (1 .. 25);
+--       P : Natural;
+--       V : Ghdl_F64;
+--       Vd : Ghdl_F64;
+--       Exp : Integer;
+--       D : Integer;
+--       B : Boolean;
+--    begin
+--       --  Handle sign.
+--       if Val < 0.0 then
+--          Str (1) := '-';
+--          P := 1;
+--          V := -Val;
+--       else
+--          P := 0;
+--          V := Val;
+--       end if;
+
+--       --  Compute the mantissa.
+--       --  FIXME: should do a dichotomy.
+--       if V  = 0.0 then
+--          Exp := 0;
+--       elsif V < 1.0 then
+--          Exp := -1;
+--          while V * (10.0 ** (-Exp)) < 1.0 loop
+--             Exp := Exp - 1;
+--          end loop;
+--       else
+--          Exp := 0;
+--          while V / (10.0 ** Exp) >= 10.0 loop
+--             Exp := Exp + 1;
+--          end loop;
+--       end if;
+
+--       --  Normalize VAL: in [0; 10[
+--       if Exp >= 0 then
+--          V := V / (10.0 ** Exp);
+--       else
+--          V := V * 10.0 ** (-Exp);
+--       end if;
+
+--       for I in 0 .. 15 loop
+--          Vd := Ghdl_F64'Floor (V);
+--          P := P + 1;
+--          Str (P) := Character'Val (48 + Integer (Vd));
+--          V := (V - Vd) * 10.0;
+
+--          if I = 0 then
+--             P := P + 1;
+--             Str (P) := '.';
+--          end if;
+--          exit when I > 0 and V < 10.0 ** (I + 1 - 15);
+--       end loop;
+
+--       if Exp /= 0 then
+--          --  LRM93 14.3
+--          --  if the exponent is present, the `e' is written as a lower case
+--          --  character.
+--          P := P + 1;
+--          Str (P) := 'e';
+
+--          if Exp < 0 then
+--             P := P + 1;
+--             Str (P) := '-';
+--             Exp := -Exp;
+--          end if;
+--          B := False;
+--          for I in 0 .. 4 loop
+--             D := (Exp / 10000) mod 10;
+--             if D /= 0 or B or I = 4 then
+--                P := P + 1;
+--                Str (P) := Character'Val (48 + D);
+--                B := True;
+--             end if;
+--             Exp := (Exp - D * 10000) * 10;
+--          end loop;
+--       end if;
+
+--       Return_String (Res, Str (1 .. P));
+--    end Ghdl_Image_F64;
+
+   procedure Ghdl_Image_F64 (Res : Std_String_Ptr; Val : Ghdl_F64)
+   is
+      --  Sign (1) + digit (1) + dot (1) + digits (15) + exp (1) + sign (1)
+      --  + exp_digits (4) -> 24.
+      Str : String (1 .. 25);
+
+      procedure snprintf (Str : System.Address;
+                          Size : Integer;
+                          Template : System.Address;
+                          Arg : Ghdl_F64);
+      pragma Import (C, snprintf);
+
+      function strlen (Str : System.Address) return Integer;
+      pragma Import (C, strlen);
+
+      Format : constant String := "%g" & Character'Val (0);
+   begin
+      snprintf (Str'Address, Str'Length, Format'Address, Val);
+      Return_String (Res, Str (1 .. strlen (Str'Address)));
+   end Ghdl_Image_F64;
+
+end Grt.Images;
diff --git a/translate/grt/grt-images.ads b/translate/grt/grt-images.ads
new file mode 100644
index 000000000..fb33b6376
--- /dev/null
+++ b/translate/grt/grt-images.ads
@@ -0,0 +1,39 @@
+--  GHDL Run Time (GRT) -  'image subprograms.
+--  Copyright (C) 2002, 2003, 2004, 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;
+with Grt.Rtis; use Grt.Rtis;
+
+package Grt.Images is
+   procedure Ghdl_Image_B2
+     (Res : Std_String_Ptr; Val : Ghdl_B2; Rti : Ghdl_Rti_Access);
+   procedure Ghdl_Image_E8
+     (Res : Std_String_Ptr; Val : Ghdl_E8; Rti : Ghdl_Rti_Access);
+   procedure Ghdl_Image_I32 (Res : Std_String_Ptr; Val : Ghdl_I32);
+   procedure Ghdl_Image_F64 (Res : Std_String_Ptr; Val : Ghdl_F64);
+   procedure Ghdl_Image_P64
+     (Res : Std_String_Ptr; Val : Ghdl_I64; Rti : Ghdl_Rti_Access);
+   procedure Ghdl_Image_P32
+     (Res : Std_String_Ptr; Val : Ghdl_I32; Rti : Ghdl_Rti_Access);
+private
+   pragma Export (C, Ghdl_Image_B2, "__ghdl_image_b2");
+   pragma Export (C, Ghdl_Image_E8, "__ghdl_image_e8");
+   pragma Export (C, Ghdl_Image_I32, "__ghdl_image_i32");
+   pragma Export (C, Ghdl_Image_F64, "__ghdl_image_f64");
+   pragma Export (C, Ghdl_Image_P64, "__ghdl_image_p64");
+   pragma Export (C, Ghdl_Image_P32, "__ghdl_image_p32");
+end Grt.Images;
diff --git a/translate/grt/grt-lib.adb b/translate/grt/grt-lib.adb
new file mode 100644
index 000000000..65abdac5c
--- /dev/null
+++ b/translate/grt/grt-lib.adb
@@ -0,0 +1,210 @@
+--  GHDL Run Time (GRT) -  misc subprograms.
+--  Copyright (C) 2002, 2003, 2004, 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.Errors; use Grt.Errors;
+with Grt.Options;
+
+package body Grt.Lib is
+   --procedure Memcpy (Dst : Address; Src : Address; Size : Size_T);
+   --pragma Import (C, Memcpy);
+
+   procedure Ghdl_Memcpy
+     (Dest : Ghdl_Ptr; Src : Ghdl_Ptr; Size : Ghdl_Index_Type)
+   is
+      procedure Memmove
+        (Dest : Ghdl_Ptr; Src : Ghdl_Ptr; Size : Ghdl_Index_Type);
+      pragma Import (C, Memmove);
+   begin
+      Memmove (Dest, Src, Size);
+   end Ghdl_Memcpy;
+
+   procedure Do_Report (Msg : String;
+                        Str : Std_String_Ptr;
+                        Severity : Integer;
+                        Loc : Ghdl_Location_Ptr)
+   is
+      Level : Integer := Severity mod 256;
+   begin
+      Report_H;
+      Report_C (Loc.Filename);
+      Report_C (":");
+      Report_C (Loc.Line);
+      Report_C (":");
+      Report_C (Loc.Col);
+      Report_C (":@");
+      Report_Now_C;
+      Report_C (":(");
+      Report_C (Msg);
+      Report_C (" ");
+      case Level is
+         when Note_Severity =>
+            Report_C ("note");
+         when Warning_Severity =>
+            Report_C ("warning");
+         when Error_Severity =>
+            Report_C ("error");
+         when Failure_Severity =>
+            Report_C ("failure");
+         when others =>
+            Report_C ("???");
+      end case;
+      Report_C ("): ");
+      Report_E (String (Str.Base (0 .. Str.Bounds.Dim_1.Length - 1)));
+      if Level >= Grt.Options.Severity_Level then
+         Error_C (Msg);
+         Error_E (" failed");
+      end if;
+   end Do_Report;
+
+   procedure Ghdl_Assert_Failed
+     (Str : Std_String_Ptr; Severity : Integer; Loc : Ghdl_Location_Ptr)
+   is
+   begin
+      Do_Report ("assertion", Str, Severity, Loc);
+   end Ghdl_Assert_Failed;
+
+   procedure Ghdl_Report
+     (Str : Std_String_Ptr; Severity : Integer; Loc : Ghdl_Location_Ptr)
+   is
+   begin
+      Do_Report ("report", Str, Severity, Loc);
+   end Ghdl_Report;
+
+   procedure Ghdl_Program_Error is
+   begin
+      Error ("program error");
+   end Ghdl_Program_Error;
+
+   procedure Ghdl_Bound_Check_Failed_L0 (Number : Ghdl_Index_Type) is
+   begin
+      Error_C ("bound check failed (#");
+      Error_C (Integer (Number));
+      Error_E (")");
+   end Ghdl_Bound_Check_Failed_L0;
+
+   procedure Ghdl_Bound_Check_Failed_L1 (Filename : Ghdl_C_String;
+                                         Line: Ghdl_I32)
+   is
+   begin
+      Error_C ("bound check failure at ");
+      Error_C (Filename);
+      Error_C (":");
+      Error_C (Integer (Line));
+      Error_E ("");
+   end Ghdl_Bound_Check_Failed_L1;
+
+   function Ghdl_Integer_Exp (V : Ghdl_I32; E : Ghdl_I32)
+     return Ghdl_I32
+   is
+      pragma Suppress (Overflow_Check);
+
+      R : Ghdl_I32;
+      Res : Ghdl_I32;
+      P : Ghdl_I32;
+      T : Ghdl_I64;
+   begin
+      if E < 0 then
+         Error ("negative exponent");
+      end if;
+      Res := 1;
+      P := V;
+      R := E;
+      loop
+         if R mod 2 = 1 then
+            T := Ghdl_I64 (Res) * Ghdl_I64 (P);
+            Res := Ghdl_I32 (T);
+            if Ghdl_I64 (Res) /= T then
+               Error ("overflow in exponentiation");
+            end if;
+         end if;
+         R := R / 2;
+         exit when R = 0;
+         P := P * P;
+      end loop;
+      return Res;
+   end Ghdl_Integer_Exp;
+
+   function C_Malloc (Size : Ghdl_Index_Type) return Ghdl_Ptr;
+   pragma Import (C, C_Malloc, "malloc");
+
+   function Ghdl_Malloc (Size : Ghdl_Index_Type) return Ghdl_Ptr is
+   begin
+      return C_Malloc (Size);
+   end Ghdl_Malloc;
+
+   function Ghdl_Malloc0 (Size : Ghdl_Index_Type) return Ghdl_Ptr
+   is
+      procedure Memset (Ptr : Ghdl_Ptr; C : Integer; Size : Ghdl_Index_Type);
+      pragma Import (C, Memset);
+
+      Res : Ghdl_Ptr;
+   begin
+      Res := C_Malloc (Size);
+      Memset (Res, 0, Size);
+      return Res;
+   end Ghdl_Malloc0;
+
+   procedure Ghdl_Deallocate (Ptr : Ghdl_Ptr)
+   is
+      procedure C_Free (Ptr : Ghdl_Ptr);
+      pragma Import (C, C_Free, "free");
+   begin
+      C_Free (Ptr);
+   end Ghdl_Deallocate;
+
+   function Ghdl_Real_Exp (X : Ghdl_Real; Exp : Ghdl_I32)
+     return Ghdl_Real
+   is
+      R : Ghdl_I32;
+      Res : Ghdl_Real;
+      P : Ghdl_Real;
+   begin
+      Res := 1.0;
+      P := X;
+      R := Exp;
+      if R >= 0 then
+         loop
+            if R mod 2 = 1 then
+               Res := Res * P;
+            end if;
+            R := R / 2;
+            exit when R = 0;
+            P := P * P;
+         end loop;
+         return Res;
+      else
+         R := -R;
+         loop
+            if R mod 2 = 1 then
+               Res := Res * P;
+            end if;
+            R := R / 2;
+            exit when R = 0;
+            P := P * P;
+         end loop;
+         if Res = 0.0 then
+            Error ("division per 0.0");
+            return 0.0;
+         end if;
+         return 1.0 / Res;
+      end if;
+   end Ghdl_Real_Exp;
+
+end Grt.Lib;
+
+
+
diff --git a/translate/grt/grt-lib.ads b/translate/grt/grt-lib.ads
new file mode 100644
index 000000000..bb1723a0a
--- /dev/null
+++ b/translate/grt/grt-lib.ads
@@ -0,0 +1,93 @@
+--  GHDL Run Time (GRT) -  misc subprograms.
+--  Copyright (C) 2002, 2003, 2004, 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 Grt.Lib is
+   pragma Preelaborate (Grt.Lib);
+
+   procedure Ghdl_Memcpy
+     (Dest : Ghdl_Ptr; Src : Ghdl_Ptr; Size : Ghdl_Index_Type);
+
+   procedure Ghdl_Assert_Failed
+     (Str : Std_String_Ptr; Severity : Integer; Loc : Ghdl_Location_Ptr);
+
+   procedure Ghdl_Report
+     (Str : Std_String_Ptr; Severity : Integer; Loc : Ghdl_Location_Ptr);
+
+   Note_Severity    : constant Integer := 0;
+   Warning_Severity : constant Integer := 1;
+   Error_Severity   : constant Integer := 2;
+   Failure_Severity : constant Integer := 3;
+
+   procedure Ghdl_Bound_Check_Failed_L0 (Number : Ghdl_Index_Type);
+   procedure Ghdl_Bound_Check_Failed_L1 (Filename : Ghdl_C_String;
+                                         Line: Ghdl_I32);
+
+   --  Program error has occured:
+   --  * configuration of an already configured block.
+   procedure Ghdl_Program_Error;
+
+   function Ghdl_Integer_Exp (V : Ghdl_I32; E : Ghdl_I32)
+     return Ghdl_I32;
+
+   function Ghdl_Malloc (Size : Ghdl_Index_Type) return Ghdl_Ptr;
+
+   --  Allocate and clear SIZE bytes.
+   function Ghdl_Malloc0 (Size : Ghdl_Index_Type) return Ghdl_Ptr;
+
+   procedure Ghdl_Deallocate (Ptr : Ghdl_Ptr);
+
+   function Ghdl_Real_Exp (X : Ghdl_Real; Exp : Ghdl_I32)
+     return Ghdl_Real;
+
+   --  Create a vhdl string.
+   Ghdl_Assert_Default_Report_Arr : constant String := "Assertion violation";
+   Ghdl_Assert_Default_Report_Bounds : constant Std_String_Bound :=
+     (Dim_1 => (Left => 1,
+                Right => Ghdl_Assert_Default_Report_Arr'Length,
+                Dir => Dir_To,
+                Length => Ghdl_Assert_Default_Report_Arr'Length));
+   Ghdl_Assert_Default_Report : constant Ghdl_Uc_Array :=
+     (Base => Ghdl_Assert_Default_Report_Arr'Address,
+      Bounds => Ghdl_Assert_Default_Report_Bounds'Address);
+
+   --  Unfortunatly, with gnat 3.15p, we cannot use a deferred constant with
+   --  the export pragma.
+   pragma Export (C, Ghdl_Assert_Default_Report,
+                  "__ghdl_assert_default_report");
+private
+   pragma Export (C, Ghdl_Memcpy, "__ghdl_memcpy");
+
+   pragma Export (C, Ghdl_Assert_Failed, "__ghdl_assert_failed");
+   pragma Export (C, Ghdl_Report, "__ghdl_report");
+
+   pragma Export (C, Ghdl_Bound_Check_Failed_L0,
+                  "__ghdl_bound_check_failed_l0");
+   pragma Export (C, Ghdl_Bound_Check_Failed_L1,
+                  "__ghdl_bound_check_failed_l1");
+   pragma Export (C, Ghdl_Program_Error, "__ghdl_program_error");
+
+   pragma Export (C, Ghdl_Malloc, "__ghdl_malloc");
+   pragma Export (C, Ghdl_Malloc0, "__ghdl_malloc0");
+   pragma Export (C, Ghdl_Deallocate, "__ghdl_deallocate");
+
+   pragma Export (C, Ghdl_Integer_Exp, "__ghdl_integer_exp");
+   pragma Export (C, Ghdl_Real_Exp, "__ghdl_real_exp");
+end Grt.Lib;
+
+
diff --git a/translate/grt/grt-main.adb b/translate/grt/grt-main.adb
new file mode 100644
index 000000000..db57dc81c
--- /dev/null
+++ b/translate/grt/grt-main.adb
@@ -0,0 +1,178 @@
+--  GHDL Run Time (GRT) -  entry point.
+--  Copyright (C) 2002, 2003, 2004, 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;
+with Grt.Errors;
+with Grt.Vcd;
+with Grt.Vpi;
+with Grt.Waves;
+with Grt.Stacks;
+with Grt.Processes;
+with Grt.Signals;
+with Grt.Options; use Grt.Options;
+with Grt.Disp_Rti;
+with Grt.Stats;
+with Grt.Hooks;
+with Grt.Disp_Signals;
+with Grt.Disp;
+
+--  The following packages are not referenced in this package.
+--  They are with'ed in order to be present in the binary.
+pragma Warnings (Off);
+with Grt.Files;
+with Grt.Types;
+with Grt.Lib;
+with Grt.Shadow_Ieee;
+with Grt.Images;
+with Grt.Values;
+with Grt.Names;
+with Grt.Vital_Annotate;
+pragma Warnings (On);
+
+package body Grt.Main is
+   procedure Ghdl_Elaborate;
+   pragma Import (C, Ghdl_Elaborate, "__ghdl_ELABORATE");
+
+   procedure Disp_Stats_Hook (Code : Integer);
+   pragma Convention (C, Disp_Stats_Hook);
+
+   procedure Disp_Stats_Hook (Code : Integer)
+   is
+      pragma Unreferenced (Code);
+   begin
+      Stats.End_Simulation;
+      Stats.Disp_Stats;
+   end Disp_Stats_Hook;
+
+   procedure Check_Flag_String
+   is
+      Err : Boolean;
+   begin
+      Err := False;
+      if (Std_Integer'Size = 32 and Flag_String (3) /= 'i')
+        or else (Std_Integer'Size = 64 and Flag_String (3) /= 'I')
+      then
+         Err := True;
+      end if;
+      if (Std_Time'Size = 32 and Flag_String (4) /= 't')
+        or else (Std_Time'Size = 64 and Flag_String (4) /= 'T')
+      then
+         Err := True;
+      end if;
+      if Err then
+         Grt.Errors.Error
+           ("GRT is not consistent with the flags used for your design");
+      end if;
+   end Check_Flag_String;
+
+   procedure Register_Modules is
+   begin
+      --  List of modules to be registered.
+      Grt.Vcd.Register;
+      Grt.Waves.Register;
+      Grt.Vpi.Register;
+      Grt.Vital_Annotate.Register;
+   end Register_Modules;
+
+   procedure Run
+   is
+      use Grt.Errors;
+      Stop : Boolean;
+      Status : Integer;
+   begin
+      Register_Modules;
+
+      if Flag_String (5) = '?' then
+         Set_Time_Resolution ('n');
+      end if;
+
+      Grt.Options.Decode (Stop);
+
+      Check_Flag_String;
+
+      --  Early stop (for options such as --help).
+      if Stop then
+         return;
+      end if;
+
+      --  Internal initializations.
+      Grt.Stacks.Stack_Init;
+
+      Grt.Hooks.Call_Init_Hooks;
+
+      Grt.Processes.Init;
+
+      Grt.Signals.Init;
+
+      if Flag_Stats then
+         Grt.Errors.Ghdl_Exit_Cb1 := Disp_Stats_Hook'Access;
+         Stats.Start_Elaboration;
+      end if;
+
+      --  Elaboration.
+      Ghdl_Elaborate;
+
+      if Flag_Stats then
+         Stats.Start_Order;
+      end if;
+
+      if Disp_Tree /= Disp_Tree_None then
+         Grt.Disp_Rti.Disp_Hierarchy;
+      end if;
+
+      if not Flag_No_Run then
+         if Grt.Options.Flag_Dump_Rti then
+            Grt.Disp_Rti.Disp_All;
+         end if;
+
+         Grt.Signals.Order_All_Signals;
+
+         if Grt.Options.Disp_Signals_Map then
+            Grt.Disp_Signals.Disp_Signals_Map;
+         end if;
+         if Grt.Options.Disp_Signals_Table then
+            Grt.Disp_Signals.Disp_Signals_Table;
+         end if;
+         if Disp_Signals_Order then
+            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;
+
+      if Flag_Stats then
+         Disp_Stats_Hook (0);
+      end if;
+
+      if Expect_Failure then
+         if Status >= 0 then
+            Expect_Failure := False;
+            Error ("error expected, but none occured");
+         end if;
+      else
+         if Status < 0 then
+            Error ("simulation failed");
+         end if;
+      end if;
+   end Run;
+
+end Grt.Main;
diff --git a/translate/grt/grt-main.ads b/translate/grt/grt-main.ads
new file mode 100644
index 000000000..c62fe0067
--- /dev/null
+++ b/translate/grt/grt-main.ads
@@ -0,0 +1,27 @@
+--  GHDL Run Time (GRT) -  entry point.
+--  Copyright (C) 2002, 2003, 2004, 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.
+
+package Grt.Main is
+   --  Register modules.
+   --  This is automatically called by RUN.
+   --  Do not call this procedure.
+   procedure Register_Modules;
+
+   --  Elaborate and simulate the design.
+   procedure Run;
+end Grt.Main;
diff --git a/translate/grt/grt-names.adb b/translate/grt/grt-names.adb
new file mode 100644
index 000000000..be4fc8665
--- /dev/null
+++ b/translate/grt/grt-names.adb
@@ -0,0 +1,96 @@
+--  GHDL Run Time (GRT) -  'name* subprograms.
+--  Copyright (C) 2002, 2003, 2004, 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.Errors; use Grt.Errors;
+with Ada.Unchecked_Conversion;
+with Grt.Processes; use Grt.Processes;
+with Grt.Rtis_Addr; use Grt.Rtis_Addr;
+with Grt.Rtis_Utils; use Grt.Rtis_Utils;
+with Grt.Vstrings; use Grt.Vstrings;
+
+package body Grt.Names is
+   function To_Str_String_Boundp is new Ada.Unchecked_Conversion
+     (Source => System.Address, Target => Std_String_Boundp);
+
+   function To_Std_String_Basep is new Ada.Unchecked_Conversion
+     (Source => String_Ptr, Target => Std_String_Basep);
+
+   function To_Std_String_Basep is new Ada.Unchecked_Conversion
+     (Source => System.Address, Target => Std_String_Basep);
+
+   procedure Get_Name (Res : Std_String_Ptr;
+                       Ctxt : Rti_Context;
+                       Name : Ghdl_Str_Len_Ptr;
+                       Is_Path : Boolean)
+   is
+      procedure Memcpy (Dst : Address; Src : Address; Len : Integer);
+      pragma Import (C, Memcpy);
+
+      Bounds : Std_String_Boundp;
+      Len : Natural;
+
+      Rstr : Rstring;
+      R_Len : Natural;
+   begin
+      if Ctxt.Block /= null then
+         Prepend (Rstr, ':');
+         Get_Path_Name (Rstr, Ctxt, ':', not Is_Path);
+         R_Len := Length (Rstr);
+         Len := R_Len + Name.Len;
+      else
+         Len := Name.Len;
+      end if;
+
+      Bounds := To_Str_String_Boundp
+        (Ghdl_Stack2_Allocate (Std_String_Bound'Size / System.Storage_Unit));
+      Bounds.Dim_1.Left := 1;
+      Bounds.Dim_1.Right := Ghdl_I32 (Len);
+      Bounds.Dim_1.Dir := Dir_To;
+      Bounds.Dim_1.Length := Ghdl_Index_Type (Len);
+      Res.Bounds := Bounds;
+      if Ctxt.Block /= null then
+         Res.Base := To_Std_String_Basep
+           (Ghdl_Stack2_Allocate (Ghdl_Index_Type (Len)));
+         Memcpy (Res.Base (0)'Address, Get_Address (Rstr), R_Len);
+         Memcpy (Res.Base (Ghdl_Index_Type (R_Len))'Address,
+                 Name.Str (1)'Address,
+                 Name.Len);
+         Free (Rstr);
+      else
+         Res.Base := To_Std_String_Basep (Name.Str);
+      end if;
+   end Get_Name;
+
+   procedure Ghdl_Get_Path_Name (Res : Std_String_Ptr;
+                                 Ctxt : Ghdl_Rti_Access;
+                                 Base : Address;
+                                 Name : Ghdl_Str_Len_Ptr)
+   is
+   begin
+      Get_Name (Res, (Base, Ctxt), Name, True);
+   end Ghdl_Get_Path_Name;
+
+   procedure Ghdl_Get_Instance_Name (Res : Std_String_Ptr;
+                                     Ctxt : Ghdl_Rti_Access;
+                                     Base : Address;
+                                     Name : Ghdl_Str_Len_Ptr)
+   is
+   begin
+      Get_Name (Res, (Base, Ctxt), Name, False);
+   end Ghdl_Get_Instance_Name;
+
+end Grt.Names;
diff --git a/translate/grt/grt-names.ads b/translate/grt/grt-names.ads
new file mode 100644
index 000000000..dd9e7efbf
--- /dev/null
+++ b/translate/grt/grt-names.ads
@@ -0,0 +1,35 @@
+--  GHDL Run Time (GRT) -  'name* subprograms.
+--  Copyright (C) 2002, 2003, 2004, 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; use System;
+with Grt.Types; use Grt.Types;
+with Grt.Rtis; use Grt.Rtis;
+
+package Grt.Names is
+   procedure Ghdl_Get_Path_Name (Res : Std_String_Ptr;
+                                 Ctxt : Ghdl_Rti_Access;
+                                 Base : Address;
+                                 Name : Ghdl_Str_Len_Ptr);
+
+   procedure Ghdl_Get_Instance_Name (Res : Std_String_Ptr;
+                                     Ctxt : Ghdl_Rti_Access;
+                                     Base : Address;
+                                     Name : Ghdl_Str_Len_Ptr);
+private
+   pragma Export (C, Ghdl_Get_Path_Name, "__ghdl_get_path_name");
+   pragma Export (C, Ghdl_Get_Instance_Name, "__ghdl_get_instance_name");
+end Grt.Names;
diff --git a/translate/grt/grt-options.adb b/translate/grt/grt-options.adb
new file mode 100644
index 000000000..9aa6f64e7
--- /dev/null
+++ b/translate/grt/grt-options.adb
@@ -0,0 +1,468 @@
+--  GHDL Run Time (GRT) -  command line options.
+--  Copyright (C) 2002, 2003, 2004, 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 Interfaces; use Interfaces;
+with Grt.Errors; use Grt.Errors;
+with Grt.Astdio;
+with Grt.Hooks;
+
+package body Grt.Options is
+
+   Std_Standard_Time_Fs : Std_Time;
+   Std_Standard_Time_Ps : Std_Time;
+   Std_Standard_Time_Ns : Std_Time;
+   Std_Standard_Time_Us : Std_Time;
+   Std_Standard_Time_Ms : Std_Time;
+   Std_Standard_Time_Sec : Std_Time;
+   Std_Standard_Time_Min : Std_Time;
+   Std_Standard_Time_Hr : Std_Time;
+   pragma Export (C, Std_Standard_Time_Fs, "std__standard__time__BT__fs");
+   pragma Weak_External (Std_Standard_Time_Fs);
+   pragma Export (C, Std_Standard_Time_Ps, "std__standard__time__BT__ps");
+   pragma Weak_External (Std_Standard_Time_Ps);
+   pragma Export (C, Std_Standard_Time_Ns, "std__standard__time__BT__ns");
+   pragma Weak_External (Std_Standard_Time_Ns);
+   pragma Export (C, Std_Standard_Time_Us, "std__standard__time__BT__us");
+   pragma Weak_External (Std_Standard_Time_Us);
+   pragma Export (C, Std_Standard_Time_Ms, "std__standard__time__BT__ms");
+   pragma Weak_External (Std_Standard_Time_Ms);
+   pragma Export (C, Std_Standard_Time_Sec, "std__standard__time__BT__sec");
+   pragma Weak_External (Std_Standard_Time_Sec);
+   pragma Export (C, Std_Standard_Time_Min, "std__standard__time__BT__min");
+   pragma Weak_External (Std_Standard_Time_Min);
+   pragma Export (C, Std_Standard_Time_Hr, "std__standard__time__BT__hr");
+   pragma Weak_External (Std_Standard_Time_Hr);
+
+   procedure Set_Time_Resolution (Res : Character)
+   is
+   begin
+      Std_Standard_Time_Hr := 0;
+      case Res is
+         when 'f' =>
+            Std_Standard_Time_Fs := 1;
+            Std_Standard_Time_Ps := 1000;
+            Std_Standard_Time_Ns := 1000_000;
+            Std_Standard_Time_Us := 1000_000_000;
+            Std_Standard_Time_Ms := Std_Time'Last;
+            Std_Standard_Time_Sec := Std_Time'Last;
+            Std_Standard_Time_Min := Std_Time'Last;
+            Std_Standard_Time_Hr := Std_Time'Last;
+         when 'p' =>
+            Std_Standard_Time_Fs := 0;
+            Std_Standard_Time_Ps := 1;
+            Std_Standard_Time_Ns := 1000;
+            Std_Standard_Time_Us := 1000_000;
+            Std_Standard_Time_Ms := 1000_000_000;
+            Std_Standard_Time_Sec := Std_Time'Last;
+            Std_Standard_Time_Min := Std_Time'Last;
+            Std_Standard_Time_Hr := Std_Time'Last;
+         when 'n' =>
+            Std_Standard_Time_Fs := 0;
+            Std_Standard_Time_Ps := 0;
+            Std_Standard_Time_Ns := 1;
+            Std_Standard_Time_Us := 1000;
+            Std_Standard_Time_Ms := 1000_000;
+            Std_Standard_Time_Sec := 1000_000_000;
+            Std_Standard_Time_Min := Std_Time'Last;
+            Std_Standard_Time_Hr := Std_Time'Last;
+         when 'u' =>
+            Std_Standard_Time_Fs := 0;
+            Std_Standard_Time_Ps := 0;
+            Std_Standard_Time_Ns := 0;
+            Std_Standard_Time_Us := 1;
+            Std_Standard_Time_Ms := 1000;
+            Std_Standard_Time_Sec := 1000_000;
+            Std_Standard_Time_Min := 60_000_000;
+            Std_Standard_Time_Hr := Std_Time'Last;
+         when 'm' =>
+            Std_Standard_Time_Fs := 0;
+            Std_Standard_Time_Ps := 0;
+            Std_Standard_Time_Ns := 0;
+            Std_Standard_Time_Us := 0;
+            Std_Standard_Time_Ms := 1;
+            Std_Standard_Time_Sec := 1000;
+            Std_Standard_Time_Min := 60_000;
+            Std_Standard_Time_Hr := 3600_000;
+         when 's' =>
+            Std_Standard_Time_Fs := 0;
+            Std_Standard_Time_Ps := 0;
+            Std_Standard_Time_Ns := 0;
+            Std_Standard_Time_Us := 0;
+            Std_Standard_Time_Ms := 0;
+            Std_Standard_Time_Sec := 1;
+            Std_Standard_Time_Min := 60;
+            Std_Standard_Time_Hr := 3600;
+         when 'M' =>
+            Std_Standard_Time_Fs := 0;
+            Std_Standard_Time_Ps := 0;
+            Std_Standard_Time_Ns := 0;
+            Std_Standard_Time_Us := 0;
+            Std_Standard_Time_Ms := 0;
+            Std_Standard_Time_Sec := 0;
+            Std_Standard_Time_Min := 1;
+            Std_Standard_Time_Hr := 60;
+         when 'h' =>
+            Std_Standard_Time_Fs := 0;
+            Std_Standard_Time_Ps := 0;
+            Std_Standard_Time_Ns := 0;
+            Std_Standard_Time_Us := 0;
+            Std_Standard_Time_Ms := 0;
+            Std_Standard_Time_Sec := 0;
+            Std_Standard_Time_Min := 0;
+            Std_Standard_Time_Hr := 1;
+         when others =>
+            Error ("bad time resolution");
+      end case;
+   end Set_Time_Resolution;
+
+   procedure Help
+   is
+      use Grt.Astdio;
+      procedure P (Str : String) renames Put_Line;
+      Prog_Name : Ghdl_C_String;
+   begin
+      if Argc > 0 then
+         Prog_Name := Argv (0);
+         Put ("Usage: ");
+         Put (Prog_Name (1 .. strlen (Prog_Name)));
+         Put (" [OPTIONS]");
+         New_Line;
+      end if;
+
+      P ("Options are:");
+      P (" --help, -h        disp this help");
+      P (" --assert-level=LEVEL   stop simulation if assert at LEVEL");
+      P ("       LEVEL is note,warning,error,failure,none");
+      P (" --stop-time=X     stop the simulation at time X");
+      P ("       X is expressed as a time value, without spaces: 1ns, ps...");
+      P (" --stop-delta=X    stop the simulation cycle after X delta");
+      P (" --disp-tree[=KIND] disp the design hierarchy after elaboration");
+      P ("       KIND is inst, proc, port (default)");
+      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");
+      Grt.Hooks.Call_Help_Hooks;
+      P ("trace options:");
+      P (" --disp-time       disp time as simulation advances");
+      P (" --trace-signals   disp signals after each cycle");
+      P (" --trace-processes disp process name before each cycle");
+      P (" --stats           display run-time statistics");
+      P ("debug options:");
+      P (" --disp-order      disp signals order");
+      P (" --disp-sources    disp sources while displaying signals");
+      P (" --disp-sig-types  disp signal types");
+      P (" --disp-signals-map    disp map bw declared sigs and internal sigs");
+      P (" --disp-signals-table  disp internal signals");
+      P (" --dump-rti        dump Run Time Information");
+      P (" --checks          do internal checks after each process run");
+      P (" --activity=LEVEL  watch activity of LEVEL signals");
+      P ("       LEVEL is all, min (default) or none (unsafe)");
+   end Help;
+
+   --  Extract from STR a number.
+   --  First, all leading blanks are skipped.
+   --  Then, all next digits are eaten.
+   --  The position of the first non digit or one past the upper bound is
+   --  returned into POS.
+   --  If there is no digits, OK is set to false, else to true.
+   procedure Extract_Integer
+     (Str : String;
+      Ok : out Boolean;
+      Result : out Integer_64;
+      Pos : out Natural)
+   is
+   begin
+      Pos := Str'First;
+      --  Skip blanks.
+      while Pos <= Str'Last and then Str (Pos) = ' ' loop
+         Pos := Pos + 1;
+      end loop;
+      Ok := False;
+      Result := 0;
+      loop
+         exit when Pos > Str'Last or else Str (Pos) not in '0' .. '9';
+         Ok := True;
+         Result := Result * 10
+           + (Character'Pos (Str (Pos)) - Character'Pos ('0'));
+         Pos := Pos + 1;
+      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.
+         return Natural (Val);
+      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
+         return Character'Val (Character'Pos (C) + 32);
+      else
+         return C;
+      end if;
+   end To_Lower;
+
+   procedure Decode (Stop : out Boolean)
+   is
+      Arg : Ghdl_C_String;
+      Len : Natural;
+   begin
+      Stop := False;
+      Last_Opt := Argc - 1;
+      for I in 1 .. Argc - 1 loop
+         Arg := Argv (I);
+         Len := strlen (Arg);
+         declare
+            Argument : String := Arg (1 .. Len);
+         begin
+            if Argument = "--" then
+               Last_Opt := I;
+               exit;
+            elsif Argument = "--help" or else Argument = "-h" then
+               Help;
+               Stop := True;
+            elsif Len >= 11 and then Argument (1 .. 11) = "--disp-tree" then
+               if Len = 11 then
+                  Disp_Tree := Disp_Tree_Port;
+               elsif Argument (12 .. Len) = "=port" then
+                  Disp_Tree := Disp_Tree_Port;
+               elsif Argument (12 .. Len) = "=proc" then
+                  Disp_Tree := Disp_Tree_Proc;
+               elsif Argument (12 .. Len) = "=inst" then
+                  Disp_Tree := Disp_Tree_Inst;
+               elsif Argument (12 .. Len) = "=none" then
+                  Disp_Tree := Disp_Tree_None;
+               else
+                  Error ("bad argument for --disp-tree option, try --help");
+               end if;
+            elsif Argument = "--disp-time" then
+               Disp_Time := True;
+            elsif Argument = "--trace-signals" then
+               Trace_Signals := True;
+               Disp_Time := True;
+            elsif Argument = "--trace-processes" then
+               Trace_Processes := True;
+               Disp_Time := True;
+            elsif Argument = "--disp-order" then
+               Disp_Signals_Order := True;
+            elsif Argument = "--checks" then
+               Checks := True;
+            elsif Argument = "--disp-sources" then
+               Disp_Sources := True;
+            elsif Argument = "--disp-sig-types" then
+               Disp_Sig_Types := True;
+            elsif Argument = "--disp-signals-map" then
+               Disp_Signals_Map := True;
+            elsif Argument = "--disp-signals-table" then
+               Disp_Signals_Table := True;
+            elsif Argument = "--dump-rti" then
+               Flag_Dump_Rti := True;
+            elsif Argument = "--stats" then
+               Flag_Stats := True;
+            elsif Argument = "--no-run" then
+               Flag_No_Run := True;
+            elsif Len > 18 and then Argument (1 .. 18) = "--time-resolution="
+            then
+               declare
+                  Res : Character;
+                  Unit : String (1 .. 3);
+               begin
+                  Res := '?';
+                  if Len >= 20 then
+                     Unit (1) := To_Lower (Argument (19));
+                     Unit (2) := To_Lower (Argument (20));
+                     if Len = 20 then
+                        if Unit (1 .. 2) = "fs" then
+                           Res := 'f';
+                        elsif Unit (1 .. 2) = "ps" then
+                           Res := 'p';
+                        elsif Unit (1 .. 2) = "ns" then
+                           Res := 'n';
+                        elsif Unit (1 .. 2) = "us" then
+                           Res := 'u';
+                        elsif Unit (1 .. 2) = "ms" then
+                           Res := 'm';
+                        elsif Unit (1 .. 2) = "hr" then
+                           Res := 'h';
+                        end if;
+                     elsif Len = 21 then
+                        Unit (3) := To_Lower (Argument (21));
+                        if Unit = "min" then
+                           Res := 'M';
+                        elsif Unit = "sec" then
+                           Res := 's';
+                        end if;
+                     end if;
+                  end if;
+                  if Res = '?' then
+                     Error_C ("bad unit for '");
+                     Error_C (Argument);
+                     Error_E ("'");
+                  else
+                     if Flag_String (5) = '-' then
+                        Error ("time resolution is ignored");
+                     elsif Flag_String (5) = '?' then
+                        if Stop_Time /= Std_Time'Last then
+                           Error ("time resolution must be set "
+                                  & "before --stop-time");
+                        else
+                           Set_Time_Resolution (Res);
+                        end if;
+                     elsif Flag_String (5) /= Res then
+                        Error ("time resolution is fixed during analysis");
+                     end if;
+                  end if;
+               end;
+            elsif Len > 12 and then Argument (1 .. 12) = "--stop-time=" then
+               declare
+                  Ok : Boolean;
+                  Pos : Natural;
+                  Time : Integer_64;
+                  Unit : String (1 .. 3);
+               begin
+                  Extract_Integer (Argument (13 .. Len), Ok, Time, Pos);
+                  if not Ok then
+                     Time := 1;
+                  end if;
+                  if (Len - Pos + 1) not in 2 .. 3 then
+                     Error_C ("bad unit for '");
+                     Error_C (Argument);
+                     Error_E ("'");
+                     return;
+                  end if;
+                  Unit (1) := To_Lower (Argument (Pos));
+                  Unit (2) := To_Lower (Argument (Pos + 1));
+                  if Len = Pos + 2 then
+                     Unit (3) := To_Lower (Argument (Pos + 2));
+                  else
+                     Unit (3) := ' ';
+                  end if;
+                  if Unit = "fs " then
+                     null;
+                  elsif Unit = "ps " then
+                     Time := Time * (10 ** 3);
+                  elsif Unit = "ns " then
+                     Time := Time * (10 ** 6);
+                  elsif Unit = "us " then
+                     Time := Time * (10 ** 9);
+                  elsif Unit = "ms " then
+                     Time := Time * (10 ** 12);
+                  elsif Unit = "sec" then
+                     Time := Time * (10 ** 15);
+                  elsif Unit = "min" then
+                     Time := Time * (10 ** 15) * 60;
+                  elsif Unit = "hr " then
+                     Time := Time * (10 ** 15) * 3600;
+                  else
+                     Error_C ("bad unit name for '");
+                     Error_C (Argument);
+                     Error_E ("'");
+                  end if;
+                  Stop_Time := Std_Time (Time);
+               end;
+            elsif Len > 13 and then Argument (1 .. 13) = "--stop-delta=" then
+               declare
+                  Ok : Boolean;
+                  Pos : Natural;
+                  Time : Integer_64;
+               begin
+                  Extract_Integer (Argument (14 .. Len), Ok, Time, Pos);
+                  if not Ok or else Pos <= Len then
+                     Error_C ("bad value in '");
+                     Error_C (Argument);
+                     Error_E ("'");
+                  else
+                     if Time > Integer_64 (Integer'Last) then
+                        Stop_Delta := Integer'Last;
+                     else
+                        Stop_Delta := Integer (Time);
+                     end if;
+                  end if;
+               end;
+            elsif Len > 15 and then Argument (1 .. 15) = "--assert-level=" then
+               if Argument (16 .. Len) = "note" then
+                  Severity_Level := Note_Severity;
+               elsif Argument (16 .. Len) = "warning" then
+                  Severity_Level := Warning_Severity;
+               elsif Argument (16 .. Len) = "error" then
+                  Severity_Level := Error_Severity;
+               elsif Argument (16 .. Len) = "failure" then
+                  Severity_Level := Failure_Severity;
+               elsif Argument (16 .. Len) = "none" then
+                  Severity_Level := 4;
+               else
+                  Error ("bad argument for --assert-level option, try --help");
+               end if;
+            elsif Argument = "--expect-failure" then
+               Expect_Failure := True;
+            elsif Len >= 13 and then Argument (1 .. 13) = "--stack-size=" then
+               Stack_Size := Extract_Size
+                 (Argument (14 .. Len), "--stack-size");
+               if Stack_Size > Stack_Max_Size then
+                  Stack_Max_Size := Stack_Size;
+               end if;
+            elsif Len >= 17 and then Argument (1 .. 17) = "--stack-max-size="
+            then
+               Stack_Max_Size := Extract_Size
+                 (Argument (18 .. Len), "--stack-size");
+               if Stack_Size > Stack_Max_Size then
+                  Stack_Size := Stack_Max_Size;
+               end if;
+            elsif Len >= 11 and then Argument (1 .. 11) = "--activity="
+            then
+               if Argument (12 .. Len) = "none" then
+                  Flag_Activity := Activity_None;
+               elsif Argument (12 .. Len) = "min" then
+                  Flag_Activity := Activity_Minimal;
+               elsif Argument (12 .. Len) = "all" then
+                  Flag_Activity := Activity_All;
+               else
+                  Error ("bad argument for --activity, try --help");
+               end if;
+            elsif not Grt.Hooks.Call_Option_Hooks (Argument) then
+               Error_C ("unknown option '");
+               Error_C (Argument);
+               Error_E ("', try --help");
+            end if;
+         end;
+      end loop;
+   end Decode;
+end Grt.Options;
diff --git a/translate/grt/grt-options.ads b/translate/grt/grt-options.ads
new file mode 100644
index 000000000..3257e9f22
--- /dev/null
+++ b/translate/grt/grt-options.ads
@@ -0,0 +1,127 @@
+--  GHDL Run Time (GRT) -  command line options.
+--  Copyright (C) 2002, 2003, 2004, 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;
+with Grt.Lib; use Grt.Lib;
+
+package Grt.Options is
+   pragma Preelaborate (Grt.Options);
+
+   --  Name of the program, set by argv[0].
+   --  Must be set before calling DECODE.
+   Progname : Ghdl_C_String;
+
+   --  Arguments.
+   --  This mimics argc/argv of 'main'.
+   --  These must be set before calling DECODE.
+   Argc : Integer;
+
+   type Argv_Array_Type is array (Natural) of Ghdl_C_String;
+   type Argv_Type is access Argv_Array_Type;
+
+   Argv : Argv_Type;
+
+   --  Last option decoded.
+   --  Following arguments are reserved for the program.
+   Last_Opt : Integer;
+
+   --  Consistent flags used for analysis.
+   --  Format is "VVitr", where:
+   --    'VV' is the version (87 or 93).
+   --    'i' is the integer size ('i' for 32 bits, 'I' for 64 bits).
+   --    't' is the time size ('t' for 32 bits, 'T' for 64 bits).
+   --    'r' is the resolution ('?' for to be set by the user, '-' for any).
+   Flag_String : constant String (1 .. 5);
+   pragma Import (C, Flag_String, "__ghdl_flag_string");
+
+   --  Display options help.
+   --  Should not be called directly.
+   procedure Help;
+
+   --  Decode command line options.
+   --  If STOP is true, there nothing must happen (set by --help).
+   procedure Decode (Stop : out Boolean);
+
+   --  Set by --disp-tree, to display the design hierarchy.
+   type Disp_Tree_Kind is
+     (
+      Disp_Tree_None,  --  Do not disp tree.
+      Disp_Tree_Inst,  --  Disp entities, arch, package, blocks, components.
+      Disp_Tree_Proc,  --  As above plus processes
+      Disp_Tree_Port   --  As above plus ports and signals.
+     );
+   Disp_Tree : Disp_Tree_Kind := Disp_Tree_None;
+
+   --  Set by --disp-time (and --trace-signals, --trace-processes) to display
+   --  time and deltas.
+   Disp_Time : Boolean := False;
+
+   --  Set by --trace-signals, to display signals after each cycle.
+   Trace_Signals : Boolean := False;
+
+   --  Set by --trace-processes, to display process name before being run.
+   Trace_Processes : Boolean := False;
+
+   --  Set by --disp-sig-types, to display signals and they types.
+   Disp_Sig_Types : Boolean := False;
+
+   Disp_Sources : Boolean := False;
+   Disp_Signals_Map : Boolean := False;
+   Disp_Signals_Table : Boolean := False;
+
+   --  Set by --disp-order to diplay evaluation order of signals.
+   Disp_Signals_Order : Boolean := False;
+
+   --  Set by --stats to display statistics.
+   Flag_Stats : Boolean := False;
+
+   --  Set by --checks to do internal checks.
+   Checks : Boolean := False;
+
+   --  Level at which an assert stop the simulation.
+   Severity_Level : Integer := Failure_Severity;
+
+   --  Set by --stop-time=XXX to stop the simulation at or just after XXX.
+   --  (unit is fs in fact).
+   Stop_Time : Std_Time := Std_Time'Last;
+
+   --  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;
+
+   --  If set, dump rtis.
+   Flag_Dump_Rti : Boolean := False;
+
+   --  Set by --no-run
+   --  If set, do not simulate, only elaborate.
+   Flag_No_Run : Boolean := False;
+
+   type Activity_Mode is (Activity_All, Activity_Minimal, Activity_None);
+   Flag_Activity : Activity_Mode := Activity_Minimal;
+
+   --  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);
+end Grt.Options;
diff --git a/translate/grt/grt-processes.adb b/translate/grt/grt-processes.adb
new file mode 100644
index 000000000..a4e269bf9
--- /dev/null
+++ b/translate/grt/grt-processes.adb
@@ -0,0 +1,795 @@
+--  GHDL Run Time (GRT) -  processes.
+--  Copyright (C) 2002, 2003, 2004, 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 GNAT.Table;
+with Ada.Unchecked_Conversion;
+with Ada.Unchecked_Deallocation;
+with Grt.Stack2; use Grt.Stack2;
+with Grt.Disp;
+with Grt.Astdio;
+with Grt.Signals; use Grt.Signals;
+with Grt.Errors; use Grt.Errors;
+with Grt.Stacks; use Grt.Stacks;
+with Grt.Options;
+with Grt.Rtis_Addr; use Grt.Rtis_Addr;
+with Grt.Rtis_Utils;
+with Grt.Hooks;
+with Grt.Disp_Signals;
+with Grt.Stdio;
+with Grt.Stats;
+
+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;
+
+   package Process_Table is new GNAT.Table
+     (Table_Component_Type => Process_Type,
+      Table_Index_Type => Process_Id,
+      Table_Low_Bound => 1,
+      Table_Initial => 1,
+      Table_Increment => 100);
+
+   procedure Free is new Ada.Unchecked_Deallocation
+     (Name => Sensitivity_Acc, Object => Sensitivity_El);
+
+   procedure Init is
+   begin
+      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);
+   end Get_Nbr_Processes;
+
+   procedure Process_Register (This : System.Address;
+                               Proc : System.Address;
+                               Ctxt : Rti_Context;
+                               State : Process_State;
+                               Postponed : Boolean)
+   is
+      function To_Proc_Acc is new Ada.Unchecked_Conversion
+        (Source => System.Address, Target => Proc_Acc);
+      Stack : Stack_Type;
+   begin
+      if State /= State_Sensitized then
+         Stack := Stack_Create (Proc, This);
+      else
+         Stack := Null_Stack;
+      end if;
+      Process_Table.Increment_Last;
+      Process_Table.Table (Process_Table.Last) :=
+        (Subprg => To_Proc_Acc (Proc),
+         This => This,
+         Rti => Ctxt,
+         Sensitivity => null,
+         Resumed => True,
+         Postponed => Postponed,
+         State => State,
+         Timeout => Bad_Time,
+         Stack => Stack);
+      --  Used to create drivers.
+      Cur_Proc_Id := Process_Table.Last;
+   end Process_Register;
+
+   procedure Ghdl_Process_Register
+     (Instance : System.Address;
+      Proc : System.Address;
+      Ctxt : Ghdl_Rti_Access;
+      Addr : System.Address)
+   is
+   begin
+      Process_Register (Instance, Proc, (Addr, Ctxt), State_Timeout, False);
+   end Ghdl_Process_Register;
+
+   procedure Ghdl_Sensitized_Process_Register
+     (Instance : System.Address;
+      Proc : System.Address;
+      Ctxt : Ghdl_Rti_Access;
+      Addr : System.Address)
+   is
+   begin
+      Process_Register (Instance, Proc, (Addr, Ctxt), State_Sensitized, False);
+   end Ghdl_Sensitized_Process_Register;
+
+   procedure Ghdl_Postponed_Process_Register
+     (Instance : System.Address;
+      Proc : System.Address;
+      Ctxt : Ghdl_Rti_Access;
+      Addr : System.Address)
+   is
+   begin
+      Process_Register (Instance, Proc, (Addr, Ctxt), State_Timeout, True);
+   end Ghdl_Postponed_Process_Register;
+
+   procedure Ghdl_Postponed_Sensitized_Process_Register
+     (Instance : System.Address;
+      Proc : System.Address;
+      Ctxt : Ghdl_Rti_Access;
+      Addr : System.Address)
+   is
+   begin
+      Process_Register (Instance, Proc, (Addr, Ctxt), State_Sensitized, True);
+   end Ghdl_Postponed_Sensitized_Process_Register;
+
+   procedure Verilog_Process_Register (This : System.Address;
+                                       Proc : System.Address;
+                                       Ctxt : Rti_Context)
+   is
+      function To_Proc_Acc is new Ada.Unchecked_Conversion
+        (Source => System.Address, Target => Proc_Acc);
+   begin
+      Process_Table.Increment_Last;
+      Process_Table.Table (Process_Table.Last) :=
+        (Rti => Ctxt,
+         Sensitivity => null,
+         Resumed => True,
+         Postponed => False,
+         State => State_Sensitized,
+         Timeout => Bad_Time,
+         Subprg => To_Proc_Acc (Proc),
+         This => This,
+         Stack => Null_Stack);
+      --  Used to create drivers.
+      Cur_Proc_Id := Process_Table.Last;
+   end Verilog_Process_Register;
+
+   procedure Ghdl_Initial_Register (Instance : System.Address;
+                                    Proc : System.Address)
+   is
+   begin
+      Verilog_Process_Register (Instance, Proc, Null_Context);
+   end Ghdl_Initial_Register;
+
+   procedure Ghdl_Always_Register (Instance : System.Address;
+                                   Proc : System.Address)
+   is
+   begin
+      Verilog_Process_Register (Instance, Proc, Null_Context);
+   end Ghdl_Always_Register;
+
+   procedure Ghdl_Process_Add_Sensitivity (Sig : Ghdl_Signal_Ptr)
+   is
+   begin
+      Resume_Process_If_Event (Sig, Process_Table.Last);
+   end Ghdl_Process_Add_Sensitivity;
+
+   procedure Resume_Process (Proc : Process_Id) is
+   begin
+      Process_Table.Table (Proc).Resumed := True;
+   end Resume_Process;
+
+   function Ghdl_Stack2_Allocate (Size : Ghdl_Index_Type)
+     return System.Address
+   is
+   begin
+      return Grt.Stack2.Allocate (Stack2, Size);
+   end Ghdl_Stack2_Allocate;
+
+   function Ghdl_Stack2_Mark return Mark_Id is
+   begin
+      if Stack2 = Null_Stack2_Ptr then
+         Stack2 := Grt.Stack2.Create;
+      end if;
+      return Grt.Stack2.Mark (Stack2);
+   end Ghdl_Stack2_Mark;
+
+   procedure Ghdl_Stack2_Release (Mark : Mark_Id) is
+   begin
+      Grt.Stack2.Release (Stack2, Mark);
+   end Ghdl_Stack2_Release;
+
+   function To_Acc is new Ada.Unchecked_Conversion
+     (Source => System.Address, Target => Process_Acc);
+
+   procedure Ghdl_Process_Wait_Add_Sensitivity (Sig : Ghdl_Signal_Ptr)
+   is
+      El : Sensitivity_Acc;
+   begin
+      El := new Sensitivity_El'(Sig => Sig,
+                                Next => Cur_Proc.Sensitivity);
+      Cur_Proc.Sensitivity := El;
+   end Ghdl_Process_Wait_Add_Sensitivity;
+
+   procedure Ghdl_Process_Wait_Set_Timeout (Time : Std_Time)
+   is
+   begin
+      if Time < 0 then
+         --  LRM93 8.1
+         Error ("negative timeout clause");
+      end if;
+      Cur_Proc.Timeout := Current_Time + Time;
+   end Ghdl_Process_Wait_Set_Timeout;
+
+   function Ghdl_Process_Wait_Suspend return Boolean
+   is
+   begin
+      if Cur_Proc.State = State_Sensitized then
+         Error ("wait statement in a sensitized process");
+      end if;
+      --  Suspend this process.
+      Cur_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;
+   end Ghdl_Process_Wait_Suspend;
+
+   procedure Ghdl_Process_Wait_Close
+   is
+      El : Sensitivity_Acc;
+      N_El : Sensitivity_Acc;
+   begin
+      El := Cur_Proc.Sensitivity;
+      Cur_Proc.Sensitivity := null;
+      while El /= null loop
+         N_El := El.Next;
+         Free (El);
+         El := N_El;
+      end loop;
+   end Ghdl_Process_Wait_Close;
+
+   procedure Ghdl_Process_Wait_Exit
+   is
+   begin
+      if Cur_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;
+      --  Suspend this process.
+      Stack_Switch (Main_Stack, Cur_Proc.Stack);
+   end Ghdl_Process_Wait_Exit;
+
+   procedure Ghdl_Process_Wait_Timeout (Time : Std_Time)
+   is
+   begin
+      if Cur_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;
+      --  Suspend this process.
+      Stack_Switch (Main_Stack, Cur_Proc.Stack);
+   end Ghdl_Process_Wait_Timeout;
+
+   --  Verilog.
+   procedure Ghdl_Process_Delay (Del : Ghdl_U32)
+   is
+   begin
+      Cur_Proc.Timeout := Current_Time + Std_Time (Del);
+      Cur_Proc.State := State_Delayed;
+   end Ghdl_Process_Delay;
+
+   --  Protected object lock.
+   --  Note: there is no real locks, since the kernel is single threading.
+   --  Multi lock is allowed, and rules are just checked.
+   type Object_Lock is record
+      --  The owner of the lock.
+      --  Nul_Process_Id means the lock is free.
+      Process : Process_Id;
+      --  Number of times the lock has been acquired.
+      Count : Natural;
+   end record;
+
+   type Object_Lock_Acc is access Object_Lock;
+   type Object_Lock_Acc_Acc is access Object_Lock_Acc;
+
+   function To_Lock_Acc_Acc is new Ada.Unchecked_Conversion
+     (Source => System.Address, Target => Object_Lock_Acc_Acc);
+
+   procedure Ghdl_Protected_Enter (Obj : System.Address)
+   is
+      Lock : Object_Lock_Acc := To_Lock_Acc_Acc (Obj).all;
+   begin
+      if Lock.Process = Nul_Process_Id then
+         if Lock.Count /= 0 then
+            Internal_Error ("protected_enter");
+         end if;
+         Lock.Process := Get_Current_Process_Id;
+         Lock.Count := 1;
+      else
+         if Lock.Process /= Get_Current_Process_Id then
+            Internal_Error ("protected_enter(2)");
+         end if;
+         Lock.Count := Lock.Count + 1;
+      end if;
+   end Ghdl_Protected_Enter;
+
+   procedure Ghdl_Protected_Leave (Obj : System.Address)
+   is
+      Lock : Object_Lock_Acc := To_Lock_Acc_Acc (Obj).all;
+   begin
+      if Lock.Process /= Get_Current_Process_Id then
+         Internal_Error ("protected_leave(1)");
+      end if;
+
+      if Lock.Count <= 0 then
+         Internal_Error ("protected_leave(2)");
+      end if;
+      Lock.Count := Lock.Count - 1;
+      if Lock.Count = 0 then
+         Lock.Process := Nul_Process_Id;
+      end if;
+   end Ghdl_Protected_Leave;
+
+   procedure Ghdl_Protected_Init (Obj : System.Address)
+   is
+      Lock : Object_Lock_Acc_Acc := To_Lock_Acc_Acc (Obj);
+   begin
+      Lock.all := new Object_Lock'(Process => Nul_Process_Id,
+                                   Count => 0);
+   end Ghdl_Protected_Init;
+
+   procedure Ghdl_Protected_Fini (Obj : System.Address)
+   is
+      procedure Deallocate is new Ada.Unchecked_Deallocation
+        (Object => Object_Lock, Name => Object_Lock_Acc);
+
+      Lock : Object_Lock_Acc_Acc := To_Lock_Acc_Acc (Obj);
+   begin
+      if Lock.all.Count /= 0 or Lock.all.Process /= Nul_Process_Id then
+         Internal_Error ("protected_fini");
+      end if;
+      Deallocate (Lock.all);
+   end Ghdl_Protected_Fini;
+
+   function Compute_Next_Time return Std_Time
+   is
+      Res : Std_Time;
+   begin
+      --  f) The time of the next simulation cycle, Tn, is determined by
+      --     setting it to the earliest of
+      --     1) TIME'HIGH
+      Res := Std_Time'Last;
+
+      --     2) The next time at which a driver becomes active, or
+      Res := Std_Time'Min (Res, Grt.Signals.Find_Next_Time);
+
+      if Res = Current_Time then
+         return Res;
+      end if;
+
+      --     3) The next time at which a process resumes.
+      for I in Process_Table.First .. Process_Table.Last loop
+         declare
+            Proc : Process_Type renames Process_Table.Table (I);
+         begin
+            if Proc.State = State_Wait
+              and then Proc.Timeout < Res
+              and then Proc.Timeout >= 0
+            then
+               --  No signals to be updated.
+               Grt.Signals.Flush_Active_List;
+
+               if Proc.Timeout = Current_Time then
+                  --  Can't be better.
+                  return Current_Time;
+               else
+                  Res := Proc.Timeout;
+               end if;
+            end if;
+         end;
+      end loop;
+
+      return Res;
+   end Compute_Next_Time;
+
+   procedure Disp_Process_Name (Stream : Grt.Stdio.FILEs; Proc : Process_Id)
+   is
+   begin
+      Grt.Rtis_Utils.Put (Stream, Process_Table.Table (Proc).Rti);
+   end Disp_Process_Name;
+
+   type Run_Handler is access function return Integer;
+   --  pragma Convention (C, Run_Handler);
+
+   function Run_Through_Longjump (Hand : Run_Handler) return Integer;
+   pragma Import (C, Run_Through_Longjump, "__ghdl_run_through_longjump");
+
+   --  Run resumed processes.
+   --  If POSTPONED is true, resume postponed processes, else resume
+   --  non-posponed processes.
+   --  Returns one of these values:
+   --  No process has been run.
+   Run_None : constant Integer := 1;
+   --  At least one process was run.
+   Run_Resumed : constant Integer := 2;
+   --  Simulation is finished.
+   Run_Finished : constant Integer := 3;
+   --  Failure, simulation should stop.
+   Run_Failure : constant Integer := -1;
+
+   function Run_Processes (Postponed : Boolean) return Integer
+   is
+      Status : Integer;
+   begin
+      Status := Run_None;
+
+      if Options.Flag_Stats then
+         Stats.Start_Processes;
+      end if;
+
+      for I in Process_Table.First .. Process_Table.Last loop
+         if Process_Table.Table (I).Postponed = Postponed
+           and Process_Table.Table (I).Resumed
+         then
+            if Grt.Options.Trace_Processes then
+               Grt.Astdio.Put ("run process ");
+               Disp_Process_Name (Stdio.stdout, I);
+               Grt.Astdio.Put (" [");
+               Grt.Astdio.Put (Stdio.stdout, Process_Table.Table (I).This);
+               Grt.Astdio.Put ("]");
+               Grt.Astdio.New_Line;
+            end if;
+            Process_Table.Table (I).Resumed := False;
+            Status := Run_Resumed;
+            Cur_Proc_Id := I;
+            Cur_Proc := To_Acc (Process_Table.Table (I)'Address);
+            if Cur_Proc.State = State_Sensitized then
+               Cur_Proc.Subprg.all (Cur_Proc.This);
+            else
+               Stack_Switch (Cur_Proc.Stack, Main_Stack);
+            end if;
+            if Grt.Options.Checks then
+               Ghdl_Signal_Internal_Checks;
+               Grt.Stack2.Check_Empty (Stack2);
+            end if;
+         end if;
+      end loop;
+
+      if Options.Flag_Stats then
+         Stats.End_Processes;
+      end if;
+      return Status;
+   end Run_Processes;
+
+   function Initialization_Phase return Integer
+   is
+      Status : Integer;
+   begin
+      --  LRM93 12.6.4
+      --  At the beginning of initialization, the current time, Tc, is assumed
+      --  to be 0 ns.
+      Current_Time := 0;
+
+      --  The initialization phase consists of the following steps:
+      --  - The driving value and the effective value of each explicitly
+      --    declared signal are computed, and the current value of the signal
+      --    is set to the effective value.  This value is assumed to have been
+      --    the value of the signal for an infinite length of time prior to
+      --    the start of the simulation.
+      Init_Signals;
+
+      --  - The value of each implicit signal of the form S'Stable(T) or
+      --    S'Quiet(T) is set to true.  The value of each implicit signal of
+      --    the form S'Delayed is set to the initial value of its prefix, S.
+      --  GHDL: already done when the signals are created.
+      null;
+
+      --  - The value of each implicit GUARD signal is set to the result of
+      --    evaluating the corresponding guard expression.
+      null;
+
+      --  - 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
+      --    of step f of the simulation cycle, below.
+      Current_Time := Compute_Next_Time;
+
+      return Run_Resumed;
+   end Initialization_Phase;
+
+   --  Launch a simulation cycle.
+   --  Set FINISHED to true if this is the last cycle.
+   function Simulation_Cycle return Integer
+   is
+      Tn : Std_Time;
+      Status : Integer;
+   begin
+      --  LRM93 12.6.4
+      --  A simulation cycle consists of the following steps:
+      --
+      --  a) The current time, Tc is set equal to Tn.  Simulation is complete
+      --     when Tn = TIME'HIGH and there are no active drivers or process
+      --     resumptions at Tn.
+      --  GHDL: this is done at the last step of the cycle.
+      null;
+
+      --  b) Each active explicit signal in the model is updated.  (Events
+      --     may occur on signals as a result).
+      --  c) Each implicit signal in the model is updated.  (Events may occur
+      --     on signals as a result.)
+      if Options.Flag_Stats then
+         Stats.Start_Update;
+      end if;
+      Update_Signals;
+      if Options.Flag_Stats then
+         Stats.End_Update;
+      end if;
+
+      --  d) For each process P, if P is currently sensitive to a signal S and
+      --     if an event has occured on S in this simulation cycle, then P
+      --     resumes.
+      for I in Process_Table.First .. Process_Table.Last loop
+         declare
+            Proc : Process_Type renames Process_Table.Table (I);
+            El : Sensitivity_Acc;
+         begin
+            case Proc.State is
+               when State_Sensitized =>
+                  null;
+               when State_Delayed =>
+                  if Proc.Timeout = Current_Time then
+                     Proc.Timeout := Bad_Time;
+                     Proc.Resumed := True;
+                     Proc.State := State_Sensitized;
+                  end if;
+               when State_Wait =>
+                  if Proc.Timeout = Current_Time then
+                     Proc.Timeout := Bad_Time;
+                     Proc.Resumed := True;
+                     Proc.State := State_Timeout;
+                  else
+                     El := Proc.Sensitivity;
+                     while El /= null loop
+                        if El.Sig.Event then
+                           Proc.Resumed := True;
+                           exit;
+                        else
+                           El := El.Next;
+                        end if;
+                     end loop;
+                  end if;
+               when State_Timeout =>
+                  Internal_Error ("process in timeout");
+               when State_Dead =>
+                  null;
+            end case;
+         end;
+      end loop;
+
+      --  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
+      --     1) TIME'HIGH
+      --     2) The next time at which a driver becomes active, or
+      --     3) The next time at which a process resumes.
+      --     If Tn = Tc, then the next simulation cycle (if any) will be a
+      --     delta cycle.
+      if Options.Flag_Stats then
+         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.
+      --     Otherwise, each postponed process that has resumed but has not
+      --     been executed since its last resumption is executed until it
+      --     suspends.  Then Tn is recalculated according to the rules of
+      --     step f.  It is an error if the execution of any postponed
+      --     process causes a delta cycle to occur immediatly after the
+      --     current simulation cycle.
+      if Tn = Current_Time then
+         if Current_Time = Last_Time and then Status = Run_None then
+            return Run_Finished;
+         else
+            Current_Delta := Current_Delta + 1;
+            return Run_Resumed;
+         end if;
+      else
+         Current_Delta := 0;
+         Status := Run_Processes (Postponed => True);
+         if Status = Run_Resumed then
+            Flush_Active_List;
+            if Options.Flag_Stats then
+               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;
+         elsif Status = Run_Failure then
+            return Run_Failure;
+         end if;
+         Current_Time := Tn;
+         return Run_Resumed;
+      end if;
+   end Simulation_Cycle;
+
+   function Simulation return Integer
+   is
+      use Options;
+      Status : Integer;
+   begin
+      --Put_Line ("grt.processes:" & Process_Id'Image (Process_Table.Last)
+      --          & " process(es)");
+
+--       if Disp_Sig_Types then
+--          Grt.Disp.Disp_Signals_Type;
+--       end if;
+
+      Grt.Hooks.Call_Start_Hooks;
+
+      Status := Run_Through_Longjump (Initialization_Phase'Access);
+      if Status /= Run_Resumed then
+         return -1;
+      end if;
+
+      Current_Delta := 0;
+      Nbr_Delta_Cycles := 0;
+      Nbr_Cycles := 0;
+      if Trace_Signals then
+         Grt.Disp_Signals.Disp_All_Signals;
+      end if;
+
+      if Current_Time /= 0 then
+         --  This is the end of a cycle.
+         Cycle_Time := 0;
+         Grt.Hooks.Call_Cycle_Hooks;
+      end if;
+
+      loop
+         Cycle_Time := Current_Time;
+         if Disp_Time then
+            Grt.Disp.Disp_Now;
+         end if;
+         Status := Run_Through_Longjump (Simulation_Cycle'Access);
+         exit when Status = Run_Failure;
+         if Trace_Signals then
+            Grt.Disp_Signals.Disp_All_Signals;
+         end if;
+
+         --  Statistics.
+         if Current_Delta = 0 then
+            Nbr_Cycles := Nbr_Cycles + 1;
+         else
+            Nbr_Delta_Cycles := Nbr_Delta_Cycles + 1;
+         end if;
+
+         exit when Status = Run_Finished;
+         if Current_Delta = 0 then
+            Grt.Hooks.Call_Cycle_Hooks;
+         end if;
+
+         if Current_Delta >= Stop_Delta then
+            Error ("simulation stopped by --stop-delta");
+            exit;
+         end if;
+         if Current_Time > Stop_Time then
+            Info ("simulation stopped by --stop-time");
+            exit;
+         end if;
+      end loop;
+
+      Grt.Hooks.Call_Finish_Hooks;
+
+      if Status = Run_Failure then
+         return -1;
+      else
+         return 0;
+      end if;
+   end Simulation;
+
+end Grt.Processes;
diff --git a/translate/grt/grt-processes.ads b/translate/grt/grt-processes.ads
new file mode 100644
index 000000000..e9faa3732
--- /dev/null
+++ b/translate/grt/grt-processes.ads
@@ -0,0 +1,156 @@
+--  GHDL Run Time (GRT) -  processes.
+--  Copyright (C) 2002, 2003, 2004, 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;
+with Grt.Stack2; use Grt.Stack2;
+with Grt.Types; use Grt.Types;
+with Grt.Signals; use Grt.Signals;
+with Grt.Rtis; use Grt.Rtis;
+with Grt.Stdio;
+
+package Grt.Processes is
+   pragma Suppress (All_Checks);
+
+   --  Internal initialisations.
+   procedure Init;
+
+   --  Do the VHDL simulation.
+   --  Return 0 in case of success (end of time reached).
+   function Simulation return Integer;
+
+   --  Number of delta cycles.
+   Nbr_Delta_Cycles : Integer;
+   --  Number of non-delta cycles.
+   Nbr_Cycles : Integer;
+
+   --  If true, the simulation should be stopped.
+   Break_Simulation : Boolean;
+
+   --  Return the identifier of the current process.
+   --  During the elaboration, this is the identifier of the last process
+   --  being elaborated.  So, this function can be used to create signal
+   --  drivers.
+   function Get_Current_Process_Id return Process_Id;
+   pragma Inline (Get_Current_Process_Id);
+
+   --  Return the number of processes.
+   --  Used for statistics.
+   function Get_Nbr_Processes return Natural;
+
+   --  Disp the name of process PROC.
+   procedure Disp_Process_Name (Stream : Grt.Stdio.FILEs; Proc : Process_Id);
+
+   --  Register a process during elaboration.
+   --  This procedure is called by vhdl elaboration code.
+   procedure Ghdl_Process_Register (Instance : System.Address;
+                                    Proc : System.Address;
+                                    Ctxt : Ghdl_Rti_Access;
+                                    Addr : System.Address);
+   procedure Ghdl_Sensitized_Process_Register (Instance : System.Address;
+                                               Proc : System.Address;
+                                               Ctxt : Ghdl_Rti_Access;
+                                               Addr : System.Address);
+   procedure Ghdl_Postponed_Process_Register (Instance : System.Address;
+                                              Proc : System.Address;
+                                              Ctxt : Ghdl_Rti_Access;
+                                              Addr : System.Address);
+   procedure Ghdl_Postponed_Sensitized_Process_Register
+     (Instance : System.Address;
+      Proc : System.Address;
+      Ctxt : Ghdl_Rti_Access;
+      Addr : System.Address);
+
+   procedure Ghdl_Initial_Register (Instance : System.Address;
+                                    Proc : System.Address);
+   procedure Ghdl_Always_Register (Instance : System.Address;
+                                   Proc : System.Address);
+
+   --  Add a simple signal in the sensitivity of the last registered
+   --  (sensitized) process.
+   procedure Ghdl_Process_Add_Sensitivity (Sig : Ghdl_Signal_Ptr);
+
+   --  Resume a process.
+   procedure Resume_Process (Proc : Process_Id);
+
+   --  Wait without timeout or sensitivity.
+   procedure Ghdl_Process_Wait_Exit;
+   --  Wait for a timeout.
+   procedure Ghdl_Process_Wait_Timeout (Time : Std_Time);
+   --  Add a sensitivity for a wait.
+   procedure Ghdl_Process_Wait_Add_Sensitivity (Sig : Ghdl_Signal_Ptr);
+   --  Add a timeout for a wait.
+   procedure Ghdl_Process_Wait_Set_Timeout (Time : Std_Time);
+   --  Wait until timeout or sensitivity.
+   --  Return TRUE in case of timeout.
+   function Ghdl_Process_Wait_Suspend return Boolean;
+   --  Finish a wait statement.
+   procedure Ghdl_Process_Wait_Close;
+
+   --  Verilog.
+   procedure Ghdl_Process_Delay (Del : Ghdl_U32);
+
+   function Ghdl_Stack2_Allocate (Size : Ghdl_Index_Type)
+     return System.Address;
+   function Ghdl_Stack2_Mark return Mark_Id;
+   procedure Ghdl_Stack2_Release (Mark : Mark_Id);
+
+   --  Protected variables.
+   procedure Ghdl_Protected_Enter (Obj : System.Address);
+   procedure Ghdl_Protected_Leave (Obj : System.Address);
+   procedure Ghdl_Protected_Init (Obj : System.Address);
+   procedure Ghdl_Protected_Fini (Obj : System.Address);
+
+private
+   pragma Export (C, Ghdl_Process_Register,
+                  "__ghdl_process_register");
+   pragma Export (C, Ghdl_Sensitized_Process_Register,
+                  "__ghdl_sensitized_process_register");
+   pragma Export (C, Ghdl_Postponed_Process_Register,
+                  "__ghdl_postponed_process_register");
+   pragma Export (C, Ghdl_Postponed_Sensitized_Process_Register,
+                  "__ghdl_postponed_sensitized_process_register");
+
+   pragma Export (C, Ghdl_Always_Register, "__ghdl_always_register");
+   pragma Export (C, Ghdl_Initial_Register, "__ghdl_initial_register");
+
+   pragma Export (C, Ghdl_Process_Add_Sensitivity,
+                  "__ghdl_process_add_sensitivity");
+
+   pragma Export (C, Ghdl_Process_Wait_Exit,
+                  "__ghdl_process_wait_exit");
+   pragma Export (C, Ghdl_Process_Wait_Timeout,
+                  "__ghdl_process_wait_timeout");
+   pragma Export (C, Ghdl_Process_Wait_Add_Sensitivity,
+                  "__ghdl_process_wait_add_sensitivity");
+   pragma Export (C, Ghdl_Process_Wait_Set_Timeout,
+                  "__ghdl_process_wait_set_timeout");
+   pragma Export (C, Ghdl_Process_Wait_Suspend,
+                  "__ghdl_process_wait_suspend");
+   pragma Export (C, Ghdl_Process_Wait_Close,
+                  "__ghdl_process_wait_close");
+
+   pragma Export (C, Ghdl_Process_Delay, "__ghdl_process_delay");
+
+   pragma Export (C, Ghdl_Stack2_Allocate, "__ghdl_stack2_allocate");
+   pragma Export (C, Ghdl_Stack2_Mark, "__ghdl_stack2_mark");
+   pragma Export (C, Ghdl_Stack2_Release, "__ghdl_stack2_release");
+
+   pragma Export (C, Ghdl_Protected_Enter, "__ghdl_protected_enter");
+   pragma Export (C, Ghdl_Protected_Leave, "__ghdl_protected_leave");
+   pragma Export (C, Ghdl_Protected_Init, "__ghdl_protected_init");
+   pragma Export (C, Ghdl_Protected_Fini, "__ghdl_protected_fini");
+end Grt.Processes;
diff --git a/translate/grt/grt-rtis.ads b/translate/grt/grt-rtis.ads
new file mode 100644
index 000000000..f6d5b580f
--- /dev/null
+++ b/translate/grt/grt-rtis.ads
@@ -0,0 +1,347 @@
+--  GHDL Run Time (GRT) -  Run Time Informations.
+--  Copyright (C) 2002, 2003, 2004, 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; use System;
+with Grt.Types; use Grt.Types;
+with Ada.Unchecked_Conversion;
+
+package Grt.Rtis is
+   pragma Preelaborate (Grt.Rtis);
+
+   type Ghdl_Rtik is
+     (Ghdl_Rtik_Top,
+      Ghdl_Rtik_Library,
+      Ghdl_Rtik_Package,
+      Ghdl_Rtik_Package_Body,
+      Ghdl_Rtik_Entity,
+      Ghdl_Rtik_Architecture,
+      Ghdl_Rtik_Process,
+      Ghdl_Rtik_Block,
+      Ghdl_Rtik_If_Generate,
+      Ghdl_Rtik_For_Generate,
+      Ghdl_Rtik_Instance, --10
+      Ghdl_Rtik_Constant,
+      Ghdl_Rtik_Iterator,
+      Ghdl_Rtik_Variable,
+      Ghdl_Rtik_Signal,
+      Ghdl_Rtik_File, -- 15
+      Ghdl_Rtik_Port,
+      Ghdl_Rtik_Generic,
+      Ghdl_Rtik_Alias,
+      Ghdl_Rtik_Guard,
+      Ghdl_Rtik_Component, -- 20
+      Ghdl_Rtik_Attribute,
+      Ghdl_Rtik_Type_B2,        --  Enum
+      Ghdl_Rtik_Type_E8,
+      Ghdl_Rtik_Type_E32,
+      Ghdl_Rtik_Type_I32,       --  25 Scalar
+      Ghdl_Rtik_Type_I64,
+      Ghdl_Rtik_Type_F64,
+      Ghdl_Rtik_Type_P32,
+      Ghdl_Rtik_Type_P64,
+      Ghdl_Rtik_Type_Access,
+      Ghdl_Rtik_Type_Array,
+      Ghdl_Rtik_Type_Record,
+      Ghdl_Rtik_Type_File,
+      Ghdl_Rtik_Subtype_Scalar,
+      Ghdl_Rtik_Subtype_Array,
+      Ghdl_Rtik_Subtype_Array_Ptr,
+      Ghdl_Rtik_Subtype_Unconstrained_Array,
+      Ghdl_Rtik_Subtype_Record,
+      Ghdl_Rtik_Subtype_Access,
+      Ghdl_Rtik_Type_Protected,
+      Ghdl_Rtik_Element,
+      Ghdl_Rtik_Unit,
+      Ghdl_Rtik_Attribute_Transaction,
+      Ghdl_Rtik_Attribute_Quiet,
+      Ghdl_Rtik_Attribute_Stable,
+      Ghdl_Rtik_Error);
+   for Ghdl_Rtik'Size use 8;
+
+   type Ghdl_Rti_Depth is range 0 .. 255;
+   for Ghdl_Rti_Depth'Size use 8;
+
+   type Ghdl_Rti_U8 is mod 2 ** 8;
+   for Ghdl_Rti_U8'Size use 8;
+
+   type Ghdl_Rti_Common is record
+      Kind : Ghdl_Rtik;
+      Depth : Ghdl_Rti_Depth;
+      Mode : Ghdl_Rti_U8;
+      Max_Depth : Ghdl_Rti_Depth;
+   end record;
+
+   type Ghdl_Rti_Access is access all Ghdl_Rti_Common;
+
+   --  Fat array of rti accesses.
+   type Ghdl_Rti_Array is array (Ghdl_Index_Type) of Ghdl_Rti_Access;
+   type Ghdl_Rti_Arr_Acc is access Ghdl_Rti_Array;
+
+   type Ghdl_Rti_Loc (Rel : Boolean := False) is record
+      case Rel is
+         when True =>
+            Off : Ghdl_Index_Type;
+         when False =>
+            Addr : Address;
+      end case;
+   end record;
+   pragma Unchecked_Union (Ghdl_Rti_Loc);
+
+   type Ghdl_C_String_Array is array (Ghdl_Index_Type) of Ghdl_C_String;
+   type Ghdl_C_String_Array_Ptr is access Ghdl_C_String_Array;
+
+   type Ghdl_Rtin_Block is record
+      Common : Ghdl_Rti_Common;
+      Name : Ghdl_C_String;
+      Loc : Ghdl_Rti_Loc;
+      Parent : Ghdl_Rti_Access;
+      Size : Ghdl_Index_Type;
+      Nbr_Child : Ghdl_Index_Type;
+      Children : Ghdl_Rti_Arr_Acc;
+   end record;
+   type Ghdl_Rtin_Block_Acc is access Ghdl_Rtin_Block;
+   function To_Ghdl_Rtin_Block_Acc is new Ada.Unchecked_Conversion
+     (Source => Ghdl_Rti_Access, Target => Ghdl_Rtin_Block_Acc);
+   function To_Ghdl_Rti_Access is new Ada.Unchecked_Conversion
+     (Source => Ghdl_Rtin_Block_Acc, Target => Ghdl_Rti_Access);
+
+   type Ghdl_Rtin_Object is record
+      Common : Ghdl_Rti_Common;
+      Name : Ghdl_C_String;
+      Loc : Ghdl_Rti_Loc;
+      Obj_Type : Ghdl_Rti_Access;
+   end record;
+   type Ghdl_Rtin_Object_Acc is access Ghdl_Rtin_Object;
+   function To_Ghdl_Rtin_Object_Acc is new Ada.Unchecked_Conversion
+     (Source => Ghdl_Rti_Access, Target => Ghdl_Rtin_Object_Acc);
+   function To_Ghdl_Rti_Access is new Ada.Unchecked_Conversion
+     (Source => Ghdl_Rtin_Object_Acc, Target => Ghdl_Rti_Access);
+
+   type Ghdl_Rtin_Instance is record
+      Common : Ghdl_Rti_Common;
+      Name : Ghdl_C_String;
+      Loc : Ghdl_Rti_Loc;
+      Parent : Ghdl_Rti_Access;
+      Instance : Ghdl_Rti_Access;
+   end record;
+   type Ghdl_Rtin_Instance_Acc is access Ghdl_Rtin_Instance;
+   function To_Ghdl_Rtin_Instance_Acc is new Ada.Unchecked_Conversion
+     (Source => Ghdl_Rti_Access, Target => Ghdl_Rtin_Instance_Acc);
+
+   --  Must be kept in sync with grt.types.mode_signal_type.
+   Ghdl_Rti_Signal_Mode_Mask    : constant Ghdl_Rti_U8 := 15;
+   Ghdl_Rti_Signal_Mode_None    : constant Ghdl_Rti_U8 := 0;
+   Ghdl_Rti_Signal_Mode_Linkage : constant Ghdl_Rti_U8 := 1;
+   Ghdl_Rti_Signal_Mode_Buffer  : constant Ghdl_Rti_U8 := 2;
+   Ghdl_Rti_Signal_Mode_Out     : constant Ghdl_Rti_U8 := 3;
+   Ghdl_Rti_Signal_Mode_Inout   : constant Ghdl_Rti_U8 := 4;
+   Ghdl_Rti_Signal_Mode_In      : constant Ghdl_Rti_U8 := 5;
+
+   Ghdl_Rti_Signal_Kind_Mask     : constant Ghdl_Rti_U8 := 48;
+   Ghdl_Rti_Signal_Kind_No       : constant Ghdl_Rti_U8 := 0;
+   Ghdl_Rti_Signal_Kind_Register : constant Ghdl_Rti_U8 := 16;
+   Ghdl_Rti_Signal_Kind_Bus      : constant Ghdl_Rti_U8 := 32;
+
+   Ghdl_Rti_Signal_Has_Active    : constant Ghdl_Rti_U8 := 64;
+
+   type Ghdl_Rtin_Component is record
+      Common : Ghdl_Rti_Common;
+      Name : Ghdl_C_String;
+      Nbr_Child : Ghdl_Index_Type;
+      Children : Ghdl_Rti_Arr_Acc;
+   end record;
+   type Ghdl_Rtin_Component_Acc is access Ghdl_Rtin_Component;
+   function To_Ghdl_Rtin_Component_Acc is new Ada.Unchecked_Conversion
+     (Source => Ghdl_Rti_Access, Target => Ghdl_Rtin_Component_Acc);
+
+   type Ghdl_Rtin_Type_Enum is record
+      Common : Ghdl_Rti_Common;
+      Name : Ghdl_C_String;
+      Nbr : Ghdl_Index_Type;
+      Names : Ghdl_C_String_Array_Ptr;
+   end record;
+   type Ghdl_Rtin_Type_Enum_Acc is access Ghdl_Rtin_Type_Enum;
+   function To_Ghdl_Rtin_Type_Enum_Acc is new Ada.Unchecked_Conversion
+     (Source => Ghdl_Rti_Access, Target => Ghdl_Rtin_Type_Enum_Acc);
+
+   type Ghdl_Rtin_Type_Scalar is record
+      Common : Ghdl_Rti_Common;
+      Name : Ghdl_C_String;
+   end record;
+   type Ghdl_Rtin_Type_Scalar_Acc is access Ghdl_Rtin_Type_Scalar;
+   function To_Ghdl_Rtin_Type_Scalar_Acc is new Ada.Unchecked_Conversion
+     (Source => Ghdl_Rti_Access, Target => Ghdl_Rtin_Type_Scalar_Acc);
+
+   type Ghdl_Rtin_Subtype_Scalar is record
+      Common : Ghdl_Rti_Common;
+      Name : Ghdl_C_String;
+      Basetype : Ghdl_Rti_Access;
+      Range_Loc : Ghdl_Rti_Loc;
+   end record;
+   type Ghdl_Rtin_Subtype_Scalar_Acc is access Ghdl_Rtin_Subtype_Scalar;
+   function To_Ghdl_Rtin_Subtype_Scalar_Acc is new Ada.Unchecked_Conversion
+     (Source => Ghdl_Rti_Access, Target => Ghdl_Rtin_Subtype_Scalar_Acc);
+   function To_Ghdl_Rti_Access is new Ada.Unchecked_Conversion
+     (Source => Ghdl_Rtin_Subtype_Scalar_Acc, Target => Ghdl_Rti_Access);
+
+   --  True if the type is complex.
+   Ghdl_Rti_Type_Complex_Mask : constant Ghdl_Rti_U8 := 1;
+   Ghdl_Rti_Type_Complex      : constant Ghdl_Rti_U8 := 1;
+
+   type Ghdl_Rtin_Type_Array is record
+      Common : Ghdl_Rti_Common;
+      Name : Ghdl_C_String;
+      Element : Ghdl_Rti_Access;
+      Nbr_Dim : Ghdl_Index_Type;
+      Indexes : Ghdl_Rti_Arr_Acc;
+   end record;
+   type Ghdl_Rtin_Type_Array_Acc is access Ghdl_Rtin_Type_Array;
+   function To_Ghdl_Rtin_Type_Array_Acc is new Ada.Unchecked_Conversion
+     (Source => Ghdl_Rti_Access, Target => Ghdl_Rtin_Type_Array_Acc);
+   function To_Ghdl_Rti_Access is new Ada.Unchecked_Conversion
+     (Source => Ghdl_Rtin_Type_Array_Acc, Target => Ghdl_Rti_Access);
+
+   type Ghdl_Rtin_Subtype_Array is record
+      Common : Ghdl_Rti_Common;
+      Name : Ghdl_C_String;
+      Basetype : Ghdl_Rtin_Type_Array_Acc;
+      Bounds : Ghdl_Rti_Loc;
+      Valsize : Ghdl_Rti_Loc;
+      Sigsize : Ghdl_Rti_Loc;
+   end record;
+   type Ghdl_Rtin_Subtype_Array_Acc is access Ghdl_Rtin_Subtype_Array;
+   function To_Ghdl_Rtin_Subtype_Array_Acc is new Ada.Unchecked_Conversion
+     (Source => Ghdl_Rti_Access, Target => Ghdl_Rtin_Subtype_Array_Acc);
+   function To_Ghdl_Rti_Access is new Ada.Unchecked_Conversion
+     (Source => Ghdl_Rtin_Subtype_Array_Acc, Target => Ghdl_Rti_Access);
+
+   type Ghdl_Rtin_Type_Fileacc is record
+      Common : Ghdl_Rti_Common;
+      Name : Ghdl_C_String;
+      Base : Ghdl_Rti_Access;
+   end record;
+   type Ghdl_Rtin_Type_Fileacc_Acc is access Ghdl_Rtin_Type_Fileacc;
+   function To_Ghdl_Rtin_Type_Fileacc_Acc is new Ada.Unchecked_Conversion
+     (Source => Ghdl_Rti_Access, Target => Ghdl_Rtin_Type_Fileacc_Acc);
+
+   type Ghdl_Rtin_Element is record
+      Common : Ghdl_Rti_Common;
+      Name : Ghdl_C_String;
+      Eltype : Ghdl_Rti_Access;
+      Val_Off : Ghdl_Index_Type;
+      Sig_Off : Ghdl_Index_Type;
+   end record;
+   type Ghdl_Rtin_Element_Acc is access Ghdl_Rtin_Element;
+   function To_Ghdl_Rtin_Element_Acc is new Ada.Unchecked_Conversion
+     (Source => Ghdl_Rti_Access, Target => Ghdl_Rtin_Element_Acc);
+
+   type Ghdl_Rtin_Type_Record is record
+      Common : Ghdl_Rti_Common;
+      Name : Ghdl_C_String;
+      Nbrel : Ghdl_Index_Type;
+      Elements : Ghdl_Rti_Arr_Acc;
+   end record;
+   type Ghdl_Rtin_Type_Record_Acc is access Ghdl_Rtin_Type_Record;
+   function To_Ghdl_Rtin_Type_Record_Acc is new Ada.Unchecked_Conversion
+     (Source => Ghdl_Rti_Access, Target => Ghdl_Rtin_Type_Record_Acc);
+
+   --  MODE is never used.  Refer to mode field of physical type.
+   type Ghdl_Rti_Unit_Mode is (Unit_Mode_32, Unit_Mode_64, Unit_Mode_Addr);
+   type Ghdl_Rti_Unit_Val (Mode : Ghdl_Rti_Unit_Mode := Unit_Mode_64) is record
+      case Mode is
+         when Unit_Mode_32 =>
+            Unit_32 : Ghdl_I32;
+         when Unit_Mode_64 =>
+            Unit_64 : Ghdl_I64;
+         when Unit_Mode_Addr =>
+            Unit_Addr : Ghdl_Value_Ptr;
+      end case;
+   end record;
+   pragma Unchecked_Union (Ghdl_Rti_Unit_Val);
+
+   type Ghdl_Rtin_Unit is record
+      Common : Ghdl_Rti_Common;
+      Name : Ghdl_C_String;
+      Value : Ghdl_Rti_Unit_Val;
+   end record;
+   type Ghdl_Rtin_Unit_Acc is access Ghdl_Rtin_Unit;
+   function To_Ghdl_Rtin_Unit_Acc is new Ada.Unchecked_Conversion
+     (Source => Ghdl_Rti_Access, Target => Ghdl_Rtin_Unit_Acc);
+
+   --  Mode field is set to 1 if units value is per address.  Otherwise,
+   --  mode is 0.
+   type Ghdl_Rtin_Type_Physical is record
+      Common : Ghdl_Rti_Common;
+      Name : Ghdl_C_String;
+      Nbr : Ghdl_Index_Type;
+      Units : Ghdl_Rti_Arr_Acc;
+   end record;
+   type Ghdl_Rtin_Type_Physical_Acc is access Ghdl_Rtin_Type_Physical;
+   function To_Ghdl_Rtin_Type_Physical_Acc is new Ada.Unchecked_Conversion
+     (Source => Ghdl_Rti_Access, Target => Ghdl_Rtin_Type_Physical_Acc);
+
+   --  Instance linkage.
+
+   --  At the beginning of a component structure (or the object for a direct
+   --  instantiation), there is a Ghdl_Component_Link_Type record.
+   --  These record contains a pointer to the instance (down link),
+   --  and RTIS to the statement and its parent (up link).
+   type Ghdl_Component_Link_Type;
+   type Ghdl_Component_Link_Acc is access Ghdl_Component_Link_Type;
+
+   --  At the beginning of an entity structure, there is a Ghdl_Link_Type,
+   --  which contains the RTI for the architecture (down-link) and a pointer
+   --  to the instantiation object (up-link).
+   type Ghdl_Entity_Link_Type is record
+      Rti : Ghdl_Rti_Access;
+      Parent : Ghdl_Component_Link_Acc;
+   end record;
+
+   type Ghdl_Entity_Link_Acc is access Ghdl_Entity_Link_Type;
+
+   function To_Ghdl_Entity_Link_Acc is new Ada.Unchecked_Conversion
+     (Source => Address, Target => Ghdl_Entity_Link_Acc);
+
+   type Ghdl_Component_Link_Type is record
+      Instance : Ghdl_Entity_Link_Acc;
+      Stmt : Ghdl_Rti_Access;
+   end record;
+
+   function To_Ghdl_Component_Link_Acc is new Ada.Unchecked_Conversion
+     (Source => Address, Target => Ghdl_Component_Link_Acc);
+
+   --  TOP rti.
+   Ghdl_Rti_Top_Ptr : Ghdl_Rtin_Block_Acc;
+
+   --  Address of the top instance.
+   Ghdl_Rti_Top_Instance : Ghdl_Rti_Access;
+
+   --  Instances have a pointer to their RTI at offset 0.
+   type Ghdl_Rti_Acc_Acc is access Ghdl_Rti_Access;
+   function To_Ghdl_Rti_Acc_Acc is new Ada.Unchecked_Conversion
+     (Source => Address, Target => Ghdl_Rti_Acc_Acc);
+
+   function To_Address is new Ada.Unchecked_Conversion
+     (Source => Ghdl_Rti_Access, Target => Address);
+
+   function To_Ghdl_Rti_Access is new Ada.Unchecked_Conversion
+     (Source => Address, Target => Ghdl_Rti_Access);
+
+private
+   pragma Export (C, Ghdl_Rti_Top_Ptr, "__ghdl_rti_top_ptr");
+   pragma Export (C, Ghdl_Rti_Top_Instance, "__ghdl_rti_top_instance");
+end Grt.Rtis;
diff --git a/translate/grt/grt-rtis_addr.adb b/translate/grt/grt-rtis_addr.adb
new file mode 100644
index 000000000..4f24fe776
--- /dev/null
+++ b/translate/grt/grt-rtis_addr.adb
@@ -0,0 +1,268 @@
+--  GHDL Run Time (GRT) -  RTI address handling.
+--  Copyright (C) 2002, 2003, 2004, 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 Ada.Unchecked_Conversion;
+with Grt.Errors; use Grt.Errors;
+
+package body Grt.Rtis_Addr is
+   function "+" (L : Address; R : Ghdl_Index_Type) return Address
+   is
+   begin
+      return To_Address (To_Integer (L) + Integer_Address (R));
+   end "+";
+
+   function "-" (L : Address; R : Ghdl_Index_Type) return Address
+   is
+   begin
+      return To_Address (To_Integer (L) - Integer_Address (R));
+   end "-";
+
+   function Align (L : Address; R : Ghdl_Index_Type) return Address
+   is
+      Nad : Integer_Address;
+   begin
+      Nad := To_Integer (L + (R - 1));
+      return To_Address (Nad - (Nad mod Integer_Address (R)));
+   end Align;
+
+   function Get_Parent_Context (Ctxt : Rti_Context) return Rti_Context
+   is
+      Blk : Ghdl_Rtin_Block_Acc;
+   begin
+      Blk := To_Ghdl_Rtin_Block_Acc (Ctxt.Block);
+      case Ctxt.Block.Kind is
+         when Ghdl_Rtik_Process
+           | Ghdl_Rtik_Block =>
+            return (Base => Ctxt.Base - Blk.Loc.Off,
+                    Block => Blk.Parent);
+         when Ghdl_Rtik_Architecture =>
+            if Blk.Loc.Off /= 0 then
+               Internal_Error ("get_parent_context(3)");
+            end if;
+            return (Base => Ctxt.Base + Blk.Loc.Off,
+                    Block => Blk.Parent);
+         when Ghdl_Rtik_For_Generate
+           | Ghdl_Rtik_If_Generate =>
+            declare
+               Nbase : Address;
+               Parent : Ghdl_Rti_Access;
+               Blk1 : Ghdl_Rtin_Block_Acc;
+            begin
+               --  Read the pointer to the parent.
+               --  This is the first field.
+               Nbase := To_Addr_Acc (Ctxt.Base).all;
+               --  Since the parent may be a grant-parent, adjust
+               --  the base.
+               Parent := Blk.Parent;
+               loop
+                  case Parent.Kind is
+                     when Ghdl_Rtik_Architecture
+                       | Ghdl_Rtik_For_Generate
+                       | Ghdl_Rtik_If_Generate =>
+                        exit;
+                     when Ghdl_Rtik_Block =>
+                        Blk1 := To_Ghdl_Rtin_Block_Acc (Parent);
+                        Nbase := Nbase + Blk1.Loc.Off;
+                        Parent := Blk1.Parent;
+                     when others =>
+                        Internal_Error ("get_parent_context(2)");
+                  end case;
+               end loop;
+               return (Base => Nbase,
+                       Block => Blk.Parent);
+            end;
+         when others =>
+            Internal_Error ("get_parent_context(1)");
+      end case;
+   end Get_Parent_Context;
+
+   procedure Get_Instance_Link (Link : Ghdl_Entity_Link_Acc;
+                                Ctxt : out Rti_Context;
+                                Stmt : out Ghdl_Rti_Access)
+   is
+      Obj : Ghdl_Rtin_Instance_Acc;
+   begin
+      if Link.Parent = null then
+         --  Top entity.
+         Stmt := null;
+         Ctxt := (Base => Null_Address, Block => null);
+      else
+         Stmt := Link.Parent.Stmt;
+         Obj := To_Ghdl_Rtin_Instance_Acc (Stmt);
+         Ctxt := (Base => Link.Parent.all'Address - Obj.Loc.Off,
+                  Block => Obj.Parent);
+      end if;
+   end Get_Instance_Link;
+
+   function Loc_To_Addr (Depth : Ghdl_Rti_Depth;
+                         Loc : Ghdl_Rti_Loc;
+                         Ctxt : Rti_Context)
+                        return Address
+   is
+      Cur_Ctxt : Rti_Context;
+      Nctxt : Rti_Context;
+   begin
+      if Depth = 0 then
+         return Loc.Addr;
+      elsif Ctxt.Block.Depth = Depth then
+         --Addr := Base + Storage_Offset (Obj.Loc.Off);
+         return Ctxt.Base + Loc.Off;
+      else
+         if Ctxt.Block.Depth < Depth then
+            Internal_Error ("loc_to_addr");
+         end if;
+         Cur_Ctxt := Ctxt;
+         loop
+            Nctxt := Get_Parent_Context (Cur_Ctxt);
+            if Nctxt.Block.Depth = Depth then
+               return Nctxt.Base + Loc.Off;
+            end if;
+            Cur_Ctxt := Nctxt;
+         end loop;
+      end if;
+   end Loc_To_Addr;
+
+   function Range_To_Length (Rng : Ghdl_Range_Ptr; Base_Type : Ghdl_Rti_Access)
+                            return Ghdl_Index_Type
+   is
+   begin
+      case Base_Type.Kind is
+         when Ghdl_Rtik_Type_B2 =>
+            return Rng.B2.Len;
+         when Ghdl_Rtik_Type_E8 =>
+            return Rng.E8.Len;
+         when Ghdl_Rtik_Type_E32 =>
+            return Rng.E32.Len;
+         when Ghdl_Rtik_Type_I32 =>
+            return Rng.I32.Len;
+         when others =>
+            Internal_Error ("range_to_length");
+      end case;
+   end Range_To_Length;
+
+   function Get_For_Generate_Length (Blk : Ghdl_Rtin_Block_Acc;
+                                     Ctxt : Rti_Context)
+                                    return Ghdl_Index_Type
+   is
+      Iter_Type : Ghdl_Rtin_Subtype_Scalar_Acc;
+      Rng : Ghdl_Range_Ptr;
+   begin
+      Iter_Type := To_Ghdl_Rtin_Subtype_Scalar_Acc
+        (To_Ghdl_Rtin_Object_Acc (Blk.Children (0)).Obj_Type);
+      if Iter_Type.Common.Kind /= Ghdl_Rtik_Subtype_Scalar then
+         Internal_Error ("get_for_generate_length(1)");
+      end if;
+      Rng := To_Ghdl_Range_Ptr
+        (Loc_To_Addr (Iter_Type.Common.Depth, Iter_Type.Range_Loc, Ctxt));
+      return Range_To_Length (Rng, Iter_Type.Basetype);
+   end Get_For_Generate_Length;
+
+   procedure Get_Instance_Context (Inst : Ghdl_Rtin_Instance_Acc;
+                                   Ctxt : Rti_Context;
+                                   Sub_Ctxt : out Rti_Context)
+   is
+      Inst_Addr : Address;
+      Inst_Base : Address;
+   begin
+      --  Address of the field containing the address of the instance.
+      Inst_Addr := Ctxt.Base + Inst.Loc.Off;
+      --  Read sub instance address.
+      Inst_Base := To_Addr_Acc (Inst_Addr).all;
+      --  Read instance RTI.
+      if Inst_Base = Null_Address then
+         Sub_Ctxt := (Base => Null_Address, Block => null);
+      else
+         Sub_Ctxt := (Base => Inst_Base,
+                      Block => To_Ghdl_Rti_Acc_Acc (Inst_Base).all);
+      end if;
+   end Get_Instance_Context;
+
+   procedure Bound_To_Range (Bounds_Addr : Address;
+                             Def : Ghdl_Rtin_Type_Array_Acc;
+                             Res : out Ghdl_Range_Array)
+   is
+      Bounds : Address;
+
+      procedure Align (A : Ghdl_Index_Type) is
+      begin
+         Bounds := Align (Bounds, A);
+      end Align;
+
+      procedure Update (S : Ghdl_Index_Type) is
+      begin
+         Bounds := Bounds + (S / Storage_Unit);
+      end Update;
+
+      Idx_Def : Ghdl_Rti_Access;
+   begin
+      if Res'Length /= Def.Nbr_Dim or else Res'First /= 0 then
+         Internal_Error ("disp_rti.bound_to_range");
+      end if;
+
+      Bounds := Bounds_Addr;
+
+      for I in 0 .. Def.Nbr_Dim - 1 loop
+         Idx_Def := Def.Indexes (I);
+
+         if Bounds = Null_Address then
+            Res (I) := null;
+         else
+            Idx_Def := Get_Base_Type (Idx_Def);
+            case Idx_Def.Kind is
+               when Ghdl_Rtik_Type_I32 =>
+                  Align (Ghdl_Range_I32'Alignment);
+                  Res (I) := To_Ghdl_Range_Ptr (Bounds);
+                  Update (Ghdl_Range_I32'Size);
+               when Ghdl_Rtik_Type_E8 =>
+                  Align (Ghdl_Range_E8'Alignment);
+                  Res (I) := To_Ghdl_Range_Ptr (Bounds);
+                  Update (Ghdl_Range_E8'Size);
+               when others =>
+                  --  Bounds are not known anymore.
+                  Bounds := Null_Address;
+            end case;
+         end if;
+      end loop;
+   end Bound_To_Range;
+
+   function Get_Base_Type (Atype : Ghdl_Rti_Access) return Ghdl_Rti_Access
+   is
+   begin
+      case Atype.Kind is
+         when Ghdl_Rtik_Subtype_Scalar =>
+            return To_Ghdl_Rtin_Subtype_Scalar_Acc (Atype).Basetype;
+         when Ghdl_Rtik_Subtype_Array =>
+            return To_Ghdl_Rti_Access
+              (To_Ghdl_Rtin_Subtype_Array_Acc (Atype).Basetype);
+         when Ghdl_Rtik_Type_E8
+           | Ghdl_Rtik_Type_B2 =>
+            return Atype;
+         when others =>
+            Internal_Error ("rtis_addr.get_base_type");
+      end case;
+   end Get_Base_Type;
+
+   function Get_Top_Context return Rti_Context
+   is
+      Ctxt : Rti_Context;
+   begin
+      Ctxt := (Base => To_Address (Ghdl_Rti_Top_Instance),
+               Block => Ghdl_Rti_Top_Ptr.Parent);
+      return Ctxt;
+   end Get_Top_Context;
+
+end Grt.Rtis_Addr;
diff --git a/translate/grt/grt-rtis_addr.ads b/translate/grt/grt-rtis_addr.ads
new file mode 100644
index 000000000..3f6b73e39
--- /dev/null
+++ b/translate/grt/grt-rtis_addr.ads
@@ -0,0 +1,88 @@
+--  GHDL Run Time (GRT) -  RTI address handling.
+--  Copyright (C) 2002, 2003, 2004, 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; use System;
+with Ada.Unchecked_Conversion;
+with Grt.Types; use Grt.Types;
+with Grt.Rtis; use Grt.Rtis;
+
+--  Addresses handling.
+package Grt.Rtis_Addr is
+   function "+" (L : Address; R : Ghdl_Index_Type) return Address;
+
+   function "-" (L : Address; R : Ghdl_Index_Type) return Address;
+
+   function Align (L : Address; R : Ghdl_Index_Type) return Address;
+
+   --  An RTI context contains a pointer (BASE) to or into an instance.
+   --  BLOCK describes data being pointed.  If a reference is made to a field
+   --  described by a parent of BLOCK, BASE must be modified.
+   type Rti_Context is record
+      Base : Address;
+      Block : Ghdl_Rti_Access;
+   end record;
+
+   Null_Context : constant Rti_Context;
+
+   --  Access to an address.
+   type Addr_Acc is access Address;
+   function To_Addr_Acc is new Ada.Unchecked_Conversion
+     (Source => Address, Target => Addr_Acc);
+
+   --  Get the parent context of CTXT.
+   --  The parent of an architecture is its entity.
+   function Get_Parent_Context (Ctxt : Rti_Context) return Rti_Context;
+
+   --  From an entity link, extract context and instantiation statement.
+   procedure Get_Instance_Link (Link : Ghdl_Entity_Link_Acc;
+                                Ctxt : out Rti_Context;
+                                Stmt : out Ghdl_Rti_Access);
+
+   --  Convert a location to an address.
+   function Loc_To_Addr (Depth : Ghdl_Rti_Depth;
+                         Loc : Ghdl_Rti_Loc;
+                         Ctxt : Rti_Context)
+                        return Address;
+
+   --  Get the length of for_generate BLK.
+   function Get_For_Generate_Length (Blk : Ghdl_Rtin_Block_Acc;
+                                     Ctxt : Rti_Context)
+                                    return Ghdl_Index_Type;
+
+   --  Get the context of instance INST.
+   procedure Get_Instance_Context (Inst : Ghdl_Rtin_Instance_Acc;
+                                   Ctxt : Rti_Context;
+                                   Sub_Ctxt : out Rti_Context);
+
+   --  Extract range of every dimension from bounds.
+   procedure Bound_To_Range (Bounds_Addr : Address;
+                             Def : Ghdl_Rtin_Type_Array_Acc;
+                             Res : out Ghdl_Range_Array);
+
+   function Range_To_Length (Rng : Ghdl_Range_Ptr; Base_Type : Ghdl_Rti_Access)
+                            return Ghdl_Index_Type;
+
+   --  Get the base type of ATYPE.
+   function Get_Base_Type (Atype : Ghdl_Rti_Access) return Ghdl_Rti_Access;
+
+   --  Get the top context.
+   function Get_Top_Context return Rti_Context;
+
+private
+   Null_Context : constant Rti_Context := (Base => Null_Address,
+                                           Block => null);
+end Grt.Rtis_Addr;
diff --git a/translate/grt/grt-rtis_binding.ads b/translate/grt/grt-rtis_binding.ads
new file mode 100644
index 000000000..cf8c7e0d7
--- /dev/null
+++ b/translate/grt/grt-rtis_binding.ads
@@ -0,0 +1,60 @@
+--  GHDL Run Time (GRT) -  Well known RTIs.
+--  Copyright (C) 2002, 2003, 2004, 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; use System;
+with Grt.Rtis; use Grt.Rtis;
+
+--  Set RTI_ptr defined in grt.rtis_types.
+
+package Grt.Rtis_Binding is
+   pragma Preelaborate (Grt.Rtis_Binding);
+
+   --  Define and set bit and boolean RTIs.
+   Std_Standard_Bit_RTI : aliased Ghdl_Rti_Common;
+
+   Std_Standard_Boolean_RTI : aliased Ghdl_Rti_Common;
+
+   pragma Import (C, Std_Standard_Bit_RTI,
+                  "std__standard__bit__RTI");
+
+   pragma Import (C, Std_Standard_Boolean_RTI,
+                  "std__standard__boolean__RTI");
+
+   Std_Standard_Bit_RTI_Ptr : Ghdl_Rti_Access
+     := Std_Standard_Bit_RTI'Access;
+
+   Std_Standard_Boolean_RTI_Ptr : Ghdl_Rti_Access
+     := Std_Standard_Boolean_RTI'Access;
+
+   pragma Export (C, Std_Standard_Bit_RTI_Ptr,
+                  "std__standard__bit__RTI_ptr");
+
+   pragma Export (C, Std_Standard_Boolean_RTI_Ptr,
+                  "std__standard__boolean__RTI_ptr");
+
+
+   --  Define and set Resolved_Resolv_Ptr.
+   procedure Ieee_Std_Logic_1164_Resolved_RESOLV;
+   pragma Import (C, Ieee_Std_Logic_1164_Resolved_RESOLV,
+                  "ieee__std_logic_1164__resolved_RESOLV");
+
+   Ieee_Std_Logic_1164_Resolved_Resolv_Ptr : Address :=
+     Ieee_Std_Logic_1164_Resolved_RESOLV'Address;
+   pragma Export (C, Ieee_Std_Logic_1164_Resolved_Resolv_Ptr,
+                  "ieee__std_logic_1164__resolved_RESOLV_ptr");
+
+end Grt.Rtis_Binding;
diff --git a/translate/grt/grt-rtis_types.adb b/translate/grt/grt-rtis_types.adb
new file mode 100644
index 000000000..05ffa644a
--- /dev/null
+++ b/translate/grt/grt-rtis_types.adb
@@ -0,0 +1,111 @@
+--  GHDL Run Time (GRT) -  Well known RTI types.
+--  Copyright (C) 2002, 2003, 2004, 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.Astdio;
+with Grt.Avhpi; use Grt.Avhpi;
+
+package body Grt.Rtis_Types is
+
+   procedure Avhpi_Error (Err : AvhpiErrorT)
+   is
+      use Grt.Astdio;
+      pragma Unreferenced (Err);
+   begin
+      Put_Line ("grt.rtis_utils.Avhpi_Error!");
+   end Avhpi_Error;
+
+   --  Extract std_ulogic type.
+   procedure Search_Types (Pack : VhpiHandleT)
+   is
+      Decl_It : VhpiHandleT;
+      Decl : VhpiHandleT;
+
+      Error : AvhpiErrorT;
+      Name : String (1 .. 16);
+      Name_Len : Natural;
+      Rti : Ghdl_Rti_Access;
+   begin
+      Vhpi_Get_Str (VhpiLibLogicalNameP, Pack, Name, Name_Len);
+      if not (Name_Len = 4 and then Name (1 .. 4)= "ieee") then
+         return;
+      end if;
+
+      Vhpi_Iterator (VhpiDecls, Pack, Decl_It, Error);
+      if Error /= AvhpiErrorOk then
+         Avhpi_Error (Error);
+         return;
+      end if;
+
+      --  Extract packages.
+      loop
+         Vhpi_Scan (Decl_It, Decl, Error);
+         exit when Error = AvhpiErrorIteratorEnd;
+         if Error /= AvhpiErrorOk then
+            Avhpi_Error (Error);
+            return;
+         end if;
+
+         if Vhpi_Get_Kind (Decl) = VhpiEnumTypeDeclK then
+            Vhpi_Get_Str (VhpiNameP, Decl, Name, Name_Len);
+            Rti := Avhpi_Get_Rti (Decl);
+            if Name_Len = 10 and then Name (1 .. 10) = "std_ulogic" then
+               Ieee_Std_Logic_1164_Std_Ulogic_RTI_Ptr := Rti;
+            end if;
+         end if;
+      end loop;
+   end Search_Types;
+
+   procedure Search_Packages
+   is
+      Pack : VhpiHandleT;
+      Pack_It : VhpiHandleT;
+
+      Error : AvhpiErrorT;
+      Name : String (1 .. 16);
+      Name_Len : Natural;
+   begin
+      Get_Package_Inst (Pack_It);
+
+      --  Extract packages.
+      loop
+         Vhpi_Scan (Pack_It, Pack, Error);
+         exit when Error = AvhpiErrorIteratorEnd;
+         if Error /= AvhpiErrorOk then
+            Avhpi_Error (Error);
+            return;
+         end if;
+
+         Vhpi_Get_Str (VhpiNameP, Pack, Name, Name_Len);
+         if Name_Len = 14 and then Name (1 .. 14) = "std_logic_1164" then
+            Search_Types (Pack);
+         end if;
+      end loop;
+   end Search_Packages;
+
+   Search_Types_RTI_Done : Boolean := False;
+
+   procedure Search_Types_RTI is
+   begin
+      if Search_Types_RTI_Done then
+         return;
+      else
+         Search_Types_RTI_Done := True;
+      end if;
+
+      Search_Packages;
+   end Search_Types_RTI;
+end Grt.Rtis_Types;
diff --git a/translate/grt/grt-rtis_types.ads b/translate/grt/grt-rtis_types.ads
new file mode 100644
index 000000000..153e1f160
--- /dev/null
+++ b/translate/grt/grt-rtis_types.ads
@@ -0,0 +1,48 @@
+--  GHDL Run Time (GRT) -  Well known RTI types.
+--  Copyright (C) 2002, 2003, 2004, 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.Rtis; use Grt.Rtis;
+
+--  This package allow access to RTIs of some types.
+--  This is used to recognize some VHDL logic types.
+--  This is also used by grt.signals to set types of some implicit signals
+--   (such as 'stable or 'transation).
+
+package Grt.Rtis_Types is
+   --  RTIs for some logic types.
+   Std_Standard_Bit_RTI_Ptr : Ghdl_Rti_Access;
+
+   Std_Standard_Boolean_RTI_Ptr : Ghdl_Rti_Access;
+
+   --  std_ulogic.
+   --  A VHDL may not contain ieee.std_logic_1164 package.  So, this RTI
+   --  must be dynamicaly searched.
+   Ieee_Std_Logic_1164_Std_Ulogic_RTI_Ptr : Ghdl_Rti_Access := null;
+
+   --  Search RTI for types.
+   --  If a type is not found, its RTI is set to null.
+   --  If this procedure has already been called, then this is a noop.
+   procedure Search_Types_RTI;
+private
+   --  These are set either by grt.rtis_binding or by ghdlrun.
+   --  This is not very clean...
+   pragma Import (C, Std_Standard_Bit_RTI_Ptr,
+                  "std__standard__bit__RTI_ptr");
+
+   pragma Import (C, Std_Standard_Boolean_RTI_Ptr,
+                  "std__standard__boolean__RTI_ptr");
+end Grt.Rtis_Types;
diff --git a/translate/grt/grt-rtis_utils.adb b/translate/grt/grt-rtis_utils.adb
new file mode 100644
index 000000000..62cd407e8
--- /dev/null
+++ b/translate/grt/grt-rtis_utils.adb
@@ -0,0 +1,623 @@
+--  GHDL Run Time (GRT) - RTI utilities.
+--  Copyright (C) 2002, 2003, 2004, 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; use System;
+with Grt.Rtis; use Grt.Rtis;
+with Grt.Types; use Grt.Types;
+--with Grt.Disp; use Grt.Disp;
+with Grt.Errors; use Grt.Errors;
+
+package body Grt.Rtis_Utils is
+
+   function Traverse_Blocks (Ctxt : Rti_Context) return Traverse_Result
+   is
+      function Traverse_Instance (Ctxt : Rti_Context) return Traverse_Result;
+
+      function Traverse_Blocks_1 (Ctxt : Rti_Context) return Traverse_Result
+      is
+         Blk : Ghdl_Rtin_Block_Acc;
+
+         Res : Traverse_Result;
+         Nctxt : Rti_Context;
+         Index : Ghdl_Index_Type;
+         Child : Ghdl_Rti_Access;
+      begin
+         Res := Process (Ctxt, Ctxt.Block);
+         if Res /= Traverse_Ok then
+            return Res;
+         end if;
+
+         Blk := To_Ghdl_Rtin_Block_Acc (Ctxt.Block);
+         Index := 0;
+         while Index < Blk.Nbr_Child loop
+            Child := Blk.Children (Index);
+            Index := Index + 1;
+            case Child.Kind is
+               when Ghdl_Rtik_Process
+                 | Ghdl_Rtik_Block =>
+                  declare
+                     Nblk : Ghdl_Rtin_Block_Acc;
+                  begin
+                     Nblk := To_Ghdl_Rtin_Block_Acc (Child);
+                     Nctxt := (Base => Ctxt.Base + Nblk.Loc.Off,
+                               Block => Child);
+                     Res := Traverse_Blocks_1 (Nctxt);
+                  end;
+               when Ghdl_Rtik_For_Generate =>
+                  declare
+                     Nblk : Ghdl_Rtin_Block_Acc;
+                     Length : Ghdl_Index_Type;
+                  begin
+                     Nblk := To_Ghdl_Rtin_Block_Acc (Child);
+                     Nctxt :=
+                       (Base => To_Addr_Acc (Ctxt.Base + Nblk.Loc.Off).all,
+                        Block => Child);
+                     Length := Get_For_Generate_Length (Nblk, Ctxt);
+                     for I in 1 .. Length loop
+                        Res := Traverse_Blocks_1 (Nctxt);
+                        exit when Res = Traverse_Stop;
+                        Nctxt.Base := Nctxt.Base + Nblk.Size;
+                     end loop;
+                  end;
+               when Ghdl_Rtik_If_Generate =>
+                  declare
+                     Nblk : Ghdl_Rtin_Block_Acc;
+                  begin
+                     Nblk := To_Ghdl_Rtin_Block_Acc (Child);
+                     Nctxt :=
+                       (Base => To_Addr_Acc (Ctxt.Base + Nblk.Loc.Off).all,
+                        Block => Child);
+                     if Nctxt.Base /= Null_Address then
+                        Res := Traverse_Blocks_1 (Nctxt);
+                     end if;
+                  end;
+               when Ghdl_Rtik_Instance =>
+                  Res := Process (Ctxt, Child);
+                  if Res = Traverse_Ok then
+                     declare
+                        Obj : Ghdl_Rtin_Instance_Acc;
+                     begin
+                        Obj := To_Ghdl_Rtin_Instance_Acc (Child);
+
+                        Get_Instance_Context (Obj, Ctxt, Nctxt);
+                        Res := Traverse_Instance (Nctxt);
+                     end;
+                  end if;
+               when Ghdl_Rtik_Package
+                 | Ghdl_Rtik_Entity
+                 | Ghdl_Rtik_Architecture =>
+                  Internal_Error ("traverse_blocks");
+               when Ghdl_Rtik_Port
+                 | Ghdl_Rtik_Signal
+                 | Ghdl_Rtik_Guard
+                 | Ghdl_Rtik_Attribute_Quiet
+                 | Ghdl_Rtik_Attribute_Stable
+                 | Ghdl_Rtik_Attribute_Transaction =>
+                  Res := Process (Ctxt, Child);
+               when others =>
+                  null;
+            end case;
+            exit when Res = Traverse_Stop;
+         end loop;
+
+         return Res;
+      end Traverse_Blocks_1;
+
+      function Traverse_Instance (Ctxt : Rti_Context) return Traverse_Result
+      is
+         Blk : Ghdl_Rtin_Block_Acc;
+
+         Res : Traverse_Result;
+         Nctxt : Rti_Context;
+
+      begin
+         Blk := To_Ghdl_Rtin_Block_Acc (Ctxt.Block);
+         case Blk.Common.Kind is
+            when Ghdl_Rtik_Architecture =>
+               Nctxt := (Base => Ctxt.Base,
+                         Block => Blk.Parent);
+               --  The entity.
+               Res := Traverse_Blocks_1 (Nctxt);
+               if Res /= Traverse_Stop then
+                  --  The architecture.
+                  Res := Traverse_Blocks_1 (Ctxt);
+               end if;
+            when Ghdl_Rtik_Package_Body =>
+               Nctxt := (Base => Ctxt.Base,
+                         Block => Blk.Parent);
+               Res := Traverse_Blocks_1 (Nctxt);
+            when others =>
+               Internal_Error ("traverse_blocks");
+         end case;
+         return Res;
+      end Traverse_Instance;
+   begin
+      return Traverse_Instance (Ctxt);
+   end Traverse_Blocks;
+
+   function Rti_Complex_Type (Atype : Ghdl_Rti_Access) return Boolean
+   is
+   begin
+      return (Atype.Mode and Ghdl_Rti_Type_Complex_Mask)
+        = Ghdl_Rti_Type_Complex;
+   end Rti_Complex_Type;
+
+   --  Disp value stored at ADDR and whose type is described by RTI.
+   procedure Get_Enum_Value
+     (Vstr : in out Vstring; Rti : Ghdl_Rti_Access; Val : Ghdl_Index_Type)
+   is
+      Enum_Rti : Ghdl_Rtin_Type_Enum_Acc;
+   begin
+      Enum_Rti := To_Ghdl_Rtin_Type_Enum_Acc (Rti);
+      Append (Vstr, Enum_Rti.Names (Val));
+   end Get_Enum_Value;
+
+
+   procedure Foreach_Scalar (Ctxt : Rti_Context;
+                             Obj_Type : Ghdl_Rti_Access;
+                             Obj_Addr : Address;
+                             Is_Sig : Boolean)
+   is
+      --  Current address.
+      Addr : Address;
+
+      Name : Vstring;
+
+      procedure Handle_Any (Rti : Ghdl_Rti_Access);
+
+      procedure Handle_Scalar (Rti : Ghdl_Rti_Access)
+      is
+         procedure Update (S : Ghdl_Index_Type) is
+         begin
+            Addr := Addr + (S / Storage_Unit);
+         end Update;
+      begin
+         Process (Addr, Name, Rti);
+
+         if Is_Sig then
+            Update (Address'Size);
+         else
+            case Rti.Kind is
+               when Ghdl_Rtik_Type_I32 =>
+                  Update (32);
+               when Ghdl_Rtik_Type_E8 =>
+                  Update (8);
+               when Ghdl_Rtik_Type_B2 =>
+                  Update (8);
+               when Ghdl_Rtik_Type_F64 =>
+                  Update (64);
+               when Ghdl_Rtik_Type_P64 =>
+                  Update (64);
+               when others =>
+                  Internal_Error ("handle_scalar");
+            end case;
+         end if;
+      end Handle_Scalar;
+
+      procedure Range_Pos_To_Val (Rti : Ghdl_Rti_Access;
+                                  Rng : Ghdl_Range_Ptr;
+                                  Pos : Ghdl_Index_Type;
+                                  Val : out Value_Union)
+      is
+      begin
+         case Rti.Kind is
+            when Ghdl_Rtik_Type_I32 =>
+               case Rng.I32.Dir is
+                  when Dir_To =>
+                     Val.I32 := Rng.I32.Left + Ghdl_I32 (Pos);
+                  when Dir_Downto =>
+                     Val.I32 := Rng.I32.Left - Ghdl_I32 (Pos);
+               end case;
+            when Ghdl_Rtik_Type_E8 =>
+               case Rng.E8.Dir is
+                  when Dir_To =>
+                     Val.E8 := Rng.E8.Left + Ghdl_E8 (Pos);
+                  when Dir_Downto =>
+                     Val.E8 := Rng.E8.Left - Ghdl_E8 (Pos);
+               end case;
+            when Ghdl_Rtik_Type_B2 =>
+               case Pos is
+                  when 0 =>
+                     Val.B2 := Rng.B2.Left;
+                  when 1 =>
+                     Val.B2 := Rng.B2.Right;
+                  when others =>
+                     Val.B2 := False;
+               end case;
+            when others =>
+               Internal_Error ("grt.rtis_utils.range_pos_to_val");
+         end case;
+      end Range_Pos_To_Val;
+
+      procedure Pos_To_Vstring
+        (Vstr : in out Vstring;
+         Rti : Ghdl_Rti_Access;
+         Rng : Ghdl_Range_Ptr;
+         Pos : Ghdl_Index_Type)
+      is
+         V : Value_Union;
+      begin
+         Range_Pos_To_Val (Rti, Rng, Pos, V);
+         case Rti.Kind is
+            when Ghdl_Rtik_Type_I32 =>
+               declare
+                  S : String (1 .. 12);
+                  F : Natural;
+               begin
+                  To_String (S, F, V.I32);
+                  Append (Vstr, S (F .. S'Last));
+               end;
+            when Ghdl_Rtik_Type_E8 =>
+               Get_Enum_Value (Vstr, Rti, Ghdl_Index_Type (V.E8));
+            when Ghdl_Rtik_Type_B2 =>
+               Get_Enum_Value (Vstr, Rti, Ghdl_B2'Pos (V.B2));
+            when others =>
+               Append (Vstr, '?');
+         end case;
+      end Pos_To_Vstring;
+
+      procedure Handle_Array_1 (El_Rti : Ghdl_Rti_Access;
+                                Rngs : Ghdl_Range_Array;
+                                Rtis : Ghdl_Rti_Arr_Acc;
+                                Index : Ghdl_Index_Type)
+      is
+         Len : Ghdl_Index_Type;
+         P : Natural;
+         Base_Type : Ghdl_Rti_Access;
+      begin
+         P := Length (Name);
+         if Index = 0 then
+            Append (Name, '(');
+         else
+            Append (Name, ',');
+         end if;
+
+         Base_Type := Get_Base_Type (Rtis (Index));
+         Len := Range_To_Length (Rngs (Index),  Base_Type);
+
+         for I in 1 .. Len loop
+            Pos_To_Vstring (Name, Base_Type, Rngs (Index), I - 1);
+            if Index = Rngs'Last then
+               Append (Name, ')');
+               Handle_Any (El_Rti);
+            else
+               Handle_Array_1 (El_Rti, Rngs, Rtis, Index + 1);
+            end if;
+            Truncate (Name, P + 1);
+         end loop;
+         Truncate (Name, P);
+      end Handle_Array_1;
+
+      procedure Handle_Array (Rti : Ghdl_Rtin_Type_Array_Acc;
+                              Vals : Ghdl_Uc_Array_Acc)
+      is
+         Nbr_Dim : Ghdl_Index_Type := Rti.Nbr_Dim;
+         Rngs : Ghdl_Range_Array (0 .. Nbr_Dim - 1);
+      begin
+         Bound_To_Range (Vals.Bounds, Rti, Rngs);
+         Addr := Vals.Base;
+         Handle_Array_1 (Rti.Element, Rngs, Rti.Indexes, 0);
+      end Handle_Array;
+
+      procedure Handle_Record (Rti : Ghdl_Rtin_Type_Record_Acc)
+      is
+         El : Ghdl_Rtin_Element_Acc;
+         Obj_Addr : Address;
+         P : Natural;
+      begin
+         P := Length (Name);
+         Obj_Addr := Addr;
+         for I in 1 .. Rti.Nbrel loop
+            El := To_Ghdl_Rtin_Element_Acc (Rti.Elements (I - 1));
+            if Is_Sig then
+               Addr := Obj_Addr + El.Sig_Off;
+            else
+               Addr := Obj_Addr + El.Val_Off;
+            end if;
+            Append (Name, '.');
+            Append (Name, El.Name);
+            Handle_Any (El.Eltype);
+            Truncate (Name, P);
+         end loop;
+         -- FIXME
+         --Addr := Obj_Addr + Rti.Xx;
+      end Handle_Record;
+
+      procedure Handle_Any (Rti : Ghdl_Rti_Access)
+      is
+         Save_Addr : Address;
+      begin
+         case Rti.Kind is
+            when Ghdl_Rtik_Subtype_Scalar =>
+               Handle_Scalar (To_Ghdl_Rtin_Subtype_Scalar_Acc (Rti).Basetype);
+            when Ghdl_Rtik_Type_I32
+              | Ghdl_Rtik_Type_E8
+              | Ghdl_Rtik_Type_B2 =>
+               Handle_Scalar (Rti);
+            when Ghdl_Rtik_Type_Array =>
+               Handle_Array (To_Ghdl_Rtin_Type_Array_Acc (Rti),
+                             To_Ghdl_Uc_Array_Acc (Addr));
+            when Ghdl_Rtik_Subtype_Array =>
+               declare
+                  St : Ghdl_Rtin_Subtype_Array_Acc :=
+                    To_Ghdl_Rtin_Subtype_Array_Acc (Rti);
+                  Bt : Ghdl_Rtin_Type_Array_Acc := St.Basetype;
+                  Rngs : Ghdl_Range_Array (0 .. Bt.Nbr_Dim - 1);
+               begin
+                  Bound_To_Range
+                    (Loc_To_Addr (St.Common.Depth, St.Bounds, Ctxt), Bt, Rngs);
+                  if Rti_Complex_Type (Rti) then
+                     Save_Addr := Addr;
+                     Addr := To_Addr_Acc (Addr).all;
+                  end if;
+                  Handle_Array_1 (Bt.Element, Rngs, Bt.Indexes, 0);
+                  if Rti_Complex_Type (Rti) then
+                     Addr := Save_Addr + (Address'Size / Storage_Unit);
+                  end if;
+               end;
+            when Ghdl_Rtik_Subtype_Array_Ptr =>
+               declare
+                  St : Ghdl_Rtin_Subtype_Array_Acc :=
+                    To_Ghdl_Rtin_Subtype_Array_Acc (Rti);
+                  Bt : Ghdl_Rtin_Type_Array_Acc := St.Basetype;
+                  Rngs : Ghdl_Range_Array (0 .. Bt.Nbr_Dim - 1);
+               begin
+                  Bound_To_Range
+                    (Loc_To_Addr (St.Common.Depth, St.Bounds, Ctxt), Bt, Rngs);
+                  Save_Addr := Addr;
+                  Addr := To_Addr_Acc (Addr).all;
+                  Handle_Array_1 (Bt.Element, Rngs, Bt.Indexes, 0);
+                  Addr := Save_Addr + (Address'Size / Storage_Unit);
+               end;
+--          when Ghdl_Rtik_Type_File =>
+--             declare
+--                Vptr : Ghdl_Value_Ptr;
+--             begin
+--                Vptr := To_Ghdl_Value_Ptr (Obj);
+--                Put (Stream, "File#");
+--                Put_I32 (Stream, Vptr.I32);
+--                --  FIXME: update OBJ (not very useful since never in a
+--                --   composite type).
+--             end;
+            when Ghdl_Rtik_Type_Record =>
+               if Rti_Complex_Type (Rti) then
+                  Save_Addr := Addr;
+                  Addr := To_Addr_Acc (Addr).all;
+               end if;
+               Handle_Record (To_Ghdl_Rtin_Type_Record_Acc (Rti));
+               if Rti_Complex_Type (Rti) then
+                  Addr := Save_Addr + (Address'Size / Storage_Unit);
+               end if;
+            when others =>
+               Internal_Error ("grt.rtis_utils.foreach_scalar.handle_any");
+         end case;
+      end Handle_Any;
+   begin
+      Addr := Obj_Addr;
+      Handle_Any (Obj_Type);
+      Free (Name);
+   end Foreach_Scalar;
+
+   procedure Get_Value (Str : in out Vstring;
+                        Value : Value_Union;
+                        Type_Rti : Ghdl_Rti_Access)
+   is
+   begin
+      case Type_Rti.Kind is
+         when Ghdl_Rtik_Type_I32 =>
+            declare
+               S : String (1 .. 12);
+               F : Natural;
+            begin
+               To_String (S, F, Value.I32);
+               Append (Str, S (F .. S'Last));
+            end;
+         when Ghdl_Rtik_Type_E8 =>
+            Get_Enum_Value (Str, Type_Rti, Ghdl_Index_Type (Value.E8));
+         when Ghdl_Rtik_Type_B2 =>
+            Get_Enum_Value
+              (Str, Type_Rti, Ghdl_Index_Type (Ghdl_B2'Pos (Value.B2)));
+         when Ghdl_Rtik_Type_F64 =>
+            declare
+               S : String (1 .. 32);
+               L : Integer;
+               --  Warning: this assumes a C99 snprintf (ie, it returns the
+               --  number of characters).
+               function snprintf (Cstr : Address;
+                                  Size : Natural;
+                                  Template : Address;
+                                  Arg : Ghdl_F64)
+                 return Integer;
+               pragma Import (C, snprintf);
+
+               Format : constant String := "%g" & Character'Val (0);
+            begin
+               L := snprintf (S'Address, S'Length, Format'Address, Value.F64);
+               if L < 0 then
+                  --  FIXME.
+                  Append (Str, "?");
+               else
+                  Append (Str, S (1 .. L));
+               end if;
+            end;
+         when Ghdl_Rtik_Type_P32 =>
+            declare
+               S : String (1 .. 12);
+               F : Natural;
+            begin
+               To_String (S, F, Value.I32);
+               Append (Str, S (F .. S'Last));
+               Append (Str,
+                       To_Ghdl_Rtin_Unit_Acc (To_Ghdl_Rtin_Type_Physical_Acc
+                                              (Type_Rti).Units (0)).Name);
+            end;
+         when Ghdl_Rtik_Type_P64 =>
+            declare
+               S : String (1 .. 21);
+               F : Natural;
+            begin
+               To_String (S, F, Value.I64);
+               Append (Str, S (F .. S'Last));
+               Append (Str,
+                       To_Ghdl_Rtin_Unit_Acc (To_Ghdl_Rtin_Type_Physical_Acc
+                                              (Type_Rti).Units (0)).Name);
+            end;
+         when others =>
+            Internal_Error ("grt.rtis_utils.get_value");
+      end case;
+   end Get_Value;
+
+   procedure Disp_Value (Stream : FILEs;
+                         Value : Value_Union;
+                         Type_Rti : Ghdl_Rti_Access)
+   is
+      Name : Vstring;
+   begin
+      Rtis_Utils.Get_Value (Name, Value, Type_Rti);
+      Put (Stream, Name);
+   end Disp_Value;
+
+   procedure Get_Enum_Value
+     (Rstr : in out Rstring; Rti : Ghdl_Rti_Access; Val : Ghdl_Index_Type)
+   is
+      Enum_Rti : Ghdl_Rtin_Type_Enum_Acc;
+   begin
+      Enum_Rti := To_Ghdl_Rtin_Type_Enum_Acc (Rti);
+      Prepend (Rstr, Enum_Rti.Names (Val));
+   end Get_Enum_Value;
+
+
+   procedure Get_Value (Rstr : in out Rstring;
+                        Addr : Address;
+                        Type_Rti : Ghdl_Rti_Access)
+   is
+      Value : Ghdl_Value_Ptr := To_Ghdl_Value_Ptr (Addr);
+   begin
+      case Type_Rti.Kind is
+         when Ghdl_Rtik_Type_I32 =>
+            declare
+               S : String (1 .. 12);
+               F : Natural;
+            begin
+               To_String (S, F, Value.I32);
+               Prepend (Rstr, S (F .. S'Last));
+            end;
+         when Ghdl_Rtik_Type_E8 =>
+            Get_Enum_Value (Rstr, Type_Rti, Ghdl_Index_Type (Value.E8));
+         when Ghdl_Rtik_Type_B2 =>
+            Get_Enum_Value
+              (Rstr, Type_Rti, Ghdl_Index_Type (Ghdl_B2'Pos (Value.B2)));
+         when others =>
+            Internal_Error ("grt.rtis_utils.get_value(rstr)");
+      end case;
+   end Get_Value;
+
+   procedure Get_Path_Name (Rstr : in out Rstring;
+                            Last_Ctxt : Rti_Context;
+                            Sep : Character;
+                            Is_Instance : Boolean := True)
+   is
+      Blk : Ghdl_Rtin_Block_Acc;
+      Ctxt : Rti_Context;
+   begin
+      Ctxt := Last_Ctxt;
+      loop
+         Blk := To_Ghdl_Rtin_Block_Acc (Ctxt.Block);
+         case Ctxt.Block.Kind is
+            when Ghdl_Rtik_Process
+              | Ghdl_Rtik_Block
+              | Ghdl_Rtik_If_Generate =>
+               Prepend (Rstr, Blk.Name);
+               Prepend (Rstr, Sep);
+               Ctxt := Get_Parent_Context (Ctxt);
+            when Ghdl_Rtik_Entity =>
+               declare
+                  Link : Ghdl_Entity_Link_Acc;
+               begin
+                  Link := To_Ghdl_Entity_Link_Acc (Ctxt.Base);
+                  Ctxt := (Base => Ctxt.Base,
+                           Block => Link.Rti);
+               end;
+            when Ghdl_Rtik_Architecture =>
+               declare
+                  Entity_Ctxt: Rti_Context;
+                  Link : Ghdl_Entity_Link_Acc;
+                  Parent_Inst : Ghdl_Rti_Access;
+               begin
+                  --  Architecture name.
+                  if Is_Instance then
+                     Prepend (Rstr, ')');
+                     Prepend (Rstr, Blk.Name);
+                     Prepend (Rstr, '(');
+                  end if;
+
+                  Entity_Ctxt := Get_Parent_Context (Ctxt);
+
+                  --  Instance parent.
+                  Link := To_Ghdl_Entity_Link_Acc (Entity_Ctxt.Base);
+                  Get_Instance_Link (Link, Ctxt, Parent_Inst);
+
+                  --  Add entity name.
+                  if Is_Instance or Parent_Inst = null then
+                     Prepend (Rstr,
+                              To_Ghdl_Rtin_Block_Acc (Entity_Ctxt.Block).Name);
+                  end if;
+
+                  if Parent_Inst = null then
+                     --  Top reached.
+                     Prepend (Rstr, Sep);
+                     return;
+                  else
+                     --  Instantiation statement label.
+                     if Is_Instance then
+                        Prepend (Rstr, '@');
+                     end if;
+                     Prepend (Rstr,
+                              To_Ghdl_Rtin_Object_Acc (Parent_Inst).Name);
+                     Prepend (Rstr, Sep);
+                  end if;
+               end;
+            when Ghdl_Rtik_For_Generate =>
+               declare
+                  Iter : Ghdl_Rtin_Object_Acc;
+                  Addr : Address;
+               begin
+                  Prepend (Rstr, ')');
+                  Iter := To_Ghdl_Rtin_Object_Acc (Blk.Children (0));
+                  Addr := Loc_To_Addr (Iter.Common.Depth, Iter.Loc, Ctxt);
+                  Get_Value (Rstr, Addr, Get_Base_Type (Iter.Obj_Type));
+                  Prepend (Rstr, '(');
+                  Prepend (Rstr, Blk.Name);
+                  Prepend (Rstr, Sep);
+                  Ctxt := Get_Parent_Context (Ctxt);
+               end;
+            when others =>
+               Internal_Error ("grt.rtis_utils.get_path_name");
+         end case;
+      end loop;
+   end Get_Path_Name;
+
+   procedure Put (Stream : FILEs; Ctxt : Rti_Context)
+   is
+      Rstr : Rstring;
+   begin
+      Get_Path_Name (Rstr, Ctxt, '.');
+      Put (Stream, Rstr);
+      Free (Rstr);
+   end Put;
+
+end Grt.Rtis_Utils;
diff --git a/translate/grt/grt-rtis_utils.ads b/translate/grt/grt-rtis_utils.ads
new file mode 100644
index 000000000..9b8fd33a0
--- /dev/null
+++ b/translate/grt/grt-rtis_utils.ads
@@ -0,0 +1,67 @@
+--  GHDL Run Time (GRT) - RTI utilities.
+--  Copyright (C) 2002, 2003, 2004, 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; use System;
+with Grt.Types; use Grt.Types;
+with Grt.Rtis; use Grt.Rtis;
+with Grt.Rtis_Addr; use Grt.Rtis_Addr;
+with Grt.Vstrings; use Grt.Vstrings;
+with Grt.Stdio; use Grt.Stdio;
+
+package Grt.Rtis_Utils is
+   --  Action to perform after a node was handled by the user function:
+   --  Traverse_Ok: continue to process.
+   --  Traverse_Skip: do not traverse children.
+   --  Traverse_Stop: end of walk.
+   type Traverse_Result is (Traverse_Ok, Traverse_Skip, Traverse_Stop);
+
+   --  Traverse all blocks (package, entities, architectures, block, generate,
+   --  processes).
+   generic
+      with function Process (Ctxt : Rti_Context;
+                             Obj : Ghdl_Rti_Access)
+                            return Traverse_Result;
+   function Traverse_Blocks (Ctxt : Rti_Context) return Traverse_Result;
+
+   generic
+      with procedure Process (Val_Addr : Address;
+                              Val_Name : Vstring;
+                              Val_Type : Ghdl_Rti_Access);
+   procedure Foreach_Scalar (Ctxt : Rti_Context;
+                             Obj_Type : Ghdl_Rti_Access;
+                             Obj_Addr : Address;
+                             Is_Sig : Boolean);
+
+   procedure Get_Value (Str : in out Vstring;
+                        Value : Value_Union;
+                        Type_Rti : Ghdl_Rti_Access);
+
+   --  Disp a value.
+   procedure Disp_Value (Stream : FILEs;
+                         Value : Value_Union;
+                         Type_Rti : Ghdl_Rti_Access);
+
+   --  Get context as a path name.
+   --  If IS_INSTANCE is true, the architecture name of entities is added.
+   procedure Get_Path_Name (Rstr : in out Rstring;
+                            Last_Ctxt : Rti_Context;
+                            Sep : Character;
+                            Is_Instance : Boolean := True);
+
+   --  Disp a context as a path.
+   procedure Put (Stream : FILEs; Ctxt : Rti_Context);
+end Grt.Rtis_Utils;
diff --git a/translate/grt/grt-sdf.adb b/translate/grt/grt-sdf.adb
new file mode 100644
index 000000000..9d329781c
--- /dev/null
+++ b/translate/grt/grt-sdf.adb
@@ -0,0 +1,1330 @@
+--  GHDL Run Time (GRT) - SDF parser.
+--  Copyright (C) 2002, 2003, 2004, 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;
+with Grt.Stdio; use Grt.Stdio;
+with Grt.Errors; use Grt.Errors;
+with Ada.Characters.Latin_1;
+with Ada.Unchecked_Deallocation;
+with Grt.Vital_Annotate;
+
+package body Grt.Sdf is
+   EOT : constant Character := Character'Val (4);
+
+   type Sdf_Token_Type is
+     (
+      Tok_Oparen, -- (
+      Tok_Cparen, -- )
+      Tok_Qstring,
+      Tok_Identifier,
+      Tok_Rnumber,
+      Tok_Dnumber,
+      Tok_Div, -- /
+      Tok_Dot, -- .
+      Tok_Cln, -- :
+
+      Tok_Error,
+      Tok_Eof
+     );
+
+   type Sdf_Context_Acc is access Sdf_Context_Type;
+   procedure Unchecked_Deallocation is new Ada.Unchecked_Deallocation
+     (Name => Sdf_Context_Acc, Object => Sdf_Context_Type);
+
+   Sdf_Context : Sdf_Context_Acc;
+
+   --  Current data read from the file.
+   Buf : String_Access (1 .. Buf_Size) := null;
+
+   --  Length of the buffer, including the EOT.
+   Buf_Len : Natural;
+   Pos : Natural;
+   Line_Start : Integer;
+
+   Sdf_Stream : FILEs := NULL_Stream;
+   Sdf_Filename : String_Access := null;
+   Sdf_Line : Natural;
+
+   function Open_Sdf (Filename : String) return Boolean
+   is
+      N_Filename : String (1 .. Filename'Length + 1);
+      Mode : constant String := "rt" & NUL;
+   begin
+      N_Filename (1 .. Filename'Length) := Filename;
+      N_Filename (N_Filename'Last) := NUL;
+      Sdf_Stream := fopen (N_Filename'Address, Mode'Address);
+      if Sdf_Stream = NULL_Stream then
+         Error_C ("cannot open SDF file '");
+         Error_C (Filename);
+         Error_E ("'");
+         return False;
+      end if;
+      Sdf_Context := new Sdf_Context_Type;
+
+      Sdf_Context.Version := Sdf_Version_Unknown;
+
+      --  Set the timescale to 1 ns.
+      Sdf_Context.Timescale := 1000;
+
+      Buf := new String (1 .. Buf_Size);
+      Buf_Len := 1;
+      Buf (1) := EOT;
+      Sdf_Line := 1;
+      Sdf_Filename := new String'(Filename);
+      Pos := 1;
+      Line_Start := 1;
+      return True;
+   end Open_Sdf;
+
+   procedure Close_Sdf
+   is
+   begin
+      fclose (Sdf_Stream);
+      Sdf_Stream := NULL_Stream;
+      Unchecked_Deallocation (Sdf_Context);
+      Unchecked_Deallocation (Buf);
+   end Close_Sdf;
+
+   procedure Read_Sdf
+   is
+      Res : size_t;
+   begin
+      Res := fread (Buf (Pos)'Address, 1, size_t (Read_Size), Sdf_Stream);
+      Line_Start := Line_Start - Buf_Len + Pos;
+      Buf_Len := Pos + Natural (Res);
+      Buf (Buf_Len) := EOT;
+   end Read_Sdf;
+
+
+   Ident_Start : Natural;
+   Ident_End : Natural;
+
+   procedure Read_Append
+   is
+      Len : Natural;
+   begin
+      Len := Pos - Ident_Start;
+      if Ident_Start = 1 or Len >= 1024 then
+         Error_C ("SDF line ");
+         Error_C (Sdf_Line);
+         Error_E (" is too long");
+         return;
+      end if;
+      Buf (1 .. Len) := Buf (Ident_Start .. Ident_Start + Len - 1);
+      Pos := Len + 1;
+      Ident_Start := 1;
+      Read_Sdf;
+   end Read_Append;
+
+   procedure Error_Sdf (Msg : String) is
+   begin
+      Error_C (Sdf_Filename.all);
+      Error_C (":");
+      Error_C (Sdf_Line);
+      Error_C (":");
+      Error_C (Pos - Line_Start);
+      Error_C (": ");
+      Error_E (Msg);
+   end Error_Sdf;
+
+   procedure Error_Bad_Character is
+   begin
+      Error_Sdf ("bad character in SDF file");
+   end Error_Bad_Character;
+
+   procedure Scan_Identifier
+   is
+   begin
+      Ident_Start := Pos;
+      loop
+         Pos := Pos + 1;
+         case Buf (Pos) is
+            when 'a' .. 'z'
+              | 'A' .. 'Z'
+              | '0' .. '9'
+              | '_' =>
+               null;
+            when '\' =>
+               Error_Sdf ("escape character not handled");
+               Ident_End := Pos - 1;
+               return;
+            when EOT =>
+               Read_Append;
+               Pos := Pos - 1;
+            when others =>
+               Ident_End := Pos - 1;
+               return;
+         end case;
+      end loop;
+   end Scan_Identifier;
+
+   function Ident_Length return Natural is
+   begin
+      return Ident_End - Ident_Start + 1;
+   end Ident_Length;
+
+   function Is_Ident (Str : String) return Boolean
+   is
+   begin
+      if Ident_Length /= Str'Length then
+         return False;
+      end if;
+      return Buf (Ident_Start .. Ident_End) = Str;
+   end Is_Ident;
+
+   procedure Scan_Qstring
+   is
+   begin
+      Ident_Start := Pos + 1;
+      loop
+         Pos := Pos + 1;
+         case Buf (Pos) is
+            when EOT =>
+               Read_Append;
+            when NUL .. Character'Val (3)
+              | Character'Val (5) .. Character'Val (31)
+              | Character'Val (127) .. Character'Val (255) =>
+               Error_Bad_Character;
+            when ' '
+              | '!'
+              | '#' .. '~' =>
+               null;
+            when '"' => -- "
+               Ident_End := Pos - 1;
+               Pos := Pos + 1;
+               exit;
+         end case;
+      end loop;
+   end Scan_Qstring;
+
+   Scan_Int : Integer;
+   Scan_Exp : Integer;
+
+   function Scan_Number return Sdf_Token_Type
+   is
+      Has_Dot : Boolean;
+   begin
+      Has_Dot := False;
+      Scan_Int := 0;
+      Scan_Exp := 0;
+      loop
+         case Buf (Pos) is
+            when '0' .. '9' =>
+               Scan_Int := Scan_Int * 10
+                 + Character'Pos (Buf (Pos)) - Character'Pos ('0');
+               if Has_Dot then
+                  Scan_Exp := Scan_Exp - 1;
+               end if;
+               Pos := Pos + 1;
+            when '.' =>
+               if Has_Dot then
+                  Error_Bad_Character;
+                  return Tok_Error;
+               else
+                  Has_Dot := True;
+               end if;
+               Pos := Pos + 1;
+            when EOT =>
+               if Pos /= Buf_Len then
+                  Error_Bad_Character;
+                  return Tok_Error;
+               end if;
+               Pos := 1;
+               Read_Sdf;
+               exit when Buf_Len = 1;
+            when others =>
+               exit;
+         end case;
+      end loop;
+      if Has_Dot then
+         return Tok_Rnumber;
+      else
+         return Tok_Dnumber;
+      end if;
+   end Scan_Number;
+
+   procedure Refill_Buf is
+   begin
+      Buf (1 .. Buf_Len - Pos) := Buf (Pos .. Buf_Len - 1);
+      Pos := Buf_Len - Pos + 1;
+      Read_Sdf;
+      Pos := 1;
+   end Refill_Buf;
+
+   function Get_Token return Sdf_Token_Type
+   is
+      use Ada.Characters.Latin_1;
+   begin
+      --  Fast blanks skipping.
+      while Buf (Pos) = ' ' loop
+         Pos := Pos + 1;
+      end loop;
+
+      loop
+         --  Be sure there is at least 4 characters.
+         if Pos + 4 >= Buf_Len then
+            Refill_Buf;
+         end if;
+
+         case Buf (Pos) is
+            when EOT =>
+               if Pos /= Buf_Len then
+                  Error_Bad_Character;
+                  return Tok_Error;
+               end if;
+               Pos := 1;
+               Read_Sdf;
+               if Buf_Len = 1 then
+                  return Tok_Eof;
+               end if;
+            when LF =>
+               Pos := Pos + 1;
+               if Buf (Pos) = CR then
+                  Pos := Pos + 1;
+               end if;
+               Line_Start := Pos;
+               Sdf_Line := Sdf_Line + 1;
+            when CR =>
+               Pos := Pos + 1;
+               if Buf (Pos) = LF then
+                  Pos := Pos + 1;
+               end if;
+               Line_Start := Pos;
+               Sdf_Line := Sdf_Line + 1;
+            when '"' => -- "
+               Scan_Qstring;
+               return Tok_Qstring;
+            when ' '
+              | HT =>
+               Pos := Pos + 1;
+            when '/' =>
+               Pos := Pos + 1;
+               return Tok_Div;
+            when '.' =>
+               Pos := Pos + 1;
+               return Tok_Dot;
+            when ':' =>
+               Pos := Pos + 1;
+               return Tok_Cln;
+            when '(' =>
+               Pos := Pos + 1;
+               return Tok_Oparen;
+            when ')' =>
+               Pos := Pos + 1;
+               return Tok_Cparen;
+            when 'a' .. 'z'
+              | 'A' .. 'Z' =>
+               Scan_Identifier;
+               return Tok_Identifier;
+            when '0' .. '9' =>
+               return Scan_Number;
+            when others =>
+               Error_Bad_Character;
+               return Tok_Error;
+         end case;
+      end loop;
+   end Get_Token;
+
+   function Is_White_Space (C : Character) return Boolean
+   is
+      use Ada.Characters.Latin_1;
+   begin
+      case C is
+         when ' '
+           | HT
+           | CR
+           | LF =>
+            return True;
+         when others =>
+            return False;
+      end case;
+   end Is_White_Space;
+
+   function Get_Edge_Token return Edge_Type
+   is
+      use Ada.Characters.Latin_1;
+   begin
+      loop
+         --  Be sure there is at least 4 characters.
+         if Pos + 4 >= Buf_Len then
+            Refill_Buf;
+         end if;
+
+         case Buf (Pos) is
+            when EOT =>
+               if Pos /= Buf_Len then
+                  exit;
+               end if;
+               Pos := 1;
+               Read_Sdf;
+               if Buf_Len = 1 then
+                  exit;
+               end if;
+            when LF =>
+               Pos := Pos + 1;
+               if Buf (Pos) = CR then
+                  Pos := Pos + 1;
+               end if;
+               Line_Start := Pos;
+               Sdf_Line := Sdf_Line + 1;
+            when CR =>
+               Pos := Pos + 1;
+               if Buf (Pos) = LF then
+                  Pos := Pos + 1;
+               end if;
+               Line_Start := Pos;
+               Sdf_Line := Sdf_Line + 1;
+            when ' '
+              | HT =>
+               Pos := Pos + 1;
+            when '0' =>
+               if Is_White_Space (Buf (Pos + 2)) then
+                  if Buf (Pos + 1) = 'z' then
+                     Pos := Pos + 2;
+                     return Edge_0z;
+                  elsif Buf (Pos + 1) = '1' then
+                     Pos := Pos + 2;
+                     return Edge_01;
+                  end if;
+               end if;
+               exit;
+            when '1' =>
+               if Is_White_Space (Buf (Pos + 2)) then
+                  if Buf (Pos + 1) = 'z' then
+                     Pos := Pos + 2;
+                     return Edge_1z;
+                  elsif Buf (Pos + 1) = '0' then
+                     Pos := Pos + 2;
+                     return Edge_10;
+                  end if;
+               end if;
+               exit;
+            when 'z' =>
+               if Is_White_Space (Buf (Pos + 2)) then
+                  if Buf (Pos + 1) = '0' then
+                     Pos := Pos + 2;
+                     return Edge_Z0;
+                  elsif Buf (Pos + 1) = '1' then
+                     Pos := Pos + 2;
+                     return Edge_Z1;
+                  end if;
+               end if;
+               exit;
+            when 'p' =>
+               Scan_Identifier;
+               if Is_Ident ("posedge") then
+                  return Edge_Posedge;
+               else
+                  exit;
+               end if;
+            when 'n' =>
+               Scan_Identifier;
+               if Is_Ident ("negedge") then
+                  return Edge_Negedge;
+               else
+                  exit;
+               end if;
+            when others =>
+               exit;
+         end case;
+      end loop;
+      Error_Sdf ("edge_identifier expected");
+      return Edge_Error;
+   end Get_Edge_Token;
+
+   procedure Error_Sdf (Tok : Sdf_Token_Type)
+   is
+   begin
+      case Tok is
+         when Tok_Qstring =>
+            Error_Sdf ("qstring expected");
+         when Tok_Oparen =>
+            Error_Sdf ("'(' expected");
+         when Tok_Identifier =>
+            Error_Sdf ("identifier expected");
+         when Tok_Cln =>
+            Error_Sdf ("':' (colon) expected");
+         when others =>
+            Error_Sdf ("parse error");
+      end case;
+   end Error_Sdf;
+
+   function Expect (Tok : Sdf_Token_Type) return Boolean
+   is
+   begin
+      if Get_Token = Tok then
+         return True;
+      end if;
+      Error_Sdf (Tok);
+      return False;
+   end Expect;
+
+   function Expect_Cp_Op_Ident (Tok : Sdf_Token_Type) return Boolean
+   is
+   begin
+      if Tok /= Tok_Cparen then
+         Error_Sdf (Tok_Cparen);
+         return False;
+      end if;
+      if not Expect (Tok_Oparen)
+        or else not Expect (Tok_Identifier)
+      then
+         return False;
+      end if;
+      return True;
+   end Expect_Cp_Op_Ident;
+
+   function Expect_Qstr_Cp_Op_Ident (Str : String) return Boolean
+   is
+      Tok : Sdf_Token_Type;
+   begin
+      if not Is_Ident (Str) then
+         return True;
+      end if;
+
+      Tok := Get_Token;
+      if Tok = Tok_Qstring then
+         Tok := Get_Token;
+      end if;
+
+      return Expect_Cp_Op_Ident (Tok);
+   end Expect_Qstr_Cp_Op_Ident;
+
+   procedure Start_Generic_Name (Kind : Timing_Generic_Kind) is
+   begin
+      Sdf_Context.Kind := Kind;
+      Sdf_Context.Port_Num := 0;
+      Sdf_Context.Ports (1).Edge := Edge_None;
+      Sdf_Context.Ports (2).Edge := Edge_None;
+   end Start_Generic_Name;
+
+   --  Status of a parsing.
+   --  ERROR: parse error (syntax is not correct)
+   --  OPTIONAL: the construct is absent.
+   --  FOUND: the construct is present.
+   --  SET: the construct is present and a value was extracted from.
+   type Parse_Status_Type is
+     (
+      Status_Error,
+      Status_Altern,
+      Status_Optional,
+      Status_Found,
+      Status_Set
+     );
+
+   function Num_To_Time return Ghdl_I64
+   is
+      Res : Ghdl_I64;
+   begin
+      Res := Ghdl_I64 (Scan_Int) * Ghdl_I64 (Sdf_Context.Timescale);
+      while Scan_Exp < 0 loop
+         Res := Res / 10;
+         Scan_Exp := Scan_Exp + 1;
+      end loop;
+      return Res;
+   end Num_To_Time;
+
+   --  Parse: REXPRESSION? ')'
+   procedure Parse_Rexpression
+     (Status : out Parse_Status_Type; Val : out Ghdl_I64)
+   is
+      Tok : Sdf_Token_Type;
+
+      procedure Pr_Rnumber (Mtm : Mtm_Type)
+      is
+      begin
+         if Tok = Tok_Rnumber or Tok = Tok_Dnumber then
+            if Mtm = Sdf_Mtm then
+               Val := Num_To_Time;
+               Status := Status_Set;
+            elsif Status /= Status_Set then
+               Status := Status_Found;
+            end if;
+            Tok := Get_Token;
+         end if;
+      end Pr_Rnumber;
+
+      function Pr_Colon return Boolean
+      is
+      begin
+         if Tok /= Tok_Cln then
+            Error_Sdf (Tok_Cln);
+            Status := Status_Error;
+            return False;
+         else
+            Tok := Get_Token;
+            return True;
+         end if;
+      end Pr_Colon;
+
+   begin
+      Val := 0;
+      Tok := Get_Token;
+      Status := Status_Error;
+      if Tok = Tok_Cparen then
+         Status := Status_Optional;
+         return;
+      end if;
+
+      Pr_Rnumber (Minimum);
+
+      if not Pr_Colon then
+         return;
+      end if;
+
+      Pr_Rnumber (Typical);
+
+      if not Pr_Colon then
+         return;
+      end if;
+
+      Pr_Rnumber (Maximum);
+
+      if Status = Status_Error then
+         Error_Sdf ("at least one number required in an rexpression");
+         return;
+      end if;
+
+      if Tok /= Tok_Cparen then
+         Error_Sdf (Tok_Cparen);
+         Status := Status_Error;
+      end if;
+   end Parse_Rexpression;
+
+   function Expect_Rexpr_Cp_Op_Ident return Boolean
+   is
+      Status : Parse_Status_Type;
+      Val : Ghdl_I64;
+   begin
+      Parse_Rexpression (Status, Val);
+      if Status = Status_Error then
+         return False;
+      end if;
+      if not Expect (Tok_Oparen)
+        or else not Expect (Tok_Identifier)
+      then
+         Error_Sdf (Tok_Identifier);
+         return False;
+      end if;
+      return True;
+   end Expect_Rexpr_Cp_Op_Ident;
+
+   function To_Lower (C : Character) return Character is
+   begin
+      if C >= 'A' and C <= 'Z' then
+         return Character'Val (Character'Pos (C)
+                               - Character'Pos ('A') + Character'Pos ('a'));
+      else
+         return C;
+      end if;
+   end To_Lower;
+
+   function Parse_Port_Path1 (Tok : Sdf_Token_Type) return Boolean
+   is
+      Port_Spec : Port_Spec_Type
+         renames Sdf_Context.Ports (Sdf_Context.Port_Num);
+      Len : Natural;
+   begin
+      if Tok /= Tok_Identifier then
+         Error_Sdf ("port path expected");
+         return False;
+      end if;
+      Len := 0;
+      for I in Ident_Start .. Ident_End loop
+         Len := Len + 1;
+         Port_Spec.Name (Len) := To_Lower (Buf (I));
+      end loop;
+      Port_Spec.Name_Len := Len;
+      return True;
+   end Parse_Port_Path1;
+
+   function Parse_Port_Path return Boolean
+   is
+   begin
+      Sdf_Context.Port_Num := Sdf_Context.Port_Num + 1;
+      return Parse_Port_Path1 (Get_Token);
+   end Parse_Port_Path;
+
+   function Parse_Port_Spec return Boolean
+   is
+      Tok : Sdf_Token_Type;
+      Edge : Edge_Type;
+   begin
+      Sdf_Context.Port_Num := Sdf_Context.Port_Num + 1;
+      Tok := Get_Token;
+      if Tok = Tok_Identifier then
+         return Parse_Port_Path1 (Tok);
+      elsif Tok /= Tok_Oparen then
+         Error_Sdf ("port spec expected");
+         return False;
+      end if;
+      Edge := Get_Edge_Token;
+      if Edge = Edge_Error then
+         return False;
+      end if;
+      Sdf_Context.Ports (Sdf_Context.Port_Num).Edge := Edge;
+      if not Parse_Port_Path1 (Get_Token) then
+         return False;
+      end if;
+      if Get_Token /= Tok_Cparen then
+         Error_Sdf (Tok_Cparen);
+         return False;
+      end if;
+      return True;
+   end Parse_Port_Spec;
+
+   function Parse_Port_Tchk return Boolean renames Parse_Port_Spec;
+
+   --  tc_rvalue ::= ( RNUMBER )
+   --            ||= ( rexpression )
+   --  Return status_optional for ( )
+   function Parse_Tc_Rvalue return Parse_Status_Type
+   is
+      Tok : Sdf_Token_Type;
+      Res : Parse_Status_Type;
+   begin
+      if Get_Token /= Tok_Oparen then
+         Error_Sdf (Tok_Oparen);
+         return Status_Error;
+      end if;
+      Res := Status_Found;
+      Tok := Get_Token;
+      if Tok = Tok_Rnumber or Tok = Tok_Dnumber then
+         Sdf_Context.Timing (1) := Num_To_Time;
+         Tok := Get_Token;
+         if Tok = Tok_Cparen then
+            --  This is a simple RNUMBER.
+            if Get_Token = Tok_Cparen then
+               return Status_Altern;
+            else
+               Error_Sdf (Tok_Cparen);
+               return Status_Error;
+            end if;
+         end if;
+         if Sdf_Mtm = Minimum then
+            Res := Status_Set;
+         end if;
+      end if;
+      if Tok = Tok_Cparen then
+         return Status_Optional;
+      end if;
+      if Tok /= Tok_Cln then
+         Error_Sdf (Tok_Cln);
+         return Status_Error;
+      end if;
+      Tok := Get_Token;
+      if Tok = Tok_Rnumber or Tok = Tok_Dnumber then
+         if Sdf_Mtm = Typical then
+            Sdf_Context.Timing (1) := Num_To_Time;
+            Res := Status_Set;
+         end if;
+         Tok := Get_Token;
+      end if;
+      if Tok /= Tok_Cln then
+         Error_Sdf (Tok_Cln);
+         return Status_Error;
+      end if;
+      Tok := Get_Token;
+      if Tok = Tok_Rnumber or Tok = Tok_Dnumber then
+         if Sdf_Mtm = Maximum then
+            Sdf_Context.Timing (1) := Num_To_Time;
+            Res := Status_Set;
+         end if;
+         Tok := Get_Token;
+      end if;
+      if Tok /= Tok_Cparen then
+         Error_Sdf (Tok_Cparen);
+         return Status_Error;
+      end if;
+      return Res;
+   end Parse_Tc_Rvalue;
+
+   function Parse_Simple_Tc_Rvalue return Boolean is
+   begin
+      Sdf_Context.Timing_Nbr := 0;
+
+      case Parse_Tc_Rvalue is
+         when Status_Error
+           | Status_Optional =>
+            return False;
+         when Status_Altern =>
+            null;
+         when Status_Found =>
+            Sdf_Context.Timing_Set (1) := False;
+         when Status_Set =>
+            Sdf_Context.Timing_Set (1) := True;
+      end case;
+      return True;
+   end Parse_Simple_Tc_Rvalue;
+
+   --  rvalue ::= ( RNUMBER )
+   --         ||= rexp_list
+   --  Parse: rvalue )
+   function Parse_Rvalue return Boolean
+   is
+      Tok : Sdf_Token_Type;
+   begin
+      Sdf_Context.Timing_Nbr := 0;
+      Sdf_Context.Timing_Set := (others => False);
+
+      case Parse_Tc_Rvalue is
+         when Status_Error =>
+            return False;
+         when Status_Altern =>
+            return True;
+         when Status_Found
+           | Status_Optional =>
+            null;
+         when Status_Set =>
+            Sdf_Context.Timing_Set (1) := True;
+      end case;
+
+      Sdf_Context.Timing_Nbr := 1;
+      loop
+         Tok := Get_Token;
+         exit when Tok = Tok_Cparen;
+         if Tok /= Tok_Oparen then
+            Error_Sdf (Tok_Oparen);
+            return False;
+         end if;
+
+         Sdf_Context.Timing_Nbr := Sdf_Context.Timing_Nbr + 1;
+         declare
+            Status : Parse_Status_Type;
+            Val : Ghdl_I64;
+         begin
+            Parse_Rexpression (Status, Val);
+            case Status is
+               when Status_Error
+                 | Status_Altern =>
+                  return False;
+               when Status_Optional
+                 | Status_Found =>
+                  null;
+               when Status_Set =>
+                  Sdf_Context.Timing_Set (Sdf_Context.Timing_Nbr) := True;
+                  Sdf_Context.Timing (Sdf_Context.Timing_Nbr) := Val;
+            end case;
+         end;
+      end loop;
+      if Boolean'(False) then
+         --  Do not expand here, since the most used is 01.
+         case Sdf_Context.Timing_Nbr is
+            when 1 =>
+               for I in 2 .. 6 loop
+                  Sdf_Context.Timing (I) := Sdf_Context.Timing (1);
+                  Sdf_Context.Timing_Set (I) := Sdf_Context.Timing_Set (1);
+               end loop;
+            when 2 =>
+               for I in 3 .. 4 loop
+                  Sdf_Context.Timing (I) := Sdf_Context.Timing (1);
+                  Sdf_Context.Timing_Set (I) := Sdf_Context.Timing_Set (1);
+               end loop;
+               for I in 5 .. 6 loop
+                  Sdf_Context.Timing (I) := Sdf_Context.Timing (2);
+                  Sdf_Context.Timing_Set (I) := Sdf_Context.Timing_Set (2);
+               end loop;
+            when 3 =>
+               for I in 4 .. 6 loop
+                  Sdf_Context.Timing (I) := Sdf_Context.Timing (I - 3);
+                  Sdf_Context.Timing_Set (I) := Sdf_Context.Timing_Set (I - 3);
+               end loop;
+            when 6
+              | 12 =>
+               null;
+            when others =>
+               Error_Sdf ("bad number of rvalue");
+               return False;
+         end case;
+      end if;
+      return True;
+   end Parse_Rvalue;
+
+   function Handle_Generic return Boolean
+   is
+      Name : String (1 .. 1024);
+      Len : Natural;
+
+      procedure Start (Str : String) is
+      begin
+         Name (1 .. Str'Length) := Str;
+         Len := Str'Length;
+      end Start;
+
+      procedure Add (Str : String)
+      is
+         Nlen : Natural;
+      begin
+         Len := Len + 1;
+         Name (Len) := '_';
+         Nlen := Len + Str'Length;
+         Name (Len + 1 .. Nlen) := Str;
+         Len := Nlen;
+      end Add;
+
+      procedure Add_Edge (Edge : Edge_Type; Force : Boolean) is
+      begin
+         case Edge is
+            when Edge_Posedge =>
+               Add ("posedge");
+            when Edge_Negedge =>
+               Add ("negedge");
+            when Edge_01 =>
+               Add ("01");
+            when Edge_10 =>
+               Add ("10");
+            when Edge_0z =>
+               Add ("0z");
+            when Edge_Z1 =>
+               Add ("Z1");
+            when Edge_1z =>
+               Add ("1z");
+            when Edge_Z0 =>
+               Add ("ZO");
+            when Edge_None =>
+               if Force then
+                  Add ("noedge");
+               end if;
+            when Edge_Error =>
+               Add ("?");
+         end case;
+      end Add_Edge;
+
+      Ok : Boolean;
+   begin
+      case Sdf_Context.Kind is
+         when Delay_Iopath =>
+            Start ("tpd");
+         when Delay_Port =>
+            Start ("tipd");
+         when Timingcheck_Setup =>
+            Start ("tsetup");
+         when Timingcheck_Hold =>
+            Start ("thold");
+         when Timingcheck_Setuphold =>
+            Start ("tsetup");
+         when Timingcheck_Recovery =>
+            Start ("trecovery");
+         when Timingcheck_Skew =>
+            Start ("tskew");
+         when Timingcheck_Width =>
+            Start ("tpw");
+         when Timingcheck_Period =>
+            Start ("tperiod");
+         when Timingcheck_Nochange =>
+            Start ("tncsetup");
+      end case;
+      for I in 1 .. Sdf_Context.Port_Num loop
+         Add (Sdf_Context.Ports (I).Name
+              (1 .. Sdf_Context.Ports (I).Name_Len));
+      end loop;
+      if Sdf_Context.Kind in Timing_Generic_Full_Condition then
+         Add_Edge (Sdf_Context.Ports (1).Edge, True);
+         Add_Edge (Sdf_Context.Ports (2).Edge, False);
+      elsif Sdf_Context.Kind in Timing_Generic_Simple_Condition then
+         Add_Edge (Sdf_Context.Ports (1).Edge, False);
+      end if;
+      Vital_Annotate.Sdf_Generic (Sdf_Context.all, Name (1 .. Len), Ok);
+      if not Ok then
+         Error_Sdf ("could not annotate generic");
+         return False;
+      end if;
+      return True;
+   end Handle_Generic;
+
+   function Parse_Sdf return Boolean
+   is
+      Tok : Sdf_Token_Type;
+      Ok : Boolean;
+   begin
+      if Get_Token /= Tok_Oparen
+        or else Get_Token /= Tok_Identifier
+        or else not Is_Ident ("DELAYFILE")
+        or else Get_Token /= Tok_Oparen
+        or else Get_Token /= Tok_Identifier
+      then
+         Error_Sdf ("not an SDF file");
+         return False;
+      end if;
+
+      if Is_Ident ("SDFVERSION") then
+         Tok := Get_Token;
+         if Tok = Tok_Qstring then
+            Sdf_Context.Version := Sdf_Version_Bad;
+            if Ident_Length = 3 and then Buf (Ident_Start + 1) = '.' then
+               --  Version has the format '"X.Y"' (without simple quote).
+               if Buf (Ident_Start) = '2'
+                 and then Buf (Ident_Start + 2) = '1'
+               then
+                  Sdf_Context.Version := Sdf_2_1;
+               end if;
+            end if;
+            Tok := Get_Token;
+         end if;
+
+         if not Expect_Cp_Op_Ident (Tok) then
+            return False;
+         end if;
+      end if;
+
+      if not Expect_Qstr_Cp_Op_Ident ("DESIGN") then
+         return False;
+      end if;
+
+      if not Expect_Qstr_Cp_Op_Ident ("DATE") then
+         return False;
+      end if;
+
+      if not Expect_Qstr_Cp_Op_Ident ("VENDOR") then
+         return False;
+      end if;
+
+      if not Expect_Qstr_Cp_Op_Ident ("PROGRAM") then
+         return False;
+      end if;
+
+      if not Expect_Qstr_Cp_Op_Ident ("VERSION") then
+         return False;
+      end if;
+
+      if Is_Ident ("DIVIDER") then
+         Tok := Get_Token;
+         if Tok = Tok_Div or Tok = Tok_Dot then
+            Tok := Get_Token;
+         end if;
+         if not Expect_Cp_Op_Ident (Tok) then
+            return False;
+         end if;
+      end if;
+
+      if Is_Ident ("VOLTAGE") then
+         if not Expect_Rexpr_Cp_Op_Ident then
+            return False;
+         end if;
+      end if;
+
+      if not Expect_Qstr_Cp_Op_Ident ("PROCESS") then
+         return False;
+      end if;
+
+      if Is_Ident ("TEMPERATURE") then
+         if not Expect_Rexpr_Cp_Op_Ident then
+            return False;
+         end if;
+      end if;
+
+      if Is_Ident ("TIMESCALE") then
+         Tok := Get_Token;
+         if Tok = Tok_Rnumber or Tok = Tok_Dnumber then
+            if Scan_Exp = 0 and (Scan_Int = 1
+                                 or Scan_Int = 10
+                                 or Scan_Int = 100)
+            then
+               Sdf_Context.Timescale := Scan_Int;
+            else
+               Error_Sdf ("bad timescale value");
+               return False;
+            end if;
+            Tok := Get_Token;
+            if Tok /= Tok_Identifier then
+               Error_Sdf (Tok_Identifier);
+            end if;
+            if Is_Ident ("ps") then
+               null;
+            elsif Is_Ident ("ns") then
+               Sdf_Context.Timescale := Sdf_Context.Timescale * 1000;
+            elsif Is_Ident ("us") then
+               Sdf_Context.Timescale := Sdf_Context.Timescale * 1000_000;
+            else
+               Error_Sdf ("bad timescale unit");
+               return False;
+            end if;
+            Tok := Get_Token;
+         end if;
+         if not Expect_Cp_Op_Ident (Tok) then
+            return False;
+         end if;
+      end if;
+
+      Vital_Annotate.Sdf_Header (Sdf_Context.all);
+
+      --  Parse cell+
+      loop
+         if not Is_Ident ("CELL") then
+            Error_Sdf ("CELL expected");
+            return False;
+         end if;
+         --  Parse celltype
+         if Get_Token /= Tok_Oparen
+           or else Get_Token /= Tok_Identifier
+           or else not Is_Ident ("CELLTYPE")
+           or else Get_Token /= Tok_Qstring
+         then
+            Error_Sdf ("CELLTYPE expected");
+            return False;
+         end if;
+         Sdf_Context.Celltype_Len := Ident_Length;
+         if Sdf_Context.Celltype_Len > Sdf_Context.Celltype'Length then
+            Error_Sdf ("CELLTYPE qstring is too long");
+            return False;
+         end if;
+         for I in Ident_Start .. Ident_End loop
+            Sdf_Context.Celltype (I - Ident_Start + 1) := To_Lower (Buf (I));
+         end loop;
+         Vital_Annotate.Sdf_Celltype (Sdf_Context.all);
+         if Get_Token /= Tok_Cparen
+           or else Get_Token /= Tok_Oparen
+           or else Get_Token /= Tok_Identifier
+           or else not Is_Ident ("INSTANCE")
+         then
+            Error_Sdf ("INSTANCE expected");
+            return False;
+         end if;
+         --  Parse instance+
+         loop
+            exit when not Is_Ident ("INSTANCE");
+            Tok := Get_Token;
+            if Tok /= Tok_Cparen then
+               if Tok /= Tok_Identifier then
+                  Error_Sdf ("instance identifier expected");
+                  return False;
+               end if;
+               for I in Ident_Start .. Ident_End loop
+                  Buf (I) := To_Lower (Buf (I));
+               end loop;
+               Vital_Annotate.Sdf_Instance
+                 (Sdf_Context.all, Buf (Ident_Start .. Ident_End), Ok);
+               if not Ok then
+                  Error_Sdf ("cannot find instance");
+                  return False;
+               end if;
+               Tok := Get_Token;
+            end if;
+            if Tok /= Tok_Cparen
+              or else Get_Token /= Tok_Oparen
+              or else Get_Token /= Tok_Identifier
+            then
+               Error_Sdf ("instance or timing_spec expected");
+               return False;
+            end if;
+         end loop;
+         Vital_Annotate.Sdf_Instance_End (Sdf_Context.all, Ok);
+         if not Ok then
+            Error_Sdf ("bad instance or celltype mistmatch");
+            return False;
+         end if;
+
+         --  Parse timing_spec+
+         loop
+            if Is_Ident ("DELAY") then
+               --  Parse deltype+
+               Tok := Get_Token;
+               loop
+                  if Tok /= Tok_Oparen
+                    or else Get_Token /= Tok_Identifier
+                  then
+                     Error_Sdf ("deltype expected");
+                     return False;
+                  end if;
+                  if Is_Ident ("PATHPULSE")
+                    or else Is_Ident ("GLOBALPATHPULSE")
+                  then
+                     Error_Sdf ("PATHPULSE and GLOBALPATHPULSE not allowed");
+                     return False;
+                  end if;
+                  if Is_Ident ("ABSOLUTE") then
+                     null;
+                  elsif Is_Ident ("INCREMENT") then
+                     null;
+                  else
+                     Error_Sdf ("ABSOLUTE or INCREMENT expected");
+                     return False;
+                  end if;
+                  --  Parse absvals+ or incvals+
+                  Tok := Get_Token;
+                  loop
+                     if Tok /= Tok_Oparen
+                       or else Get_Token /= Tok_Identifier
+                     then
+                        Error_Sdf ("absvals or incvals expected");
+                        return False;
+                     end if;
+                     if Is_Ident ("IOPATH") then
+                        Start_Generic_Name (Delay_Iopath);
+                        if not Parse_Port_Spec
+                          or else not Parse_Port_Path
+                          or else not Parse_Rvalue
+                        then
+                           return False;
+                        end if;
+                     elsif Is_Ident ("PORT") then
+                        Start_Generic_Name (Delay_Port);
+                        if not Parse_Port_Path
+                          or else not Parse_Rvalue
+                        then
+                           return False;
+                        end if;
+                     elsif Is_Ident ("COND")
+                       or else Is_Ident ("INTERCONNECT")
+                       or else Is_Ident ("DEVICE")
+                     then
+                        Error_Sdf
+                          ("COND, INTERCONNECT, or DEVICE not handled");
+                        return False;
+                     elsif Is_Ident ("NETDELAY") then
+                        Error_Sdf ("NETDELAY not allowed in VITAL SDF");
+                        return False;
+                     else
+                        Error_Sdf ("absvals or incvals expected");
+                        return False;
+                     end if;
+
+                     if not Handle_Generic then
+                        return False;
+                     end if;
+
+                     Tok := Get_Token;
+                     exit when Tok = Tok_Cparen;
+                  end loop;
+                  Tok := Get_Token;
+                  exit when Tok = Tok_Cparen;
+               end loop;
+            elsif Is_Ident ("TIMINGCHECK") then
+               --  parse tc_def+
+               Tok := Get_Token;
+               loop
+                  if Tok /= Tok_Oparen
+                    or else Get_Token /= Tok_Identifier
+                  then
+                     Error_Sdf ("tc_def expected");
+                     return False;
+                  end if;
+                  if Is_Ident ("SETUP") then
+                     Start_Generic_Name (Timingcheck_Setup);
+                  elsif Is_Ident ("HOLD") then
+                     Start_Generic_Name (Timingcheck_Hold);
+                  elsif Is_Ident ("SETUPHOLD") then
+                     Start_Generic_Name (Timingcheck_Setuphold);
+                  elsif Is_Ident ("RECOVERY") then
+                     Start_Generic_Name (Timingcheck_Recovery);
+                  elsif Is_Ident ("SKEW") then
+                     Start_Generic_Name (Timingcheck_Skew);
+                  elsif Is_Ident ("WIDTH") then
+                     Start_Generic_Name (Timingcheck_Width);
+                  elsif Is_Ident ("PERIOD") then
+                     Start_Generic_Name (Timingcheck_Period);
+                  elsif Is_Ident ("NOCHANGE") then
+                     Start_Generic_Name (Timingcheck_Nochange);
+                  elsif Is_Ident ("PATHCONSTRAINT")
+                    or else Is_Ident ("SUM")
+                    or else Is_Ident ("DIFF")
+                    or else Is_Ident ("SKEWCONSTRAINT")
+                  then
+                     Error_Sdf ("non-VITAL tc_def");
+                     return False;
+                  else
+                     Error_Sdf ("bad tc_def");
+                     return False;
+                  end if;
+
+                  case Sdf_Context.Kind is
+                     when Timingcheck_Setup
+                       | Timingcheck_Hold
+                       | Timingcheck_Recovery
+                       | Timingcheck_Skew
+                       | Timingcheck_Setuphold
+                       | Timingcheck_Nochange =>
+                        if not Parse_Port_Tchk
+                          or else not Parse_Port_Tchk
+                          or else not Parse_Simple_Tc_Rvalue
+                        then
+                           return False;
+                        end if;
+                     when Timingcheck_Width
+                       | Timingcheck_Period =>
+                        if not Parse_Port_Tchk
+                          or else not Parse_Simple_Tc_Rvalue
+                        then
+                           return False;
+                        end if;
+                     when others =>
+                        Internal_Error ("sdf_parse");
+                  end case;
+
+                  if not Handle_Generic then
+                     return False;
+                  end if;
+
+                  case Sdf_Context.Kind is
+                     when Timingcheck_Setuphold
+                       | Timingcheck_Nochange =>
+                        if not Parse_Simple_Tc_Rvalue then
+                           return False;
+                        end if;
+                        Error_Sdf ("setuphold and nochange not yet handled");
+                        return False;
+                     when others =>
+                        null;
+                  end case;
+
+                  if Get_Token /= Tok_Cparen then
+                     Error_Sdf (Tok_Cparen);
+                     return False;
+                  end if;
+                  Tok := Get_Token;
+                  exit when Tok = Tok_Cparen;
+               end loop;
+            end if;
+            Tok := Get_Token;
+            exit when Tok = Tok_Cparen;
+            if Tok /= Tok_Oparen then
+               Error_Sdf (Tok_Oparen);
+               return False;
+            end if;
+            if Get_Token /= Tok_Identifier then
+               Error_Sdf (Tok_Identifier);
+               return False;
+            end if;
+         end loop;
+         Tok := Get_Token;
+         exit when Tok = Tok_Cparen;
+         if Tok /= Tok_Oparen
+           or else Get_Token /= Tok_Identifier
+         then
+            Error_Sdf (Tok_Identifier);
+         end if;
+      end loop;
+      if Get_Token /= Tok_Eof then
+         Error_Sdf ("EOF expected");
+         return False;
+      end if;
+      return True;
+   end Parse_Sdf;
+
+   function Parse_Sdf_File (Filename : String) return Boolean
+   is
+      Res : Boolean;
+   begin
+      if not Open_Sdf (Filename) then
+         return False;
+      end if;
+      Res := Parse_Sdf;
+      Close_Sdf;
+      return Res;
+   end Parse_Sdf_File;
+
+end Grt.Sdf;
diff --git a/translate/grt/grt-sdf.ads b/translate/grt/grt-sdf.ads
new file mode 100644
index 000000000..9e2477656
--- /dev/null
+++ b/translate/grt/grt-sdf.ads
@@ -0,0 +1,113 @@
+--  GHDL Run Time (GRT) - SDF parser.
+--  Copyright (C) 2002, 2003, 2004, 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 Grt.Sdf is
+   type Edge_Type is
+     (
+      Edge_Error,
+      Edge_None,
+      Edge_Posedge,
+      Edge_Negedge,
+      Edge_01,
+      Edge_10,
+      Edge_0z,
+      Edge_Z1,
+      Edge_1z,
+      Edge_Z0
+     );
+
+   type Timing_Generic_Kind is
+     (
+      Delay_Port,
+      --Delay_Interconnect,
+      --Delay_Device,
+
+      --  Simple condition
+      Delay_Iopath,
+      Timingcheck_Width,
+      Timingcheck_Period,
+
+      --  Full condition
+      Timingcheck_Setup,
+      Timingcheck_Hold,
+      Timingcheck_Recovery,
+      Timingcheck_Skew,
+      Timingcheck_Nochange,
+      Timingcheck_Setuphold
+     );
+
+   subtype Timing_Generic_Simple_Condition is Timing_Generic_Kind
+     range Delay_Iopath .. Timingcheck_Period;
+
+   subtype Timing_Generic_Full_Condition is Timing_Generic_Kind
+     range Timingcheck_Setup .. Timingcheck_Setuphold;
+
+   type Sdf_Version_Type is
+     (
+      Sdf_2_1,
+      Sdf_Version_Unknown,
+      Sdf_Version_Bad
+     );
+
+   Read_Size : constant Natural := 4096;
+   Buf_Size : constant Natural := Read_Size + 1024 + 1;
+
+   type Port_Spec_Type is record
+      Name : String (1 .. 1024);
+      Name_Len : Natural;
+   -- Cond : String (1 .. 1024);
+   -- Cond_Len : Natural;
+      Edge : Edge_Type;
+   end record;
+
+   type Port_Spec_Array_Type is array (Natural range <>) of Port_Spec_Type;
+
+   type Ghdl_I64_Array is array (1 .. 12) of Ghdl_I64;
+   type Boolean_Array is array (1 .. 12) of Boolean;
+
+   type Sdf_Context_Type is record
+      --  Version of the SDF file.
+      Version : Sdf_Version_Type;
+
+      --  Timescale; 1 corresponds to 1 ps.
+      --  Default is 1000 (1 ns).
+      Timescale : Natural;
+
+      Kind : Timing_Generic_Kind;
+
+      --  Cell type.
+      Celltype : String (1 .. 128);
+      Celltype_Len : Natural;
+
+      --  Current port.
+      Port_Num : Natural;
+      Ports : Port_Spec_Array_Type (1 .. 2);
+
+      --  timing spec.
+      Timing : Ghdl_I64_Array;
+      Timing_Set : Boolean_Array;
+      Timing_Nbr : Natural;
+   end record;
+
+   --  Which value is extracted.
+   type Mtm_Type is (Minimum, Typical, Maximum);
+   Sdf_Mtm : Mtm_Type := Typical;
+
+   function Parse_Sdf_File (Filename : String) return Boolean;
+end Grt.Sdf;
diff --git a/translate/grt/grt-shadow_ieee.adb b/translate/grt/grt-shadow_ieee.adb
new file mode 100644
index 000000000..cefd2d2a2
--- /dev/null
+++ b/translate/grt/grt-shadow_ieee.adb
@@ -0,0 +1,25 @@
+--  GHDL Run Time (GRT) - ghost declarations for ieee.
+--  Copyright (C) 2002, 2003, 2004, 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.Errors; use Grt.Errors;
+
+package body Grt.Shadow_Ieee is
+   procedure Ieee_Std_Logic_1164_Resolved_RESOLV is
+   begin
+      Internal_Error ("resolved_RESOLV from shadow ieee called");
+   end Ieee_Std_Logic_1164_Resolved_RESOLV;
+end Grt.Shadow_Ieee;
diff --git a/translate/grt/grt-shadow_ieee.ads b/translate/grt/grt-shadow_ieee.ads
new file mode 100644
index 000000000..7433ca16a
--- /dev/null
+++ b/translate/grt/grt-shadow_ieee.ads
@@ -0,0 +1,34 @@
+--  GHDL Run Time (GRT) - ghost declarations for ieee.
+--  Copyright (C) 2002, 2003, 2004, 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.
+
+--  This packages provides dummy declaration for main IEEE.STD_LOGIC_1164
+--  type descriptors.
+--  The package must not have elaboration code, since the actual type
+--  descriptors are not writable (they are constant).  Making it preelaborated
+--  is not enough, the variables must be initialized.  This current
+--  implementation provides bad values; this is not a problem since they are
+--  not read in grt.
+
+package Grt.Shadow_Ieee is
+   pragma Preelaborate (Grt.Shadow_Ieee);
+
+   procedure Ieee_Std_Logic_1164_Resolved_RESOLV;
+private
+   pragma Export (C, Ieee_Std_Logic_1164_Resolved_RESOLV,
+                  "ieee__std_logic_1164__resolved_RESOLV");
+end Grt.Shadow_Ieee;
diff --git a/translate/grt/grt-signals.adb b/translate/grt/grt-signals.adb
new file mode 100644
index 000000000..9ed8a3227
--- /dev/null
+++ b/translate/grt/grt-signals.adb
@@ -0,0 +1,2949 @@
+--  GHDL Run Time (GRT) - signals management.
+--  Copyright (C) 2002, 2003, 2004, 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; use System;
+with Ada.Unchecked_Deallocation;
+with Ada.Unchecked_Conversion;
+with Grt.Errors; use Grt.Errors;
+with Grt.Processes; use Grt.Processes;
+with Grt.Options; use Grt.Options;
+with Grt.Rtis_Types; use Grt.Rtis_Types;
+with Grt.Disp_Signals;
+with Grt.Astdio;
+with Grt.Stdio;
+
+package body Grt.Signals is
+   function Is_Signal_Guarded (Sig : Ghdl_Signal_Ptr) return Boolean
+   is
+   begin
+      return (Sig.Rti.Common.Mode and Ghdl_Rti_Signal_Kind_Mask)
+        /= Ghdl_Rti_Signal_Kind_No;
+   end Is_Signal_Guarded;
+
+   Sig_Rti : Ghdl_Rtin_Object_Acc;
+   Last_Implicit_Signal : Ghdl_Signal_Ptr;
+   Current_Resolv : Resolved_Signal_Acc := null;
+
+   function Get_Current_Mode_Signal return Mode_Signal_Type
+   is
+   begin
+      return Mode_Signal_Type'Val
+        (Sig_Rti.Common.Mode and Ghdl_Rti_Signal_Mode_Mask);
+   end Get_Current_Mode_Signal;
+
+
+   procedure Ghdl_Signal_Name_Rti (Sig : Ghdl_Rti_Access;
+                                   Ctxt : Ghdl_Rti_Access;
+                                   Addr : Address)
+   is
+      pragma Unreferenced (Ctxt);
+      pragma Unreferenced (Addr);
+   begin
+      Sig_Rti := To_Ghdl_Rtin_Object_Acc (Sig);
+   end Ghdl_Signal_Name_Rti;
+
+   function To_Address is new Ada.Unchecked_Conversion
+     (Source => Ghdl_Signal_Ptr, Target => Address);
+
+   function Create_Signal
+     (Mode : Mode_Type;
+      Init_Val : Value_Union;
+      Mode_Sig : Mode_Signal_Type;
+      Resolv_Proc : System.Address;
+      Resolv_Inst : System.Address)
+     return Ghdl_Signal_Ptr
+   is
+      Res : Ghdl_Signal_Ptr;
+      Resolv : Resolved_Signal_Acc;
+      S : Ghdl_Signal_Data (Mode_Sig);
+   begin
+      Sig_Table.Increment_Last;
+
+      if Current_Resolv = null then
+         if Resolv_Proc /= Null_Address then
+            Resolv := new Resolved_Signal_Type'
+              (Resolv_Proc => Resolv_Proc,
+               Resolv_Inst => Resolv_Inst,
+               Resolv_Ptr => Null_Address,
+               Sig_Range => (Sig_Table.Last, Sig_Table.Last),
+               Disconnect_Time => Bad_Time);
+         else
+            Resolv := null;
+         end if;
+      else
+         if Resolv_Proc /= Null_Address then
+            --  Only one resolution function is allowed!
+            Internal_Error ("create_signal");
+         end if;
+         Resolv := Current_Resolv;
+         if Current_Resolv.Sig_Range.Last = Sig_Table.Last then
+            Current_Resolv := null;
+         end if;
+      end if;
+
+      case Mode_Sig is
+         when Mode_Signal_User =>
+            S.Nbr_Drivers := 0;
+            S.Drivers := null;
+            S.Effective := null;
+            S.Resolv := Resolv;
+         when Mode_Conv_In
+           | Mode_Conv_Out =>
+            S.Conv := null;
+         when Mode_Stable
+           | Mode_Quiet
+           | Mode_Delayed =>
+            S.Time := 0;
+         when Mode_Guard =>
+            S.Guard_Func := null;
+            S.Guard_Instance := System.Null_Address;
+         when Mode_Transaction
+           | Mode_End =>
+            null;
+      end case;
+
+      Res := new Ghdl_Signal'(Value => Init_Val,
+                              Driving_Value => Init_Val,
+                              Last_Value => Init_Val,
+                              --  Note: use -Std_Time'last instead of
+                              --  Std_Time'First so that NOW - x'last_event
+                              --  returns time'high at initialization!
+                              Last_Event => -Std_Time'Last,
+                              Last_Active => -Std_Time'Last,
+                              Event => False,
+                              Active => False,
+
+                              Mode => Mode,
+                              Flags => (Propag => Propag_None,
+                                        Has_Active => False,
+                                        Is_Dumped => False,
+                                        Cyc_Event => False),
+
+                              Net => No_Signal_Net,
+                              Link => null,
+                              Alink => null,
+                              Flink => null,
+
+                              Event_List => null,
+                              Rti => Sig_Rti,
+
+                              Nbr_Ports => 0,
+                              Ports => null,
+
+                              S => S);
+
+      if Resolv /= null and then Resolv.Resolv_Ptr = System.Null_Address then
+         Resolv.Resolv_Ptr := To_Address (Res);
+      end if;
+
+      case Flag_Activity is
+         when Activity_All =>
+            Res.Flags.Has_Active := True;
+         when Activity_Minimal =>
+            if (Sig_Rti.Common.Mode and Ghdl_Rti_Signal_Has_Active) /= 0 then
+               Res.Flags.Has_Active := True;
+            end if;
+         when Activity_None =>
+            Res.Flags.Has_Active := False;
+      end case;
+
+      --  Put the signal in the table.
+      Sig_Table.Table (Sig_Table.Last) := Res;
+
+      return Res;
+   end Create_Signal;
+
+   procedure Ghdl_Signal_Init (Sig : Ghdl_Signal_Ptr; Val : Value_Union) is
+   begin
+      Sig.Value := Val;
+      Sig.Driving_Value := Val;
+      Sig.Last_Value := Val;
+   end Ghdl_Signal_Init;
+
+   procedure Ghdl_Signal_Merge_Rti (Sig : Ghdl_Signal_Ptr;
+                                    Rti : Ghdl_Rti_Access)
+   is
+      S_Rti : Ghdl_Rtin_Object_Acc;
+   begin
+      S_Rti := To_Ghdl_Rtin_Object_Acc (Rti);
+      if Flag_Activity = Activity_Minimal then
+         if (S_Rti.Common.Mode and Ghdl_Rti_Signal_Has_Active) /= 0 then
+            Sig.Flags.Has_Active := True;
+         end if;
+      end if;
+   end Ghdl_Signal_Merge_Rti;
+
+   procedure Ghdl_Signal_Create_Resolution (Proc : System.Address;
+                                            Instance : System.Address;
+                                            Sig : System.Address;
+                                            Nbr_Sig : Ghdl_Index_Type)
+   is
+   begin
+      if Current_Resolv /= null then
+         Internal_Error ("Ghdl_Signal_Create_Resolution");
+      end if;
+      Current_Resolv := new Resolved_Signal_Type'
+        (Resolv_Proc => Proc,
+         Resolv_Inst => Instance,
+         Resolv_Ptr => Sig,
+         Sig_Range => (First => Sig_Table.Last + 1,
+                       Last => Sig_Table.Last + Sig_Table_Index (Nbr_Sig)),
+         Disconnect_Time => Bad_Time);
+   end Ghdl_Signal_Create_Resolution;
+
+   procedure Check_New_Source (Sig : Ghdl_Signal_Ptr)
+   is
+      use Grt.Stdio;
+      use Grt.Astdio;
+   begin
+      if Sig.S.Nbr_Drivers + Sig.Nbr_Ports > 0 then
+         if Sig.S.Resolv = null then
+            --  LRM 4.3.1.2 Signal Declaration
+            --  It is an error if, after the elaboration of a description, a
+            --  signal has multiple sources and it is not a resolved signal.
+            Put ("for signal: ");
+            Disp_Signals.Put_Signal_Name (stderr, Sig);
+            New_Line (stderr);
+            Error ("several sources for unresolved signal");
+            --  FIXME: display signal name.
+         elsif Sig.S.Mode_Sig = Mode_Buffer and False then
+            --  LRM 1.1.1.2  Ports
+            --  A BUFFER port may have at most one source.
+
+            --  FIXME: this is not true with VHDL-02.
+            --  With VHDL-87/93, should also check that: any actual associated
+            --  with a formal buffer port may have at most one source.
+            Error ("buffer port which more than one source");
+         end if;
+      end if;
+   end Check_New_Source;
+
+   procedure Ghdl_Process_Add_Driver (Sign : Ghdl_Signal_Ptr)
+   is
+      type Size_T is new Integer;
+
+      function Malloc (Size : Size_T) return Driver_Arr_Ptr;
+      pragma Import (C, Malloc);
+
+      function Realloc (Ptr : Driver_Arr_Ptr; Size : Size_T)
+        return Driver_Arr_Ptr;
+      pragma Import (C, Realloc);
+
+      function Size (N : Ghdl_Index_Type) return Size_T is
+      begin
+         return Size_T (N * Driver_Type'Size / System.Storage_Unit);
+      end Size;
+
+      Trans : Transaction_Acc;
+      Id : Process_Id;
+   begin
+      Id := Get_Current_Process_Id;
+      if Sign.S.Nbr_Drivers = 0 then
+         Check_New_Source (Sign);
+         Sign.S.Drivers := Malloc (Size (1));
+         Sign.S.Nbr_Drivers := 1;
+      else
+         -- Do not create a driver twice.
+         for I in 0 .. Sign.S.Nbr_Drivers - 1 loop
+            if Sign.S.Drivers (I).Proc = Id then
+               return;
+            end if;
+         end loop;
+         Check_New_Source (Sign);
+         Sign.S.Nbr_Drivers := Sign.S.Nbr_Drivers + 1;
+         Sign.S.Drivers := Realloc (Sign.S.Drivers, Size (Sign.S.Nbr_Drivers));
+      end if;
+      Trans := new Transaction'(Kind => Trans_Value,
+                                Time => 0,
+                                Next => null,
+                                Val => Sign.Value);
+      Sign.S.Drivers (Sign.S.Nbr_Drivers - 1) :=
+        (First_Trans => Trans,
+         Last_Trans => Trans,
+         Proc => Id);
+   end Ghdl_Process_Add_Driver;
+
+   procedure Append_Port (Targ : Ghdl_Signal_Ptr; Src : Ghdl_Signal_Ptr)
+   is
+      type Size_T is new Integer;
+
+      function Malloc (Size : Size_T) return Signal_Arr_Ptr;
+      pragma Import (C, Malloc);
+
+      function Realloc (Ptr : Signal_Arr_Ptr; Size : Size_T)
+        return Signal_Arr_Ptr;
+      pragma Import (C, Realloc);
+
+      function Size (N : Ghdl_Index_Type) return Size_T is
+      begin
+         return Size_T (N * Ghdl_Signal_Ptr'Size / System.Storage_Unit);
+      end Size;
+   begin
+      if Targ.Nbr_Ports = 0 then
+         Targ.Ports := Malloc (Size (1));
+         Targ.Nbr_Ports := 1;
+      else
+         Targ.Nbr_Ports := Targ.Nbr_Ports + 1;
+         Targ.Ports := Realloc (Targ.Ports, Size (Targ.Nbr_Ports));
+      end if;
+      Targ.Ports (Targ.Nbr_Ports - 1) := Src;
+   end Append_Port;
+
+   --  Add SRC to port list of TARG, but only if not already in this list.
+   procedure Add_Port (Targ : Ghdl_Signal_Ptr; Src : Ghdl_Signal_Ptr)
+   is
+   begin
+      for I in 1 .. Targ.Nbr_Ports loop
+         if Targ.Ports (I - 1) = Src then
+            return;
+         end if;
+      end loop;
+      Append_Port (Targ, Src);
+   end Add_Port;
+
+   procedure Ghdl_Signal_Add_Source (Targ : Ghdl_Signal_Ptr;
+                                     Src : Ghdl_Signal_Ptr)
+   is
+   begin
+      Check_New_Source (Targ);
+      Append_Port (Targ, Src);
+   end Ghdl_Signal_Add_Source;
+
+   procedure Ghdl_Signal_Set_Disconnect (Sign : Ghdl_Signal_Ptr;
+                                         Time : Std_Time) is
+   begin
+      if Sign.S.Resolv = null then
+         Internal_Error ("ghdl_signal_set_disconnect: not resolved");
+      end if;
+      if Sign.S.Resolv.Disconnect_Time /= Bad_Time then
+         Error ("disconnection already specified for signal");
+      end if;
+      if Time < 0 then
+         Error ("disconnection time is negative");
+      end if;
+      Sign.S.Resolv.Disconnect_Time := Time;
+   end Ghdl_Signal_Set_Disconnect;
+
+   procedure Free is new Ada.Unchecked_Deallocation
+     (Object => Transaction, Name => Transaction_Acc);
+
+   function Value_Equal (Left, Right : Value_Union; Mode : Mode_Type)
+     return Boolean
+   is
+   begin
+      case Mode is
+         when Mode_B2 =>
+            return Left.B2 = Right.B2;
+         when Mode_E8 =>
+            return Left.E8 = Right.E8;
+         when Mode_E32 =>
+            return Left.E32 = Right.E32;
+         when Mode_I32 =>
+            return Left.I32 = Right.I32;
+         when Mode_I64 =>
+            return Left.I64 = Right.I64;
+         when Mode_F64 =>
+            return Left.F64 = Right.F64;
+      end case;
+   end Value_Equal;
+
+   function Find_Driver (Sig : Ghdl_Signal_Ptr) return Ghdl_Index_Type
+   is
+      Id : Process_Id;
+   begin
+      if Sig.S.Drivers = null then
+         Error ("assignment to a signal without any driver");
+      end if;
+      Id := Get_Current_Process_Id;
+      for I in 0 .. Sig.S.Nbr_Drivers - 1 loop
+         if Sig.S.Drivers (I).Proc = Id then
+            return I;
+         end if;
+      end loop;
+      Error ("assignment to a signal without a driver for the process");
+   end Find_Driver;
+
+   function Get_Driver (Sig : Ghdl_Signal_Ptr) return Driver_Acc
+   is
+      Id : Process_Id;
+   begin
+      if Sig.S.Drivers = null then
+         return null;
+      end if;
+      Id := Get_Current_Process_Id;
+      for I in 0 .. Sig.S.Nbr_Drivers - 1 loop
+         if Sig.S.Drivers (I).Proc = Id then
+            return Sig.S.Drivers (I)'Access;
+         end if;
+      end loop;
+      return null;
+   end Get_Driver;
+
+   --  Unused but well-known signal which always terminate ACTIVE_LIST.
+   --  As a consequence, every element of ACTIVE_LIST has a link field set to
+   --  a non-null value (this is of course not true for SIGNAL_END).  This may
+   --  be used to quickly check if a signal is in the list.
+   --  This signal is not in the signal table.
+   Signal_End : Ghdl_Signal_Ptr;
+
+   --  List of active signals.
+   Active_List : Ghdl_Signal_Ptr;
+
+   --  List of signals which have projected waveforms in the future (beyond
+   --  the next delta cycle).
+   Future_List : Ghdl_Signal_Ptr;
+
+   procedure Ghdl_Signal_Start_Assign (Sign : Ghdl_Signal_Ptr;
+                                       Reject : Std_Time;
+                                       Trans : Transaction_Acc;
+                                       After : Std_Time)
+   is
+      Assign_Time : Std_Time;
+      Drv : constant Ghdl_Index_Type := Find_Driver (Sign);
+      Drv_Ptr : constant Driver_Arr_Ptr := Sign.S.Drivers;
+      Driver : Driver_Type renames Drv_Ptr (Drv);
+   begin
+      --  LRM93 8.4.1
+      --  It is an error if the time expression in a waveform element
+      --  evaluates to a negative value.
+      if After < 0 then
+         Error ("negative time expression in signal assignment");
+      end if;
+
+      if After = 0 then
+         --  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;
+         end if;
+      else
+         --  AFTER > 0.
+         --  Put SIGN on the future list.
+         if Sign.Flink = null then
+            Sign.Flink := Future_List;
+            Future_List := Sign;
+         end if;
+      end if;
+
+      Assign_Time := Current_Time + After;
+      if Assign_Time < 0 then
+         --  Beyond the future
+         declare
+            Ntrans : Transaction_Acc;
+         begin
+            Ntrans := Trans;
+            Free (Ntrans);
+            return;
+         end;
+      end if;
+
+      --  LRM93 8.4.1
+      --  1. All old transactions that are projected to occur at or after the
+      --     time at which the earliest new transaction is projected to occur
+      --     are deleted from the projected output waveform.
+      if Driver.Last_Trans.Time >= Assign_Time then
+         declare
+            --  LAST is the last transaction to keep.
+            Last : Transaction_Acc;
+            Next : Transaction_Acc;
+         begin
+            Last := Driver.First_Trans;
+            --  Find the first transaction to be deleted.
+            Next := Last.Next;
+            while Next /= null and then Next.Time < Assign_Time loop
+               Last := Next;
+               Next := Next.Next;
+            end loop;
+            --  Delete old transactions.
+            if Next /= null then
+               --  Set the last transaction of the driver.
+               Driver.Last_Trans := Last;
+               --  Cut the chain.  This is not strickly necessary, since
+               --  it will be overriden below, by appending TRANS to the
+               --  driver.
+               Last.Next := null;
+               --  Free removed transactions.
+               loop
+                  Last := Next.Next;
+                  Free (Next);
+                  exit when Last = null;
+                  Next := Last;
+               end loop;
+            end if;
+         end;
+      end if;
+
+      --  2.  The new transaction are then appended to the projected output
+      --      waveform in the order of their projected occurence.
+      Trans.Time := Assign_Time;
+      Driver.Last_Trans.Next := Trans;
+      Driver.Last_Trans := Trans;
+
+      --  If the initial delay is inertial delay according to the definitions
+      --  of section 8.4, the projected output waveform is further modified
+      --  as follows:
+      --  1.  All of the new transactions are marked.
+      --  2.  An old transaction is marked if the time at which it is projected
+      --      to occur is less than the time at which the first new transaction
+      --      is projected to occur minus the pulse rejection limit.
+      --  3.  For each remaining unmarked, old transaction, the old transaction
+      --      is marked if it immediatly precedes a marked transaction and its
+      --      value component is the same as that of the marked transaction;
+      --  4.  The transaction that determines the current value of the driver
+      --      is marked.
+      --  5.  All unmarked transactions (all of which are old transactions) are
+      --      deleted from the projected output waveform.
+      --
+      --  GHDL: only transactions that are projected to occur at [T-R, T[
+      --  can be deleted (R is the reject time, T is now + after time).
+      if Reject > 0 then
+         --  LRM93 8.4
+         --  It is an error if the pulse rejection limit for any inertially
+         --  delayed signal assignment statement is [...] or greater than the
+         --  time expression associated with the first waveform element.
+         if Reject > After then
+            Error ("pulse rejection greater than first waveform delay");
+         end if;
+
+         declare
+            Prev : Transaction_Acc;
+            Next : Transaction_Acc;
+         begin
+            --  Find the first transaction after the project time less the
+            --  rejection time.
+            --  PREV will be the last old transaction which is projected to
+            --  occur before T - R.
+            Prev := Driver.First_Trans;
+            loop
+               Next := Prev.Next;
+               exit when Next.Time >= Assign_Time - Reject;
+               Prev := Next;
+            end loop;
+
+            --  Scan every transaction until TRANS.  If a transaction value is
+            --  different from the TRANS value, then delete all previous
+            --  transactions (from T - R to the currently scanned transaction),
+            --  since they are not marked.
+            while Next /= Trans loop
+               if Next.Kind /= Trans.Kind
+                 or else
+                 (Trans.Kind = Trans_Value
+                  and then not Value_Equal (Next.Val, Trans.Val, Sign.Mode))
+               then
+                  --  NEXT is different from TRANS.
+                  --  Delete ]PREV;NEXT].
+                  declare
+                     D, N : Transaction_Acc;
+                  begin
+                     D := Prev.Next;
+                     Next := Next.Next;
+                     Prev.Next := Next;
+                     loop
+                        N := D.Next;
+                        Free (D);
+                        exit when N = Next;
+                        D := N;
+                     end loop;
+                  end;
+               else
+                  Next := Next.Next;
+               end if;
+            end loop;
+         end;
+      elsif Reject /= 0 then
+         --  LRM93 8.4
+         --  It is an error if the pulse rejection limit for any inertially
+         --  delayed signal assignment statement is either negative or [...].
+         Error ("pulse rejection is negative");
+      end if;
+
+      --  Do some checks.
+      if Driver.Last_Trans.Next /= null then
+         Error ("ghdl_signal_start_assign internal_error");
+      end if;
+   end Ghdl_Signal_Start_Assign;
+
+   procedure Ghdl_Signal_Next_Assign (Sign : Ghdl_Signal_Ptr;
+                                      Val : Value_Union;
+                                      After : Std_Time)
+   is
+      Drv_Ptr : constant Driver_Arr_Ptr := Sign.S.Drivers;
+      Driver : Driver_Type renames Drv_Ptr (Find_Driver (Sign));
+
+      Trans : Transaction_Acc;
+   begin
+      if After > 0 and then Sign.Flink = null then
+         --  Put SIGN on the future list.
+         Sign.Flink := Future_List;
+         Future_List := Sign;
+      end if;
+
+      Trans := new Transaction'(Kind => Trans_Value,
+                                Time => Current_Time + After,
+                                Next => null,
+                                Val => Val);
+      if Trans.Time <= Driver.Last_Trans.Time then
+         Error ("transactions not in ascending order");
+      end if;
+      Driver.Last_Trans.Next := Trans;
+      Driver.Last_Trans := Trans;
+   end Ghdl_Signal_Next_Assign;
+
+   procedure Ghdl_Signal_Simple_Assign_Error (Sign : Ghdl_Signal_Ptr)
+   is
+      Trans : Transaction_Acc;
+   begin
+      Trans := new Transaction'(Kind => Trans_Error,
+                                Time => 0,
+                                Next => null);
+      Ghdl_Signal_Start_Assign (Sign, 0, Trans, 0);
+   end Ghdl_Signal_Simple_Assign_Error;
+
+   procedure Ghdl_Signal_Start_Assign_Error (Sign : Ghdl_Signal_Ptr;
+                                             Rej : Std_Time;
+                                             After : Std_Time)
+   is
+      Trans : Transaction_Acc;
+   begin
+      Trans := new Transaction'(Kind => Trans_Error,
+                                Time => 0,
+                                Next => null);
+      Ghdl_Signal_Start_Assign (Sign, Rej, Trans, After);
+   end Ghdl_Signal_Start_Assign_Error;
+
+   procedure Ghdl_Signal_Start_Assign_Null (Sign : Ghdl_Signal_Ptr;
+                                            Rej : Std_Time;
+                                            After : Std_Time)
+   is
+      Trans : Transaction_Acc;
+   begin
+      if not Is_Signal_Guarded (Sign) then
+         Error ("null transaction for a non-guarded target");
+      end if;
+      Trans := new Transaction'(Kind => Trans_Null,
+                                Time => 0,
+                                Next => null);
+      Ghdl_Signal_Start_Assign (Sign, Rej, Trans, After);
+   end Ghdl_Signal_Start_Assign_Null;
+
+   procedure Ghdl_Signal_Disconnect (Sign : Ghdl_Signal_Ptr)
+   is
+      Trans : Transaction_Acc;
+      Time : Std_Time;
+   begin
+      if not Is_Signal_Guarded (Sign) then
+         Error ("null transaction for a non-guarded target");
+      end if;
+      Trans := new Transaction'(Kind => Trans_Null,
+                                Time => 0,
+                                Next => null);
+      Time := Sign.S.Resolv.Disconnect_Time;
+      Ghdl_Signal_Start_Assign (Sign, Time, Trans, Time);
+   end Ghdl_Signal_Disconnect;
+
+   procedure Ghdl_Signal_Associate (Sig : Ghdl_Signal_Ptr; Val : Value_Union)
+   is
+   begin
+      Sig.Value := Val;
+      Sig.Driving_Value := Val;
+   end Ghdl_Signal_Associate;
+
+   function Ghdl_Create_Signal_B2
+     (Init_Val : Ghdl_B2;
+      Resolv_Func : System.Address;
+      Resolv_Inst : System.Address)
+     return Ghdl_Signal_Ptr
+   is
+   begin
+      return Create_Signal
+        (Mode_B2, Value_Union'(Mode => Mode_B2, B2 => Init_Val),
+         Get_Current_Mode_Signal,
+         Resolv_Func, Resolv_Inst);
+   end Ghdl_Create_Signal_B2;
+
+   procedure Ghdl_Signal_Init_B2 (Sig : Ghdl_Signal_Ptr; Init_Val : Ghdl_B2) is
+   begin
+      Ghdl_Signal_Init (Sig, Value_Union'(Mode => Mode_B2, B2 => Init_Val));
+   end Ghdl_Signal_Init_B2;
+
+   procedure Ghdl_Signal_Associate_B2 (Sig : Ghdl_Signal_Ptr; Val : Ghdl_B2) is
+   begin
+      Ghdl_Signal_Associate (Sig, Value_Union'(Mode => Mode_B2, B2 => Val));
+   end Ghdl_Signal_Associate_B2;
+
+   procedure Ghdl_Signal_Simple_Assign_B2 (Sign : Ghdl_Signal_Ptr;
+                                           Val : Ghdl_B2)
+   is
+      Trans : Transaction_Acc;
+   begin
+      if not Sign.Flags.Has_Active
+        and then Sign.Net = Net_One_Driver
+        and then Val = Sign.Value.B2
+        and then Sign.S.Drivers (0).First_Trans.Next = null
+      then
+         return;
+      end if;
+
+      Trans := new Transaction'
+        (Kind => Trans_Value,
+         Time => 0,
+         Next => null,
+         Val => Value_Union'(Mode => Mode_B2, B2 => Val));
+
+      Ghdl_Signal_Start_Assign (Sign, 0, Trans, 0);
+   end Ghdl_Signal_Simple_Assign_B2;
+
+   procedure Ghdl_Signal_Start_Assign_B2 (Sign : Ghdl_Signal_Ptr;
+                                          Rej : Std_Time;
+                                          Val : Ghdl_B2;
+                                          After : Std_Time)
+   is
+      Trans : Transaction_Acc;
+   begin
+      Trans := new Transaction'
+        (Kind => Trans_Value,
+         Time => 0,
+         Next => null,
+         Val => Value_Union'(Mode => Mode_B2, B2 => Val));
+      Ghdl_Signal_Start_Assign (Sign, Rej, Trans, After);
+   end Ghdl_Signal_Start_Assign_B2;
+
+   procedure Ghdl_Signal_Next_Assign_B2 (Sign : Ghdl_Signal_Ptr;
+                                         Val : Ghdl_B2;
+                                         After : Std_Time)
+   is
+   begin
+      Ghdl_Signal_Next_Assign
+        (Sign, Value_Union'(Mode => Mode_B2, B2 => Val), After);
+   end Ghdl_Signal_Next_Assign_B2;
+
+   function Ghdl_Create_Signal_E8
+     (Init_Val : Ghdl_E8;
+      Resolv_Func : System.Address;
+      Resolv_Inst : System.Address)
+     return Ghdl_Signal_Ptr
+   is
+   begin
+      return Create_Signal
+        (Mode_E8, Value_Union'(Mode => Mode_E8, E8 => Init_Val),
+         Get_Current_Mode_Signal,
+         Resolv_Func, Resolv_Inst);
+   end Ghdl_Create_Signal_E8;
+
+   procedure Ghdl_Signal_Init_E8 (Sig : Ghdl_Signal_Ptr; Init_Val : Ghdl_E8) is
+   begin
+      Ghdl_Signal_Init (Sig, Value_Union'(Mode => Mode_E8, E8 => Init_Val));
+   end Ghdl_Signal_Init_E8;
+
+   procedure Ghdl_Signal_Associate_E8 (Sig : Ghdl_Signal_Ptr; Val : Ghdl_E8) is
+   begin
+      Ghdl_Signal_Associate (Sig, Value_Union'(Mode => Mode_E8, E8 => Val));
+   end Ghdl_Signal_Associate_E8;
+
+   procedure Ghdl_Signal_Simple_Assign_E8 (Sign : Ghdl_Signal_Ptr;
+                                           Val : Ghdl_E8)
+   is
+      Trans : Transaction_Acc;
+   begin
+      if not Sign.Flags.Has_Active
+        and then Sign.Net = Net_One_Driver
+        and then Val = Sign.Value.E8
+        and then Sign.S.Drivers (0).First_Trans.Next = null
+      then
+         return;
+      end if;
+
+      Trans := new Transaction'
+        (Kind => Trans_Value,
+         Time => 0,
+         Next => null,
+         Val => Value_Union'(Mode => Mode_E8, E8 => Val));
+
+      Ghdl_Signal_Start_Assign (Sign, 0, Trans, 0);
+   end Ghdl_Signal_Simple_Assign_E8;
+
+   procedure Ghdl_Signal_Start_Assign_E8 (Sign : Ghdl_Signal_Ptr;
+                                          Rej : Std_Time;
+                                          Val : Ghdl_E8;
+                                          After : Std_Time)
+   is
+      Trans : Transaction_Acc;
+   begin
+      Trans := new Transaction'
+        (Kind => Trans_Value,
+         Time => 0,
+         Next => null,
+         Val => Value_Union'(Mode => Mode_E8, E8 => Val));
+      Ghdl_Signal_Start_Assign (Sign, Rej, Trans, After);
+   end Ghdl_Signal_Start_Assign_E8;
+
+   procedure Ghdl_Signal_Next_Assign_E8 (Sign : Ghdl_Signal_Ptr;
+                                         Val : Ghdl_E8;
+                                         After : Std_Time)
+   is
+   begin
+      Ghdl_Signal_Next_Assign
+        (Sign, Value_Union'(Mode => Mode_E8, E8 => Val), After);
+   end Ghdl_Signal_Next_Assign_E8;
+
+   function Ghdl_Create_Signal_I32
+     (Init_Val : Ghdl_I32;
+      Resolv_Func : System.Address;
+      Resolv_Inst : System.Address)
+     return Ghdl_Signal_Ptr
+   is
+   begin
+      return Create_Signal
+        (Mode_I32, Value_Union'(Mode => Mode_I32, I32 => Init_Val),
+         Get_Current_Mode_Signal,
+         Resolv_Func, Resolv_Inst);
+   end Ghdl_Create_Signal_I32;
+
+   procedure Ghdl_Signal_Init_I32 (Sig : Ghdl_Signal_Ptr; Init_Val : Ghdl_I32)
+   is
+   begin
+      Ghdl_Signal_Init (Sig, Value_Union'(Mode => Mode_I32, I32 => Init_Val));
+   end Ghdl_Signal_Init_I32;
+
+   procedure Ghdl_Signal_Associate_I32 (Sig : Ghdl_Signal_Ptr; Val : Ghdl_I32)
+   is
+   begin
+      Ghdl_Signal_Associate (Sig, Value_Union'(Mode => Mode_I32, I32 => Val));
+   end Ghdl_Signal_Associate_I32;
+
+   procedure Ghdl_Signal_Simple_Assign_I32 (Sign : Ghdl_Signal_Ptr;
+                                            Val : Ghdl_I32)
+   is
+      Trans : Transaction_Acc;
+   begin
+      if not Sign.Flags.Has_Active
+        and then Sign.Net = Net_One_Driver
+        and then Val = Sign.Value.I32
+        and then Sign.S.Drivers (0).First_Trans.Next = null
+      then
+         return;
+      end if;
+
+      Trans := new Transaction'
+        (Kind => Trans_Value,
+         Time => 0,
+         Next => null,
+         Val => Value_Union'(Mode => Mode_I32, I32 => Val));
+
+      Ghdl_Signal_Start_Assign (Sign, 0, Trans, 0);
+   end Ghdl_Signal_Simple_Assign_I32;
+
+   procedure Ghdl_Signal_Start_Assign_I32 (Sign : Ghdl_Signal_Ptr;
+                                           Rej : Std_Time;
+                                           Val : Ghdl_I32;
+                                           After : Std_Time)
+   is
+      Trans : Transaction_Acc;
+   begin
+      Trans := new Transaction'
+        (Kind => Trans_Value,
+         Time => 0,
+         Next => null,
+         Val => Value_Union'(Mode => Mode_I32, I32 => Val));
+      Ghdl_Signal_Start_Assign (Sign, Rej, Trans, After);
+   end Ghdl_Signal_Start_Assign_I32;
+
+   procedure Ghdl_Signal_Next_Assign_I32 (Sign : Ghdl_Signal_Ptr;
+                                          Val : Ghdl_I32;
+                                          After : Std_Time)
+   is
+   begin
+      Ghdl_Signal_Next_Assign
+        (Sign, Value_Union'(Mode => Mode_I32, I32 => Val), After);
+   end Ghdl_Signal_Next_Assign_I32;
+
+   function Ghdl_Create_Signal_I64
+     (Init_Val : Ghdl_I64;
+      Resolv_Func : System.Address;
+      Resolv_Inst : System.Address)
+     return Ghdl_Signal_Ptr
+   is
+   begin
+      return Create_Signal
+        (Mode_I64, Value_Union'(Mode => Mode_I64, I64 => Init_Val),
+         Get_Current_Mode_Signal,
+         Resolv_Func, Resolv_Inst);
+   end Ghdl_Create_Signal_I64;
+
+   procedure Ghdl_Signal_Init_I64 (Sig : Ghdl_Signal_Ptr; Init_Val : Ghdl_I64)
+   is
+   begin
+      Ghdl_Signal_Init (Sig, Value_Union'(Mode => Mode_I64, I64 => Init_Val));
+   end Ghdl_Signal_Init_I64;
+
+   procedure Ghdl_Signal_Associate_I64 (Sig : Ghdl_Signal_Ptr; Val : Ghdl_I64)
+   is
+   begin
+      Ghdl_Signal_Associate (Sig, Value_Union'(Mode => Mode_I64, I64 => Val));
+   end Ghdl_Signal_Associate_I64;
+
+   procedure Ghdl_Signal_Simple_Assign_I64 (Sign : Ghdl_Signal_Ptr;
+                                            Val : Ghdl_I64)
+   is
+      Trans : Transaction_Acc;
+   begin
+      if not Sign.Flags.Has_Active
+        and then Sign.Net = Net_One_Driver
+        and then Val = Sign.Value.I64
+        and then Sign.S.Drivers (0).First_Trans.Next = null
+      then
+         return;
+      end if;
+
+      Trans := new Transaction'
+        (Kind => Trans_Value,
+         Time => 0,
+         Next => null,
+         Val => Value_Union'(Mode => Mode_I64, I64 => Val));
+
+      Ghdl_Signal_Start_Assign (Sign, 0, Trans, 0);
+   end Ghdl_Signal_Simple_Assign_I64;
+
+   procedure Ghdl_Signal_Start_Assign_I64 (Sign : Ghdl_Signal_Ptr;
+                                           Rej : Std_Time;
+                                           Val : Ghdl_I64;
+                                           After : Std_Time)
+   is
+      Trans : Transaction_Acc;
+   begin
+      Trans := new Transaction'
+        (Kind => Trans_Value,
+         Time => 0,
+         Next => null,
+         Val => Value_Union'(Mode => Mode_I64, I64 => Val));
+      Ghdl_Signal_Start_Assign (Sign, Rej, Trans, After);
+   end Ghdl_Signal_Start_Assign_I64;
+
+   procedure Ghdl_Signal_Next_Assign_I64 (Sign : Ghdl_Signal_Ptr;
+                                          Val : Ghdl_I64;
+                                          After : Std_Time)
+   is
+   begin
+      Ghdl_Signal_Next_Assign
+        (Sign, Value_Union'(Mode => Mode_I64, I64 => Val), After);
+   end Ghdl_Signal_Next_Assign_I64;
+
+   function Ghdl_Create_Signal_F64
+     (Init_Val : Ghdl_F64;
+      Resolv_Func : System.Address;
+      Resolv_Inst : System.Address)
+     return Ghdl_Signal_Ptr
+   is
+   begin
+      return Create_Signal
+        (Mode_F64, Value_Union'(Mode => Mode_F64, F64 => Init_Val),
+         Get_Current_Mode_Signal,
+         Resolv_Func, Resolv_Inst);
+   end Ghdl_Create_Signal_F64;
+
+   procedure Ghdl_Signal_Init_F64 (Sig : Ghdl_Signal_Ptr; Init_Val : Ghdl_F64)
+   is
+   begin
+      Ghdl_Signal_Init (Sig, Value_Union'(Mode => Mode_F64, F64 => Init_Val));
+   end Ghdl_Signal_Init_F64;
+
+   procedure Ghdl_Signal_Associate_F64 (Sig : Ghdl_Signal_Ptr; Val : Ghdl_F64)
+   is
+   begin
+      Ghdl_Signal_Associate (Sig, Value_Union'(Mode => Mode_F64, F64 => Val));
+   end Ghdl_Signal_Associate_F64;
+
+   procedure Ghdl_Signal_Simple_Assign_F64 (Sign : Ghdl_Signal_Ptr;
+                                            Val : Ghdl_F64)
+   is
+      Trans : Transaction_Acc;
+   begin
+      if not Sign.Flags.Has_Active
+        and then Sign.Net = Net_One_Driver
+        and then Val = Sign.Value.F64
+        and then Sign.S.Drivers (0).First_Trans.Next = null
+      then
+         return;
+      end if;
+
+      Trans := new Transaction'
+        (Kind => Trans_Value,
+         Time => 0,
+         Next => null,
+         Val => Value_Union'(Mode => Mode_F64, F64 => Val));
+
+      Ghdl_Signal_Start_Assign (Sign, 0, Trans, 0);
+   end Ghdl_Signal_Simple_Assign_F64;
+
+   procedure Ghdl_Signal_Start_Assign_F64 (Sign : Ghdl_Signal_Ptr;
+                                           Rej : Std_Time;
+                                           Val : Ghdl_F64;
+                                           After : Std_Time)
+   is
+      Trans : Transaction_Acc;
+   begin
+      Trans := new Transaction'
+        (Kind => Trans_Value,
+         Time => 0,
+         Next => null,
+         Val => Value_Union'(Mode => Mode_F64, F64 => Val));
+      Ghdl_Signal_Start_Assign (Sign, Rej, Trans, After);
+   end Ghdl_Signal_Start_Assign_F64;
+
+   procedure Ghdl_Signal_Next_Assign_F64 (Sign : Ghdl_Signal_Ptr;
+                                          Val : Ghdl_F64;
+                                          After : Std_Time)
+   is
+   begin
+      Ghdl_Signal_Next_Assign
+        (Sign, Value_Union'(Mode => Mode_F64, F64 => Val), After);
+   end Ghdl_Signal_Next_Assign_F64;
+
+   procedure Ghdl_Signal_Internal_Checks
+   is
+      Sig : Ghdl_Signal_Ptr;
+   begin
+      for I in Sig_Table.First .. Sig_Table.Last loop
+         Sig := Sig_Table.Table (I);
+
+         --  Check drivers.
+         for J in 1 .. Sig.S.Nbr_Drivers loop
+            declare
+               Trans : Transaction_Acc;
+            begin
+               Trans := Sig.S.Drivers (J - 1).First_Trans;
+               while Trans.Next /= null loop
+                  if Trans.Next.Time < Trans.Time then
+                     Internal_Error ("ghdl_signal_internal_checks: "
+                                     & "bad transaction order");
+                  end if;
+                  Trans := Trans.Next;
+               end loop;
+               if Trans /= Sig.S.Drivers (J - 1).Last_Trans then
+                  Internal_Error ("ghdl_signal_internal_checks: "
+                                  & "last transaction mismatch");
+               end if;
+            end;
+         end loop;
+      end loop;
+   end Ghdl_Signal_Internal_Checks;
+
+   procedure Ghdl_Signal_Effective_Value (Targ : Ghdl_Signal_Ptr;
+                                          Src : Ghdl_Signal_Ptr)
+   is
+   begin
+      if Targ.S.Effective /= null then
+         Error ("internal error: already effective value");
+      end if;
+      Targ.S.Effective := Src;
+   end Ghdl_Signal_Effective_Value;
+
+   Bit_Signal_Rti : aliased Ghdl_Rtin_Object :=
+     (Common => (Kind => Ghdl_Rtik_Signal,
+                 Depth => 0,
+                 Mode => Ghdl_Rti_Signal_Mode_None,
+                 Max_Depth => 0),
+      Name => null,
+      Loc => (Rel => True, Off => 0),
+      Obj_Type => null);
+
+   Boolean_Signal_Rti : aliased Ghdl_Rtin_Object :=
+     (Common => (Kind => Ghdl_Rtik_Signal,
+                 Depth => 0,
+                 Mode => Ghdl_Rti_Signal_Mode_None,
+                 Max_Depth => 0),
+      Name => null,
+      Loc => (Rel => True, Off => 0),
+      Obj_Type => null);
+
+   function Ghdl_Create_Signal_Attribute
+     (Mode : Mode_Signal_Type; Time : Std_Time)
+     return Ghdl_Signal_Ptr
+   is
+      Res : Ghdl_Signal_Ptr;
+--      Sig_Type : Ghdl_Desc_Ptr;
+   begin
+      case Mode is
+         when Mode_Transaction =>
+            Sig_Rti := To_Ghdl_Rtin_Object_Acc
+              (To_Ghdl_Rti_Access (Bit_Signal_Rti'Address));
+         when Mode_Quiet
+           | Mode_Stable =>
+            Sig_Rti := To_Ghdl_Rtin_Object_Acc
+              (To_Ghdl_Rti_Access (Boolean_Signal_Rti'Address));
+         when others =>
+            Internal_Error ("ghdl_create_signal_attribute");
+      end case;
+--       Sig_Instance_Name := new Ghdl_Instance_Name_Type'
+--         (Kind => Ghdl_Name_Signal,
+--          Name => null,
+--          Parent => null,
+--          Brother => null,
+--          Sig_Mode => Mode,
+--          Sig_Kind => Kind_Signal_No,
+--        Sig_Indexes => (First => Sig_Table.Last + 1, Last => Sig_Table.Last),
+--          Sig_Type_Desc => Sig_Type);
+      --  Note: bit and boolean are both mode_b2.
+      Res := Create_Signal
+        (Mode_B2, Value_Union'(Mode => Mode_B2, B2 => True),
+         Mode, Null_Address, Null_Address);
+
+      Last_Implicit_Signal := Res;
+
+      if Mode /= Mode_Transaction then
+         Res.S.Time := Time;
+         Res.S.Attr_Trans := new Transaction'(Kind => Trans_Value,
+                                              Time => 0,
+                                              Next => null,
+                                              Val => Res.Value);
+      end if;
+
+      if Time > 0 then
+         Res.Flink := Future_List;
+         Future_List := Res;
+      end if;
+
+      return Res;
+   end Ghdl_Create_Signal_Attribute;
+
+   function Ghdl_Create_Stable_Signal (Val : Std_Time) return Ghdl_Signal_Ptr
+   is
+   begin
+      return Ghdl_Create_Signal_Attribute (Mode_Stable, Val);
+   end Ghdl_Create_Stable_Signal;
+
+   function Ghdl_Create_Quiet_Signal (Val : Std_Time) return Ghdl_Signal_Ptr
+   is
+   begin
+      return Ghdl_Create_Signal_Attribute (Mode_Quiet, Val);
+   end Ghdl_Create_Quiet_Signal;
+
+   function Ghdl_Create_Transaction_Signal return Ghdl_Signal_Ptr
+   is
+   begin
+      return Ghdl_Create_Signal_Attribute (Mode_Transaction, 0);
+   end Ghdl_Create_Transaction_Signal;
+
+   procedure Ghdl_Signal_Attribute_Register_Prefix (Sig : Ghdl_Signal_Ptr)
+   is
+   begin
+      Add_Port (Last_Implicit_Signal, Sig);
+   end Ghdl_Signal_Attribute_Register_Prefix;
+
+   --Guard_String : constant String := "guard";
+   --Guard_Name : constant Ghdl_Str_Len_Address_Type :=
+   --  (Len => 5, Str => Guard_String'Address);
+   --function To_Ghdl_Str_Len_Ptr is new Ada.Unchecked_Conversion
+   --  (Source => System.Address, Target => Ghdl_Str_Len_Ptr);
+
+   Guard_Rti : aliased constant Ghdl_Rtin_Object :=
+     (Common => (Kind => Ghdl_Rtik_Signal,
+                 Depth => 0,
+                 Mode => Ghdl_Rti_Signal_Mode_None,
+                 Max_Depth => 0),
+      Name => null,
+      Loc => (Rel => True, Off => 0),
+      Obj_Type => Std_Standard_Boolean_RTI_Ptr);
+
+   function Ghdl_Signal_Create_Guard (This : System.Address;
+                                      Proc : Guard_Func_Acc)
+     return Ghdl_Signal_Ptr
+   is
+      Res : Ghdl_Signal_Ptr;
+   begin
+      Sig_Rti := To_Ghdl_Rtin_Object_Acc
+        (To_Ghdl_Rti_Access (Guard_Rti'Address));
+      Res := Create_Signal
+        (Mode_B2, Value_Union'(Mode => Mode_B2, B2 => Proc.all (This)),
+         Mode_Guard, Null_Address, Null_Address);
+      Res.S.Guard_Func := Proc;
+      Res.S.Guard_Instance := This;
+      Last_Implicit_Signal := Res;
+      return Res;
+   end Ghdl_Signal_Create_Guard;
+
+   procedure Ghdl_Signal_Guard_Dependence (Sig : Ghdl_Signal_Ptr)
+   is
+   begin
+      Add_Port (Last_Implicit_Signal, Sig);
+   end Ghdl_Signal_Guard_Dependence;
+
+   function Ghdl_Create_Delayed_Signal (Sig : Ghdl_Signal_Ptr; Val : Std_Time)
+                                       return Ghdl_Signal_Ptr
+   is
+      Res : Ghdl_Signal_Ptr;
+   begin
+      Res := Create_Signal (Sig.Mode, Sig.Value,
+                            Mode_Delayed, Null_Address, Null_Address);
+      Res.S.Time := Val;
+      if Val > 0 then
+         Res.Flink := Future_List;
+         Future_List := Res;
+      end if;
+      Res.S.Attr_Trans := new Transaction'(Kind => Trans_Value,
+                                           Time => 0,
+                                           Next => null,
+                                           Val => Res.Value);
+      Append_Port (Res, Sig);
+      return Res;
+   end Ghdl_Create_Delayed_Signal;
+
+   function Signal_Ptr_To_Index (Ptr : Ghdl_Signal_Ptr) return Sig_Table_Index
+   is
+   begin
+      --  Note: we may start from ptr.instance_name.sig_index, but
+      --  instance_name is *not* set for conversion signals.
+      for I in reverse Sig_Table.First .. Sig_Table.Last loop
+         if Sig_Table.Table (I) = Ptr then
+            return I;
+         end if;
+      end loop;
+      return -1;
+   end Signal_Ptr_To_Index;
+
+   function Ghdl_Signal_Get_Nbr_Ports (Sig : Ghdl_Signal_Ptr)
+                                      return Ghdl_Index_Type is
+   begin
+      return Sig.Nbr_Ports;
+   end Ghdl_Signal_Get_Nbr_Ports;
+
+   function Ghdl_Signal_Get_Nbr_Drivers (Sig : Ghdl_Signal_Ptr)
+                                        return Ghdl_Index_Type is
+   begin
+      return Sig.S.Nbr_Drivers;
+   end Ghdl_Signal_Get_Nbr_Drivers;
+
+   function Ghdl_Signal_Read_Port
+     (Sig : Ghdl_Signal_Ptr; Index : Ghdl_Index_Type)
+     return Ghdl_Value_Ptr
+   is
+   begin
+      if Index >= Sig.Nbr_Ports then
+         Internal_Error ("ghdl_signal_read_port: bad index");
+      end if;
+      return To_Ghdl_Value_Ptr (Sig.Ports (Index).Driving_Value'Address);
+   end Ghdl_Signal_Read_Port;
+
+   function Ghdl_Signal_Read_Driver
+     (Sig : Ghdl_Signal_Ptr; Index : Ghdl_Index_Type)
+     return Ghdl_Value_Ptr
+   is
+      Trans : Transaction_Acc;
+   begin
+      if Index >= Sig.S.Nbr_Drivers then
+         Internal_Error ("ghdl_signal_read_driver: bad index");
+      end if;
+      Trans := Sig.S.Drivers (Index).First_Trans;
+      case Trans.Kind is
+         when Trans_Value =>
+            return To_Ghdl_Value_Ptr (Trans.Val'Address);
+         when Trans_Null =>
+            return null;
+         when Trans_Error =>
+            Error ("range check error on signal");
+      end case;
+   end Ghdl_Signal_Read_Driver;
+
+   procedure Ghdl_Signal_Conversion (Func : System.Address;
+                                     Instance : System.Address;
+                                     Src : Ghdl_Signal_Ptr;
+                                     Src_Len : Ghdl_Index_Type;
+                                     Dst : Ghdl_Signal_Ptr;
+                                     Dst_Len : Ghdl_Index_Type;
+                                     Mode : Mode_Signal_Type)
+   is
+      Data : Sig_Conversion_Acc;
+      Sig : Ghdl_Signal_Ptr;
+   begin
+      Data := new Sig_Conversion_Type'(Func => Func,
+                                       Instance => Instance,
+                                       Src => (-1, -1),
+                                       Dest => (-1, -1));
+      Data.Src.First := Signal_Ptr_To_Index (Src);
+      Data.Src.Last := Data.Src.First + Sig_Table_Index (Src_Len) - 1;
+
+      Data.Dest.First := Signal_Ptr_To_Index (Dst);
+      Data.Dest.Last := Data.Dest.First + Sig_Table_Index (Dst_Len) - 1;
+
+      --  Convert DEST to new mode.
+      for I in Data.Dest.First .. Data.Dest.Last loop
+         Sig := Sig_Table.Table (I);
+         case Mode is
+            when Mode_Conv_In =>
+               Sig.S := (Mode_Sig => Mode_Conv_In,
+                         Conv => Data);
+            when Mode_Conv_Out =>
+               Sig.S := (Mode_Sig => Mode_Conv_Out,
+                         Conv => Data);
+            when others =>
+               Internal_Error ("ghdl_signal_conversion");
+         end case;
+      end loop;
+   end Ghdl_Signal_Conversion;
+
+   procedure Ghdl_Signal_In_Conversion (Func : System.Address;
+                                        Instance : System.Address;
+                                        Src : Ghdl_Signal_Ptr;
+                                        Src_Len : Ghdl_Index_Type;
+                                        Dst : Ghdl_Signal_Ptr;
+                                        Dst_Len : Ghdl_Index_Type)
+   is
+   begin
+      Ghdl_Signal_Conversion
+        (Func, Instance, Src, Src_Len, Dst, Dst_Len, Mode_Conv_In);
+   end Ghdl_Signal_In_Conversion;
+
+   procedure Ghdl_Signal_Out_Conversion (Func : System.Address;
+                                         Instance : System.Address;
+                                         Src : Ghdl_Signal_Ptr;
+                                         Src_Len : Ghdl_Index_Type;
+                                         Dst : Ghdl_Signal_Ptr;
+                                         Dst_Len : Ghdl_Index_Type)
+   is
+   begin
+      Ghdl_Signal_Conversion
+        (Func, Instance, Src, Src_Len, Dst, Dst_Len, Mode_Conv_Out);
+   end Ghdl_Signal_Out_Conversion;
+
+   function Ghdl_Signal_Driving (Sig : Ghdl_Signal_Ptr) return Ghdl_B2
+   is
+      Drv : Driver_Acc;
+   begin
+      Drv := Get_Driver (Sig);
+      if Drv = null then
+         --  FIXME: disp signal and process.
+         Error ("'driving error: no driver in process for signal");
+      end if;
+      if Drv.First_Trans.Kind /= Trans_Null then
+         return True;
+      else
+         return False;
+      end if;
+   end Ghdl_Signal_Driving;
+
+   function Ghdl_Signal_Driving_Value_B2 (Sig : Ghdl_Signal_Ptr) return Ghdl_B2
+   is
+      Drv : Driver_Acc;
+   begin
+      Drv := Get_Driver (Sig);
+      if Drv = null or else Drv.First_Trans.Kind /= Trans_Value then
+         Error ("'driving_value: no active driver in process for signal");
+      else
+         return Drv.First_Trans.Val.B2;
+      end if;
+   end Ghdl_Signal_Driving_Value_B2;
+
+   function Ghdl_Signal_Driving_Value_E8 (Sig : Ghdl_Signal_Ptr)
+                                         return Ghdl_E8
+   is
+      Drv : Driver_Acc;
+   begin
+      Drv := Get_Driver (Sig);
+      if Drv = null or else Drv.First_Trans.Kind /= Trans_Value then
+         Error ("'driving_value: no active driver in process for signal");
+      else
+         return Drv.First_Trans.Val.E8;
+      end if;
+   end Ghdl_Signal_Driving_Value_E8;
+
+   function Ghdl_Signal_Driving_Value_I32 (Sig : Ghdl_Signal_Ptr)
+                                          return Ghdl_I32
+   is
+      Drv : Driver_Acc;
+   begin
+      Drv := Get_Driver (Sig);
+      if Drv = null or else Drv.First_Trans.Kind /= Trans_Value then
+         Error ("'driving_value: no active driver in process for signal");
+      else
+         return Drv.First_Trans.Val.I32;
+      end if;
+   end Ghdl_Signal_Driving_Value_I32;
+
+   function Ghdl_Signal_Driving_Value_I64 (Sig : Ghdl_Signal_Ptr)
+                                          return Ghdl_I64
+   is
+      Drv : Driver_Acc;
+   begin
+      Drv := Get_Driver (Sig);
+      if Drv = null or else Drv.First_Trans.Kind /= Trans_Value then
+         Error ("'driving_value: no active driver in process for signal");
+      else
+         return Drv.First_Trans.Val.I64;
+      end if;
+   end Ghdl_Signal_Driving_Value_I64;
+
+   function Ghdl_Signal_Driving_Value_F64 (Sig : Ghdl_Signal_Ptr)
+                                          return Ghdl_F64
+   is
+      Drv : Driver_Acc;
+   begin
+      Drv := Get_Driver (Sig);
+      if Drv = null or else Drv.First_Trans.Kind /= Trans_Value then
+         Error ("'driving_value: no active driver in process for signal");
+      else
+         return Drv.First_Trans.Val.F64;
+      end if;
+   end Ghdl_Signal_Driving_Value_F64;
+
+   procedure Flush_Active_List
+   is
+      Sig : Ghdl_Signal_Ptr;
+      Next_Sig : Ghdl_Signal_Ptr;
+   begin
+      --  Free active_list.
+      Sig := Active_List;
+      loop
+         Next_Sig := Sig.Link;
+         exit when Next_Sig = null;
+         Sig.Link := null;
+         Sig := Next_Sig;
+      end loop;
+      Active_List := Sig;
+   end Flush_Active_List;
+
+   --  Add SIG in active_list.
+   procedure Add_Active_List (Sig : Ghdl_Signal_Ptr);
+   pragma Inline (Add_Active_List);
+
+   procedure Add_Active_List (Sig : Ghdl_Signal_Ptr)
+   is
+   begin
+      if Sig.Link = null then
+         Sig.Link := Active_List;
+         Active_List := Sig;
+      end if;
+   end Add_Active_List;
+
+   function Find_Next_Time return Std_Time
+   is
+      Res : Std_Time;
+      Sig : Ghdl_Signal_Ptr;
+
+      procedure Check_Transaction (Trans : Transaction_Acc)
+      is
+      begin
+         if Trans /= null then
+            if Trans.Time = Res and Sig.Link = null then
+               Sig.Link := Active_List;
+               Active_List := Sig;
+            elsif Trans.Time < Res then
+               Flush_Active_List;
+
+               --  Put sig on the list.
+               Sig.Link := Active_List;
+               Active_List := Sig;
+
+               Res := Trans.Time;
+            end if;
+            if Res = Current_Time then
+               --  Must have been in the active list.
+               Internal_Error ("find_next_time(2)");
+            end if;
+         end if;
+      end Check_Transaction;
+   begin
+      --  If there is signals in the active list, then next cycle is a delta
+      --  cycle, so next time is current_time.
+      if Active_List.Link /= null then
+         return Current_Time;
+      end if;
+
+      Res := Std_Time'Last;
+
+      Sig := Future_List;
+      while Sig.Flink /= null loop
+         case Sig.S.Mode_Sig is
+            when Mode_Signal_User =>
+               for J in 1 .. Sig.S.Nbr_Drivers loop
+                  Check_Transaction (Sig.S.Drivers (J - 1).First_Trans.Next);
+               end loop;
+            when Mode_Delayed
+              | Mode_Stable
+              | Mode_Quiet =>
+               Check_Transaction (Sig.S.Attr_Trans.Next);
+            when others =>
+               Internal_Error ("find_next_time(3)");
+         end case;
+         Sig := Sig.Flink;
+      end loop;
+      return Res;
+   end Find_Next_Time;
+
+--    function Get_Nbr_Non_Null_Source (Sig : Ghdl_Signal_Ptr)
+--                                     return Natural
+--    is
+--       Length : Natural;
+--    begin
+--       Length := Sig.Nbr_Ports;
+--       for I in 0 .. Sig.Nbr_Drivers - 1 loop
+--          case Sig.Drivers (I).First_Trans.Kind is
+--             when Trans_Value =>
+--                Length := Length + 1;
+--             when Trans_Null =>
+--                null;
+--             when Trans_Error =>
+--                Error ("range check error");
+--          end case;
+--       end loop;
+--       return Length;
+--    end Get_Nbr_Non_Null_Source;
+
+   Clear_List : Ghdl_Signal_Ptr := null;
+
+   procedure Mark_Active (Sig : Ghdl_Signal_Ptr);
+   pragma Inline (Mark_Active);
+
+   procedure Mark_Active (Sig : Ghdl_Signal_Ptr)
+   is
+   begin
+      if Sig.Active then
+         Internal_Error ("mark_active");
+      end if;
+      Sig.Active := True;
+      Sig.Last_Active := Current_Time;
+      Sig.Alink := Clear_List;
+      Clear_List := Sig;
+   end Mark_Active;
+
+   type Resolver_Acc is access procedure
+     (Instance : System.Address;
+      Val : System.Address;
+      Bool_Vec : System.Address;
+      Vec_Len : Ghdl_Index_Type;
+      Nbr_Drv : Ghdl_Index_Type;
+      Nbr_Ports : Ghdl_Index_Type);
+
+   function To_Resolver_Acc is new Ada.Unchecked_Conversion
+     (Source => System.Address, Target => Resolver_Acc);
+
+   procedure Compute_Resolved_Signal (Resolv : Resolved_Signal_Acc)
+   is
+      Sig : Ghdl_Signal_Ptr := Sig_Table.Table (Resolv.Sig_Range.First);
+      Length : Ghdl_Index_Type;
+      type Bool_Array_Type is array (1 .. Sig.S.Nbr_Drivers) of Boolean;
+      Vec : Bool_Array_Type;
+   begin
+      --  Compute number of non-null drivers.
+      Length := 0;
+      for I in 1 .. Sig.S.Nbr_Drivers loop
+         case Sig.S.Drivers (I - 1).First_Trans.Kind is
+            when Trans_Value =>
+               Length := Length + 1;
+               Vec (I) := True;
+            when Trans_Null =>
+               Vec (I) := False;
+            when Trans_Error =>
+               Error ("range check error");
+         end case;
+      end loop;
+
+      --  Check driving condition on all signals.
+      for J in Resolv.Sig_Range.First + 1.. Resolv.Sig_Range.Last loop
+         for I in 1 .. Sig.S.Nbr_Drivers loop
+            if (Sig_Table.Table (J).S.Drivers (I - 1).First_Trans.Kind
+                /= Trans_Null)
+              xor Vec (I)
+            then
+               Error ("null-transaction required");
+            end if;
+         end loop;
+      end loop;
+
+      --  if no driving sources and register, exit.
+      if Length = 0 and then Sig.Nbr_Ports = 0
+        and then ((Sig.Rti.Common.Mode and Ghdl_Rti_Signal_Kind_Mask)
+                  = Ghdl_Rti_Signal_Kind_Register)
+      then
+         return;
+      end if;
+
+      --  Call the procedure.
+      To_Resolver_Acc (Resolv.Resolv_Proc).all
+        (Resolv.Resolv_Inst,
+         Resolv.Resolv_Ptr,
+         Vec'Address,
+         Length,
+         Sig.S.Nbr_Drivers,
+         Sig.Nbr_Ports);
+   end Compute_Resolved_Signal;
+
+   type Conversion_Func_Acc is access procedure (Instance : System.Address);
+   function To_Conversion_Func_Acc is new Ada.Unchecked_Conversion
+     (Source => System.Address, Target => Conversion_Func_Acc);
+
+   procedure Call_Conversion_Function (Conv : Sig_Conversion_Acc)
+   is
+      F : Conversion_Func_Acc;
+   begin
+      F := To_Conversion_Func_Acc (Conv.Func);
+      F.all (Conv.Instance);
+   end Call_Conversion_Function;
+
+   procedure Resume_Process_If_Event
+     (Sig : Ghdl_Signal_Ptr; Proc : Process_Id)
+   is
+      El : Action_List_Acc;
+   begin
+      El := new Action_List'(Kind => Action_Process,
+                             Proc => Proc,
+                             Next => Sig.Event_List);
+      Sig.Event_List := El;
+   end Resume_Process_If_Event;
+
+   --  Order of signals:
+   --  To be computed: driving value or/and effective value
+   --  To be considered: ports, signals, implicit signals, resolution,
+   --                    conversion
+   --
+
+   procedure Add_Propagation (P : Propagation_Type) is
+   begin
+      Propagation.Increment_Last;
+      Propagation.Table (Propagation.Last) := P;
+   end Add_Propagation;
+
+   --  Put SIG in PROPAGATION table until ORDER level.
+   procedure Order_Signal (Sig : Ghdl_Signal_Ptr; Order : Propag_Order_Flag);
+
+   --  Return TRUE is the effective value of SIG is the driving value of SIG.
+   function Is_Eff_Drv (Sig : Ghdl_Signal_Ptr) return Boolean
+   is
+   begin
+      case Sig.S.Mode_Sig is
+         when Mode_Signal
+           | Mode_Buffer =>
+            return True;
+         when Mode_Linkage
+           | Mode_Out =>
+            --  No effective value.
+            return False;
+         when Mode_Inout
+           | Mode_In =>
+            if Sig.S.Effective = null then
+               if Sig.S.Nbr_Drivers > 0 or Sig.Nbr_Ports > 0 then
+                  --  Only for inout.
+                  return True;
+               else
+                  return False;
+               end if;
+            else
+               return False;
+            end if;
+         when Mode_Conv_In
+           | Mode_Conv_Out =>
+            return False;
+         when Mode_Stable
+           | Mode_Guard
+           | Mode_Quiet
+           | Mode_Transaction
+           | Mode_Delayed =>
+            return True;
+         when Mode_End =>
+            return False;
+      end case;
+   end Is_Eff_Drv;
+
+   procedure Order_Signal_List (Sig : Ghdl_Signal_Ptr;
+                                Order : Propag_Order_Flag)
+   is
+   begin
+      for I in 1 .. Sig.Nbr_Ports loop
+         Order_Signal (Sig.Ports (I - 1), Order);
+      end loop;
+   end Order_Signal_List;
+
+   --  Put SIG in PROPAGATION table until ORDER level.
+   procedure Order_Signal (Sig : Ghdl_Signal_Ptr; Order : Propag_Order_Flag)
+   is
+   begin
+      if Sig = null then
+         return;
+      end if;
+
+      --  Catch infinite loops, which must never happen.
+      --  Also exit if the signal is already fully ordered.
+      case Sig.Flags.Propag is
+         when Propag_None =>
+            null;
+         when Propag_Being_Driving =>
+            Internal_Error ("order_signal: being driving");
+         when Propag_Being_Effective =>
+            Internal_Error ("order_signal: being effective");
+         when Propag_Driving =>
+            null;
+         when Propag_Done =>
+            --  If sig was already handled, nothing to do!
+            return;
+      end case;
+
+      --  First, the driving value.
+      if Sig.Flags.Propag = Propag_None then
+         case Sig.S.Mode_Sig is
+            when Mode_Signal_User =>
+               if Sig.S.Nbr_Drivers = 0 and Sig.Nbr_Ports = 0 then
+                  --  No source.
+                  Sig.Flags.Propag := Propag_Driving;
+               elsif Sig.S.Resolv = null then
+                  --  Not resolved (so at most one source).
+                  if Sig.S.Nbr_Drivers = 1 then
+                     --  Not resolved, 1 source : a driver.
+                     if Is_Eff_Drv (Sig) then
+                        Add_Propagation ((Kind => Eff_One_Driver, Sig => Sig));
+                        Sig.Flags.Propag := Propag_Done;
+                     else
+                        Add_Propagation ((Kind => Drv_One_Driver, Sig => Sig));
+                        Sig.Flags.Propag := Propag_Driving;
+                     end if;
+                  else
+                     Sig.Flags.Propag := Propag_Being_Driving;
+                     --  not resolved, 1 source : Source is a port.
+                     Order_Signal (Sig.Ports (0), Propag_Driving);
+                     if Is_Eff_Drv (Sig) then
+                        Add_Propagation ((Kind => Eff_One_Port, Sig => Sig));
+                        Sig.Flags.Propag := Propag_Done;
+                     else
+                        Add_Propagation ((Kind => Drv_One_Port, Sig => Sig));
+                        Sig.Flags.Propag := Propag_Driving;
+                     end if;
+                  end if;
+               else
+                  --  Resolved signal.
+                  declare
+                     Resolv : Resolved_Signal_Acc;
+                     S : Ghdl_Signal_Ptr;
+                  begin
+                     --  Compute driving value of brothers.
+                     Resolv := Sig.S.Resolv;
+                     for I in Resolv.Sig_Range.First .. Resolv.Sig_Range.Last
+                     loop
+                        S := Sig_Table.Table (I);
+                        if S.Flags.Propag /= Propag_None then
+                           Internal_Error ("order_signal(1)");
+                        end if;
+                        S.Flags.Propag := Propag_Being_Driving;
+                     end loop;
+                     for I in Resolv.Sig_Range.First .. Resolv.Sig_Range.Last
+                     loop
+                        S := Sig_Table.Table (I);
+                        --  Compute driving value of the sources.
+                        for J in 1 .. S.Nbr_Ports loop
+                           Order_Signal (S.Ports (J - 1), Propag_Driving);
+                        end loop;
+                     end loop;
+                     for I in Resolv.Sig_Range.First .. Resolv.Sig_Range.Last
+                     loop
+                        S := Sig_Table.Table (I);
+                        S.Flags.Propag := Propag_Driving;
+                     end loop;
+
+                     if Is_Eff_Drv (Sig) then
+                        if Resolv.Sig_Range.First = Resolv.Sig_Range.Last then
+                           Add_Propagation ((Kind => Eff_One_Resolved,
+                                             Sig => Sig));
+                        else
+                           Add_Propagation ((Kind => Eff_Multiple,
+                                             Resolv => Resolv));
+                        end if;
+                     else
+                        if Resolv.Sig_Range.First = Resolv.Sig_Range.Last then
+                           Add_Propagation ((Kind => Drv_One_Resolved,
+                                             Sig => Sig));
+                        else
+                           Add_Propagation ((Kind => Drv_Multiple,
+                                             Resolv => Resolv));
+                        end if;
+                     end if;
+                  end;
+               end if;
+            when Mode_Signal_Implicit =>
+               Sig.Flags.Propag := Propag_Being_Driving;
+               Order_Signal_List (Sig, Propag_Done);
+               Sig.Flags.Propag := Propag_Done;
+               case Mode_Signal_Implicit (Sig.S.Mode_Sig) is
+                  when Mode_Guard =>
+                     Add_Propagation ((Kind => Imp_Guard, Sig => Sig));
+                  when Mode_Stable =>
+                     Add_Propagation ((Kind => Imp_Stable, Sig => Sig));
+                  when Mode_Quiet =>
+                     Add_Propagation ((Kind => Imp_Quiet, Sig => Sig));
+                  when Mode_Transaction =>
+                     Add_Propagation ((Kind => Imp_Transaction, Sig => Sig));
+                  when Mode_Delayed =>
+                     Add_Propagation ((Kind => Imp_Delayed, Sig => Sig));
+               end case;
+               return;
+            when Mode_Conv_In =>
+               --  In conversion signals have no driving value
+               null;
+            when Mode_Conv_Out =>
+               declare
+                  Conv : Sig_Conversion_Acc;
+               begin
+                  Conv := Sig.S.Conv;
+                  for I in Conv.Dest.First .. Conv.Dest.Last loop
+                     Sig_Table.Table (I).Flags.Propag := Propag_Being_Driving;
+                  end loop;
+                  for I in Conv.Src.First .. Conv.Src.Last loop
+                     Order_Signal (Sig_Table.Table (I), Propag_Driving);
+                  end loop;
+                  Add_Propagation ((Kind => Out_Conversion, Conv => Conv));
+                  for I in Conv.Dest.First .. Conv.Dest.Last loop
+                     Sig_Table.Table (I).Flags.Propag := Propag_Done;
+                  end loop;
+               end;
+            when Mode_End =>
+               Internal_Error ("order_signal: mode_end");
+         end case;
+      end if;
+
+      -- Effective value.
+      if Order = Propag_Driving then
+         --  Will be done later.
+         return;
+      end if;
+
+      case Sig.S.Mode_Sig is
+         when Mode_Signal
+           | Mode_Buffer =>
+            --  Effective value is driving value.
+            Sig.Flags.Propag := Propag_Done;
+         when Mode_Linkage
+           | Mode_Out =>
+            --  No effective value.
+            Sig.Flags.Propag := Propag_Done;
+         when Mode_Inout
+           | Mode_In =>
+            if Sig.S.Effective = null then
+               --  Effective value is driving value or initial value.
+               null;
+            else
+               Sig.Flags.Propag := Propag_Being_Effective;
+               Order_Signal (Sig.S.Effective, Propag_Done);
+               Add_Propagation ((Kind => Eff_Actual, Sig => Sig));
+               Sig.Flags.Propag := Propag_Done;
+            end if;
+         when Mode_Stable
+           | Mode_Guard
+           | Mode_Quiet
+           | Mode_Transaction
+           | Mode_Delayed =>
+            --  Sig.Propag is already set to PROPAG_DONE.
+            null;
+         when Mode_Conv_In =>
+            declare
+               Conv : Sig_Conversion_Acc;
+            begin
+               Conv := Sig.S.Conv;
+               for I in Conv.Dest.First .. Conv.Dest.Last loop
+                  Sig_Table.Table (I).Flags.Propag := Propag_Being_Effective;
+               end loop;
+               for I in Conv.Src.First .. Conv.Src.Last loop
+                  Order_Signal (Sig_Table.Table (I), Propag_Done);
+               end loop;
+               Add_Propagation ((Kind => In_Conversion, Conv => Conv));
+               for I in Conv.Dest.First .. Conv.Dest.Last loop
+                  Sig_Table.Table (I).Flags.Propag := Propag_Done;
+               end loop;
+            end;
+         when Mode_Conv_Out =>
+            --  No effective value.
+            null;
+         when Mode_End =>
+            Internal_Error ("order_signal: mode_end");
+      end case;
+   end Order_Signal;
+
+   procedure Set_Net (Sig : Ghdl_Signal_Ptr;
+                      Net : Signal_Net_Type;
+                      Link : Ghdl_Signal_Ptr)
+   is
+      use Astdio;
+      use Stdio;
+   begin
+      if Sig = null then
+         return;
+      end if;
+
+      if Boolean'(False) then
+         Put ("set_net ");
+         Put_I32 (stdout, Ghdl_I32 (Net));
+         Put (" on ");
+         Put (stdout, Sig.all'Address);
+         Put ("  ");
+         Disp_Signals.Disp_Mode_Signal (Sig.S.Mode_Sig);
+         New_Line;
+      end if;
+
+      if Sig.Net /= No_Signal_Net then
+         if Sig.Net /= Net then
+            --  Renumber.
+            if Boolean'(False) then
+               Put ("set_net renumber ");
+               Put_I32 (stdout, Ghdl_I32 (Net));
+               Put (" on ");
+               Put (stdout, Sig.all'Address);
+               New_Line;
+            end if;
+
+            declare
+               S : Ghdl_Signal_Ptr;
+               Old : Signal_Net_Type := Sig.Net;
+            begin
+               --  Merge the old net into NET.
+               S := Sig;
+               loop
+                  S.Net := Net;
+                  S := S.Link;
+                  exit when S = Sig;
+               end loop;
+
+               --  Add to the ring.
+               S := Sig.Link;
+               Sig.Link := Link.Link;
+               Link.Link := S;
+
+               --  Check.
+               for I in Sig_Table.First .. Sig_Table.Last loop
+                  if Sig_Table.Table (I).Net = Old then
+--                      Disp_Signals.Disp_Signals_Table;
+--                      Disp_Signals.Disp_Signals_Map;
+
+                     Internal_Error ("set_net: link corrupted");
+                  end if;
+               end loop;
+            end;
+         end if;
+         return;
+      end if;
+
+      Sig.Net := Net;
+
+      --  Add SIG in the LINK ring.
+      --  Note: this works even if LINK is not a ring (ie, LINK.link = null).
+      if Link.Link = null and then Sig /= Link then
+         Internal_Error ("set_net: bad link");
+      end if;
+      Sig.Link := Link.Link;
+      Link.Link := Sig;
+
+      --  Dependences.
+      case Sig.S.Mode_Sig is
+         when Mode_Signal_User =>
+            for I in 1 .. Sig.Nbr_Ports loop
+               Set_Net (Sig.Ports (I - 1), Net, Link);
+            end loop;
+            Set_Net (Sig.S.Effective, Net, Link);
+            if Sig.S.Resolv /= null then
+               for I in Sig.S.Resolv.Sig_Range.First
+                 .. Sig.S.Resolv.Sig_Range.Last
+               loop
+                  Set_Net (Sig_Table.Table (I), Net, Link);
+               end loop;
+            end if;
+         when Mode_Signal_Implicit =>
+            for I in 1 .. Sig.Nbr_Ports loop
+               Set_Net (Sig.Ports (I - 1), Net, Link);
+            end loop;
+         when Mode_Conv_In
+           | Mode_Conv_Out =>
+            declare
+               S : Ghdl_Signal_Ptr;
+               Conv : Sig_Conversion_Acc;
+            begin
+               Conv := Sig.S.Conv;
+               S := Sig_Table.Table (Conv.Src.First);
+               if Sig = S or else S.Net /= Net then
+                  for J in Conv.Src.First .. Conv.Src.Last loop
+                     Set_Net (Sig_Table.Table (J), Net, Link);
+                  end loop;
+                  for J in Conv.Dest.First .. Conv.Dest.Last loop
+                     Set_Net (Sig_Table.Table (J), Net, Link);
+                  end loop;
+               end if;
+            end;
+         when Mode_End =>
+            Internal_Error ("set_net");
+      end case;
+   end Set_Net;
+
+   function Get_Propagation_Net (P : Signal_Net_Type) return Signal_Net_Type
+   is
+   begin
+      case Propagation.Table (P).Kind is
+         when Drv_Multiple
+           | Eff_Multiple =>
+            return Sig_Table.Table
+              (Propagation.Table (P).Resolv.Sig_Range.First).Net;
+         when In_Conversion
+           | Out_Conversion =>
+            return Sig_Table.Table
+              (Propagation.Table (P).Conv.Src.First).Net;
+         when others =>
+            return Propagation.Table (P).Sig.Net;
+      end case;
+   end Get_Propagation_Net;
+
+   Last_Signal_Net : Signal_Net_Type;
+
+   --  Create a net for SIG, or if one of its dependences has already a net,
+   --  merge SIG in this net.
+   procedure Merge_Net (Sig : Ghdl_Signal_Ptr)
+   is
+   begin
+      if Sig.S.Mode_Sig in Mode_Signal_User then
+         if Sig.S.Resolv = null
+           and then Sig.Nbr_Ports = 0
+           and then Sig.S.Effective = null
+         then
+            Internal_Error ("create_nets(1)");
+         end if;
+
+         if Sig.S.Effective /= null
+           and then Sig.S.Effective.Net /= No_Signal_Net
+         then
+            --  Avoid to create a net, just merge.
+            Set_Net (Sig, Sig.S.Effective.Net, Sig.S.Effective);
+            return;
+         end if;
+      end if;
+
+      if Sig.Nbr_Ports >= 1
+        and then Sig.Ports (0).Net /= No_Signal_Net
+      then
+         --  Avoid to create a net, just merge.
+         Set_Net (Sig, Sig.Ports (0).Net, Sig.Ports (0));
+      else
+         Last_Signal_Net := Last_Signal_Net + 1;
+         Set_Net (Sig, Last_Signal_Net, Sig);
+      end if;
+   end Merge_Net;
+
+   --  Create nets.
+   --  For all signals, set the net field.
+   procedure Create_Nets
+   is
+      Sig : Ghdl_Signal_Ptr;
+   begin
+      Last_Signal_Net := No_Signal_Net;
+
+      for I in reverse Propagation.First .. Propagation.Last loop
+         case Propagation.Table (I).Kind is
+            when Drv_Error
+              | Prop_End =>
+               null;
+            when Drv_One_Driver
+              | Eff_One_Driver =>
+               null;
+            when Eff_One_Resolved =>
+               Sig := Propagation.Table (I).Sig;
+               --  Do not create a net if the signal has no dependences.
+               if Sig.Net = No_Signal_Net
+                 and then (Sig.S.Effective /= null or Sig.Nbr_Ports /= 0)
+               then
+                  Merge_Net (Sig);
+               end if;
+            when Drv_One_Port
+              | Eff_One_Port
+              | Imp_Guard
+              | Imp_Quiet
+              | Imp_Transaction
+              | Imp_Stable
+              | Imp_Delayed
+              | Eff_Actual
+              | Drv_One_Resolved =>
+               Sig := Propagation.Table (I).Sig;
+               if Sig.Net = No_Signal_Net then
+                  Merge_Net (Sig);
+               end if;
+            when Drv_Multiple
+              | Eff_Multiple =>
+               declare
+                  Resolv : Resolved_Signal_Acc;
+                  Link : Ghdl_Signal_Ptr;
+               begin
+                  Last_Signal_Net := Last_Signal_Net + 1;
+                  Resolv := Propagation.Table (I).Resolv;
+                  Link := Sig_Table.Table (Resolv.Sig_Range.First);
+                  for J in Resolv.Sig_Range.First .. Resolv.Sig_Range.Last loop
+                     Set_Net (Sig_Table.Table (J), Last_Signal_Net, Link);
+                  end loop;
+               end;
+            when In_Conversion
+              | Out_Conversion =>
+               declare
+                  Conv : Sig_Conversion_Acc;
+                  Link : Ghdl_Signal_Ptr;
+               begin
+                  Conv := Propagation.Table (I).Conv;
+                  Link := Sig_Table.Table (Conv.Src.First);
+                  if Link.Net = No_Signal_Net then
+                     Last_Signal_Net := Last_Signal_Net + 1;
+                     Set_Net (Link, Last_Signal_Net, Link);
+                  end if;
+               end;
+         end case;
+      end loop;
+
+      --  Reorder propagation table.
+      declare
+         type Off_Array is array (Signal_Net_Type range <>) of Signal_Net_Type;
+         type Off_Array_Acc is access Off_Array;
+         Offs : Off_Array_Acc;
+         procedure Free is new Ada.Unchecked_Deallocation
+           (Name => Off_Array_Acc, Object => Off_Array);
+
+         Last_Off : Signal_Net_Type;
+         Num : Signal_Net_Type;
+
+--          procedure Disp_Offs
+--          is
+--             use Grt.Astdio;
+--             use Grt.Stdio;
+--          begin
+--             for I in Offs'Range loop
+--                if Offs (I) /= 0 then
+--                   Put_I32 (stdout, Ghdl_I32 (I));
+--                   Put (": ");
+--                   Put_I32 (stdout, Ghdl_I32 (Offs (I)));
+--                   New_Line;
+--                end if;
+--             end loop;
+--          end Disp_Offs;
+
+         type Propag_Array is array (Signal_Net_Type range <>)
+           of Propagation_Type;
+         type Propag_Array_Acc is access Propag_Array;
+         Propag : Propag_Array_Acc;
+         procedure Free is new Ada.Unchecked_Deallocation
+           (Name => Propag_Array_Acc, Object => Propag_Array);
+
+         Net : Signal_Net_Type;
+      begin
+         --  1) Count number of propagation cell per net.
+         Offs := new Off_Array (0 .. Last_Signal_Net);
+         Offs.all := (others => 0);
+         for I in Propagation.First .. Propagation.Last loop
+            Net := Get_Propagation_Net (I);
+            Offs (Net) := Offs (Net) + 1;
+         end loop;
+         --  2) Convert this table into offsets.
+         Last_Off := 1;
+         for I in 1 .. Last_Signal_Net loop
+            Num := Offs (I);
+            if Num /= 0 then
+               --  Reserve one slot for a prepended 'prop_end'.
+               Offs (I) := Last_Off + 1;
+               Last_Off := Last_Off + 1 + Num;
+            end if;
+         end loop;
+         Num := Offs (0);
+         Offs (0) := Last_Off + 1;
+         --Last_Off := Last_Off + 1 + Num - 1;
+
+         --  3) Re-order the table (by a copy).
+         Propag := new Propag_Array (1 .. Last_Off);
+         for I in Propagation.First .. Propagation.Last loop
+            Net := Get_Propagation_Net (I);
+            if Net /= No_Signal_Net then
+               Propag (Offs (Net)) := Propagation.Table (I);
+               Offs (Net) := Offs (Net) + 1;
+            end if;
+         end loop;
+         Propagation.Set_Last (Last_Off);
+         Propagation.Release;
+         for I in Propagation.First .. Propagation.Last loop
+            Propagation.Table (I) := Propag (I);
+         end loop;
+         Free (Propag);
+         for I in 1 .. Last_Signal_Net loop
+            --  Ignore holes.
+            if Offs (I) /= 0 then
+               Propagation.Table (Offs (I)) :=
+                 (Kind => Prop_End, Updated => True);
+            end if;
+         end loop;
+         Propagation.Table (1) := (Kind => Prop_End, Updated => True);
+
+         --  4) Convert back from offset to start position (on the prop_end
+         --     cell).
+         Offs (0) := 1;
+         Last_Off := 1;
+         for I in 1 .. Last_Signal_Net loop
+            if Offs (I) /= 0 then
+               Num := Offs (I);
+               Offs (I) := Last_Off;
+               Last_Off := Num;
+            end if;
+         end loop;
+
+         --  5) Re-map the nets to cell indexes.
+         for I in Sig_Table.First .. Sig_Table.Last loop
+            Sig := Sig_Table.Table (I);
+            if Sig.Net = No_Signal_Net then
+               if Sig.S.Resolv /= null then
+                  Sig.Net := Net_One_Resolved;
+               elsif Sig.S.Nbr_Drivers = 1 then
+                  Sig.Net := Net_One_Driver;
+               end if;
+            else
+               Sig.Net := Signal_Net_Type (Offs (Sig.Net));
+            end if;
+            Sig.Link := null;
+         end loop;
+         Free (Offs);
+      end;
+   end Create_Nets;
+
+   function Get_Nbr_Future return Ghdl_I32
+   is
+      Res : Ghdl_I32;
+      Sig : Ghdl_Signal_Ptr;
+   begin
+      Res := 0;
+      Sig := Future_List;
+      while Sig.Flink /= null loop
+         Res := Res + 1;
+         Sig := Sig.Flink;
+      end loop;
+      return Res;
+   end Get_Nbr_Future;
+
+   --  Check every scalar subelement of a resolved signal has a driver
+   --  in the same process.
+   procedure Check_Resolved_Driver (Resolv : Resolved_Signal_Acc)
+   is
+      First_Sig : Ghdl_Signal_Ptr;
+      Nbr : Ghdl_Index_Type;
+   begin
+      First_Sig := Sig_Table.Table (Resolv.Sig_Range.First);
+      Nbr := First_Sig.S.Nbr_Drivers;
+      for I in Resolv.Sig_Range.First + 1 .. Resolv.Sig_Range.Last loop
+         if Sig_Table.Table (I).S.Nbr_Drivers /= Nbr then
+            --  FIXME: provide more information (signal name, process name).
+            Error ("missing drivers for subelement of a resolved signal");
+         end if;
+      end loop;
+   end Check_Resolved_Driver;
+
+   Ieee_Std_Logic_1164_Resolved_Resolv_Ptr : Address;
+   pragma Import (C, Ieee_Std_Logic_1164_Resolved_Resolv_Ptr,
+                  "ieee__std_logic_1164__resolved_RESOLV_ptr");
+
+   procedure Free is new Ada.Unchecked_Deallocation
+     (Name => Resolved_Signal_Acc, Object => Resolved_Signal_Type);
+
+   procedure Order_All_Signals
+   is
+      Sig : Ghdl_Signal_Ptr;
+      Resolv : Resolved_Signal_Acc;
+   begin
+      --  Do checks and optimization.
+      for I in Sig_Table.First .. Sig_Table.Last loop
+         Sig := Sig_Table.Table (I);
+
+         --  LRM 5.3
+         --  If, by the above rules, no disconnection specification applies to
+         --  the drivers of a guarded, scalar signal S whose type mark is T
+         --  (including a scalar subelement of a composite signal), then the
+         --  following default disconnection specification is implicitly
+         --  assumed:
+         --    disconnect S : T after 0 ns;
+         if Sig.S.Mode_Sig in Mode_Signal_User then
+            Resolv := Sig.S.Resolv;
+            if Resolv /= null and then Resolv.Disconnect_Time = Bad_Time then
+               Resolv.Disconnect_Time := 0;
+            end if;
+
+            if Resolv /= null
+              and then Resolv.Sig_Range.First = I
+              and then Resolv.Sig_Range.Last > I
+            then
+               --  Check every scalar subelement of a resolved signal
+               --  has a driver in the same process.
+               Check_Resolved_Driver (Resolv);
+            end if;
+
+            if Resolv /= null
+              and then Resolv.Sig_Range.First = I
+              and then Resolv.Sig_Range.Last = I
+              and then (Resolv.Resolv_Proc
+                        = Ieee_Std_Logic_1164_Resolved_Resolv_Ptr)
+              and then Sig.S.Nbr_Drivers + Sig.Nbr_Ports <= 1
+            then
+               --  Optimization: remove resolver if there is at most one
+               --  source.
+               Free (Sig.S.Resolv);
+            end if;
+         end if;
+      end loop;
+
+      --  Really order them.
+      for I in Sig_Table.First .. Sig_Table.Last loop
+         Order_Signal (Sig_Table.Table (I), Propag_Driving);
+      end loop;
+      for I in Sig_Table.First .. Sig_Table.Last loop
+         Order_Signal (Sig_Table.Table (I), Propag_Done);
+      end loop;
+
+      Create_Nets;
+   end Order_All_Signals;
+
+   procedure Set_Guard_Activity (Sig : Ghdl_Signal_Ptr) is
+   begin
+      for I in 1 .. Sig.Nbr_Ports loop
+         if Sig.Ports (I - 1).Active then
+            Mark_Active (Sig);
+            return;
+         end if;
+      end loop;
+   end Set_Guard_Activity;
+
+   procedure Set_Stable_Quiet_Activity
+     (Mode : Propagation_Kind_Type; Sig : Ghdl_Signal_Ptr) is
+   begin
+      case Mode is
+         when Imp_Stable =>
+            for I in 0 .. Sig.Nbr_Ports - 1 loop
+               if Sig.Ports (I).Event then
+                  Mark_Active (Sig);
+                  return;
+               end if;
+            end loop;
+         when Imp_Quiet
+           | Imp_Transaction =>
+            for I in 0 .. Sig.Nbr_Ports - 1 loop
+               if Sig.Ports (I).Active then
+                  Mark_Active (Sig);
+                  return;
+               end if;
+            end loop;
+         when others =>
+            Internal_Error ("set_stable_quiet_activity");
+      end case;
+   end Set_Stable_Quiet_Activity;
+
+   function Get_Resolved_Activity (Sig : Ghdl_Signal_Ptr) return Boolean
+   is
+      Trans : Transaction_Acc;
+      Res : Boolean := False;
+   begin
+      for J in 1 .. Sig.S.Nbr_Drivers loop
+         Trans := Sig.S.Drivers (J - 1).First_Trans.Next;
+         if Trans /= null and then Trans.Time = Current_Time then
+            Free (Sig.S.Drivers (J - 1).First_Trans);
+            Sig.S.Drivers (J - 1).First_Trans := Trans;
+            Res := True;
+         end if;
+      end loop;
+      if Res then
+         return True;
+      end if;
+      for J in 1 .. Sig.Nbr_Ports loop
+         if Sig.Ports (J - 1).Active then
+            return True;
+         end if;
+      end loop;
+      return False;
+   end Get_Resolved_Activity;
+
+   procedure Set_Conversion_Activity (Conv : Sig_Conversion_Acc)
+   is
+      Active : Boolean := False;
+   begin
+      for I in Conv.Src.First .. Conv.Src.Last loop
+         Active := Active or Sig_Table.Table (I).Active;
+      end loop;
+      if Active then
+         Call_Conversion_Function (Conv);
+      end if;
+      for I in Conv.Dest.First .. Conv.Dest.Last loop
+         Sig_Table.Table (I).Active := Active;
+      end loop;
+   end Set_Conversion_Activity;
+
+   procedure Delayed_Implicit_Process (Sig : Ghdl_Signal_Ptr)
+   is
+      Pfx : Ghdl_Signal_Ptr;
+      Trans : Transaction_Acc;
+      Last : Transaction_Acc;
+      Prev : Transaction_Acc;
+   begin
+      Pfx := Sig.Ports (0);
+      if Pfx.Event then
+         --  LRM 14.1
+         --  P: process (S)
+         --  begin
+         --     R <= transport S after T;
+         --  end process;
+         Trans := new Transaction'(Kind => Trans_Value,
+                                   Time => Current_Time + Sig.S.Time,
+                                   Next => null,
+                                   Val => Pfx.Value);
+         --  Find the last transaction.
+         Last := Sig.S.Attr_Trans;
+         Prev := Last;
+         while Last.Next /= null loop
+            Prev := Last;
+            Last := Last.Next;
+         end loop;
+         --  Maybe, remove it.
+         if Last.Time > Trans.Time then
+            Internal_Error ("delayed time");
+         elsif Last.Time = Trans.Time then
+            if Prev = Last then
+               Internal_Error ("delayed");
+            end if;
+            Free (Last);
+         else
+            Prev := Last;
+         end if;
+         --  Append the transaction.
+         Prev.Next := Trans;
+         if Sig.S.Time = 0 then
+            Add_Active_List (Sig);
+         end if;
+      end if;
+   end Delayed_Implicit_Process;
+
+   --  Set the effective value of signal SIG to VAL.
+   --  If the value is different from the previous one, resume processes.
+   procedure Set_Effective_Value (Sig : Ghdl_Signal_Ptr; Val : Value_Union)
+   is
+      El : Action_List_Acc;
+   begin
+      if not Value_Equal (Sig.Value, Val, Sig.Mode) then
+         Sig.Last_Value := Sig.Value;
+         Sig.Value := Val;
+         Sig.Event := True;
+         Sig.Last_Event := Current_Time;
+         Sig.Flags.Cyc_Event := True;
+
+         El := Sig.Event_List;
+         while El /= null loop
+            case El.Kind is
+               when Action_Process =>
+                  Resume_Process (El.Proc);
+               when Action_Signal =>
+                  Internal_Error ("set_effective_value");
+            end case;
+            El := El.Next;
+         end loop;
+      end if;
+   end Set_Effective_Value;
+
+   procedure Run_Propagation (Start : Signal_Net_Type)
+   is
+      I : Signal_Net_Type;
+      Sig : Ghdl_Signal_Ptr;
+      Trans : Transaction_Acc;
+   begin
+      I := Start;
+      loop
+         --  First: the driving value.
+         case Propagation.Table (I).Kind is
+            when Drv_One_Driver
+              | Eff_One_Driver =>
+               Sig := Propagation.Table (I).Sig;
+               Trans := Sig.S.Drivers (0).First_Trans.Next;
+               if Trans /= null and then Trans.Time = Current_Time then
+                  Mark_Active (Sig);
+                  Free (Sig.S.Drivers (0).First_Trans);
+                  Sig.S.Drivers (0).First_Trans := Trans;
+                  case Trans.Kind is
+                     when Trans_Value =>
+                        Sig.Driving_Value := Trans.Val;
+                     when Trans_Null =>
+                        Error ("null transaction");
+                     when Trans_Error =>
+                        Error ("range check error on signal");
+                  end case;
+               end if;
+            when Drv_One_Resolved
+              | Eff_One_Resolved =>
+               Sig := Propagation.Table (I).Sig;
+               if Get_Resolved_Activity (Sig) then
+                  Mark_Active (Sig);
+                  Compute_Resolved_Signal (Propagation.Table (I).Sig.S.Resolv);
+               end if;
+            when Drv_One_Port
+              | Eff_One_Port =>
+               Sig := Propagation.Table (I).Sig;
+               if Sig.Ports (0).Active then
+                  Mark_Active (Sig);
+                  Sig.Driving_Value := Sig.Ports (0).Driving_Value;
+               end if;
+            when Eff_Actual =>
+               Sig := Propagation.Table (I).Sig;
+               --  Note: the signal may have drivers (inout ports).
+               if Sig.S.Effective.Active and not Sig.Active then
+                  Mark_Active (Sig);
+               end if;
+            when Drv_Multiple
+              | Eff_Multiple =>
+               declare
+                  Active : Boolean := False;
+                  Resolv : Resolved_Signal_Acc;
+               begin
+                  Resolv := Propagation.Table (I).Resolv;
+                  for I in Resolv.Sig_Range.First .. Resolv.Sig_Range.Last loop
+                     Sig := Sig_Table.Table (I);
+                     Active := Active or Get_Resolved_Activity (Sig);
+                  end loop;
+                  if Active then
+                     --  Mark the first signal as active (since only this one
+                     --  will be checked to set effective value).
+                     for I in Resolv.Sig_Range.First .. Resolv.Sig_Range.Last
+                     loop
+                        Mark_Active (Sig_Table.Table (I));
+                     end loop;
+                     Compute_Resolved_Signal (Resolv);
+                  end if;
+               end;
+            when Imp_Guard
+              | Imp_Stable
+              | Imp_Quiet
+              | Imp_Transaction =>
+               null;
+            when Imp_Delayed =>
+               Sig := Propagation.Table (I).Sig;
+               Trans := Sig.S.Attr_Trans.Next;
+               if Trans /= null and then Trans.Time = Current_Time then
+                  Mark_Active (Sig);
+                  Free (Sig.S.Attr_Trans);
+                  Sig.S.Attr_Trans := Trans;
+                  Sig.Driving_Value := Trans.Val;
+               end if;
+            when In_Conversion =>
+               null;
+            when Out_Conversion =>
+               Set_Conversion_Activity (Propagation.Table (I).Conv);
+            when Prop_End =>
+               return;
+            when Drv_Error =>
+               Internal_Error ("update signals");
+         end case;
+
+         --  Second: the effective value.
+         case Propagation.Table (I).Kind is
+            when Drv_One_Driver
+              | Drv_One_Port
+              | Drv_One_Resolved
+              | Drv_Multiple =>
+               null;
+            when Eff_One_Driver
+              | Eff_One_Port
+              | Eff_One_Resolved =>
+               Sig := Propagation.Table (I).Sig;
+               if Sig.Active then
+                  Set_Effective_Value (Sig, Sig.Driving_Value);
+               end if;
+            when Eff_Multiple =>
+               declare
+                  Resolv : Resolved_Signal_Acc;
+               begin
+                  Resolv := Propagation.Table (I).Resolv;
+                  if Sig_Table.Table (Resolv.Sig_Range.First).Active then
+                     --  If one signal is active, all are active.
+                     for I in Resolv.Sig_Range.First .. Resolv.Sig_Range.Last
+                     loop
+                        Sig := Sig_Table.Table (I);
+                        Set_Effective_Value (Sig, Sig.Driving_Value);
+                     end loop;
+                  end if;
+               end;
+            when Eff_Actual =>
+               Sig := Propagation.Table (I).Sig;
+               if Sig.Active then
+                  Set_Effective_Value (Sig, Sig.S.Effective.Value);
+               end if;
+            when Imp_Guard =>
+               --  Guard signal is active iff one of its dependence is active.
+               Sig := Propagation.Table (I).Sig;
+               Set_Guard_Activity (Sig);
+               if Sig.Active then
+                  Sig.Driving_Value.B2 :=
+                    Sig.S.Guard_Func.all (Sig.S.Guard_Instance);
+                  Set_Effective_Value (Sig, Sig.Driving_Value);
+               end if;
+            when Imp_Stable
+              | Imp_Quiet =>
+               Sig := Propagation.Table (I).Sig;
+               Set_Stable_Quiet_Activity (Propagation.Table (I).Kind, Sig);
+               if Sig.Active then
+                  Sig.Driving_Value :=
+                    Value_Union'(Mode => Mode_B2, B2 => False);
+                  --  Set driver.
+                  Trans := new Transaction'
+                    (Kind => Trans_Value,
+                     Time => Current_Time + Sig.S.Time,
+                     Next => null,
+                     Val => Value_Union'(Mode => Mode_B2, B2 => True));
+                  if Sig.S.Attr_Trans.Next /= null then
+                     Free (Sig.S.Attr_Trans.Next);
+                  end if;
+                  Sig.S.Attr_Trans.Next := Trans;
+                  Set_Effective_Value (Sig, Sig.Driving_Value);
+                  if Sig.S.Time = 0 then
+                     Add_Active_List (Sig);
+                  end if;
+               else
+                  Trans := Sig.S.Attr_Trans.Next;
+                  if Trans /= null and then Trans.Time = Current_Time then
+                     Mark_Active (Sig);
+                     Free (Sig.S.Attr_Trans);
+                     Sig.S.Attr_Trans := Trans;
+                     Sig.Driving_Value := Trans.Val;
+                     Set_Effective_Value (Sig, Sig.Driving_Value);
+                  end if;
+               end if;
+            when Imp_Transaction =>
+               --  LRM 12.6.3 Updating Implicit Signals
+               --  Finally, for any implicit signal S'Transaction, the current
+               --  value of the signal is modified if and only if S is active.
+               --  If signal S is active, then S'Transaction is updated by
+               --  assigning the value of the expression (not S'Transaction)
+               --  to the variable representing the current value of
+               --  S'Transaction.
+               Sig := Propagation.Table (I).Sig;
+               for I in 0 .. Sig.Nbr_Ports - 1 loop
+                  if Sig.Ports (I).Active then
+                     Mark_Active (Sig);
+                     Set_Effective_Value
+                       (Sig, Value_Union'(Mode => Mode_B2,
+                                          B2 => not Sig.Value.B2));
+                     exit;
+                  end if;
+               end loop;
+            when Imp_Delayed =>
+               Sig := Propagation.Table (I).Sig;
+               if Sig.Active then
+                  Set_Effective_Value (Sig, Sig.Driving_Value);
+               end if;
+               Delayed_Implicit_Process (Sig);
+            when In_Conversion =>
+               Set_Conversion_Activity (Propagation.Table (I).Conv);
+            when Out_Conversion =>
+               null;
+            when Prop_End =>
+               null;
+            when Drv_Error =>
+               Internal_Error ("run_propagation(2)");
+         end case;
+         I := I + 1;
+      end loop;
+   end Run_Propagation;
+
+   procedure Reset_Active_Flag
+   is
+      Sig : Ghdl_Signal_Ptr;
+   begin
+      --  1) Reset active flag.
+      Sig := Clear_List;
+      Clear_List := null;
+      while Sig /= null loop
+         if Options.Flag_Stats then
+            if Sig.Active then
+               Nbr_Active := Nbr_Active + 1;
+            end if;
+            if Sig.Event then
+               Nbr_Events := Nbr_Events + 1;
+            end if;
+         end if;
+         Sig.Active := False;
+         Sig.Event := False;
+
+         Sig := Sig.Alink;
+      end loop;
+
+--       for I in Sig_Table.First .. Sig_Table.Last loop
+--          Sig := Sig_Table.Table (I);
+--          if Sig.Active or Sig.Event then
+--             Internal_Error ("reset_active_flag");
+--          end if;
+--       end loop;
+   end Reset_Active_Flag;
+
+   procedure Update_Signals
+   is
+      Sig : Ghdl_Signal_Ptr;
+      Next_Sig : Ghdl_Signal_Ptr;
+      Trans : Transaction_Acc;
+   begin
+      --  LRM93 12.6.2
+      --  1) Reset active flag.
+      Reset_Active_Flag;
+
+      Sig := Active_List;
+      Active_List := Signal_End;
+      while Sig.S.Mode_Sig /= Mode_End loop
+         Next_Sig := Sig.Link;
+         Sig.Link := null;
+
+         case Sig.Net is
+            when Net_One_Driver =>
+               --  This signal is active.
+               Mark_Active (Sig);
+
+               Trans := Sig.S.Drivers (0).First_Trans.Next;
+               Free (Sig.S.Drivers (0).First_Trans);
+               Sig.S.Drivers (0).First_Trans := Trans;
+               case Trans.Kind is
+                  when Trans_Value =>
+                     Sig.Driving_Value := Trans.Val;
+                  when Trans_Null =>
+                     Error ("null transaction");
+                  when Trans_Error =>
+                     Error ("range check error on signal");
+               end case;
+               Set_Effective_Value (Sig, Sig.Driving_Value);
+
+            when Net_One_Resolved =>
+               --  This signal is active.
+               Mark_Active (Sig);
+
+               for J in 1 .. Sig.S.Nbr_Drivers loop
+                  Trans := Sig.S.Drivers (J - 1).First_Trans.Next;
+                  if Trans /= null and then Trans.Time = Current_Time then
+                     Free (Sig.S.Drivers (J - 1).First_Trans);
+                     Sig.S.Drivers (J - 1).First_Trans := Trans;
+                  end if;
+               end loop;
+               Compute_Resolved_Signal (Sig.S.Resolv);
+               Set_Effective_Value (Sig, Sig.Driving_Value);
+
+            when No_Signal_Net =>
+               Internal_Error ("update_signals: no_signal_net");
+
+            when others =>
+               if not Propagation.Table (Sig.Net).Updated then
+                  Propagation.Table (Sig.Net).Updated := True;
+                  Run_Propagation (Sig.Net + 1);
+
+                  --  Put it on the list.
+                  Add_Active_List (Sig);
+               end if;
+         end case;
+
+         Sig := Next_Sig;
+      end loop;
+
+      --  Un-mark updated.
+      Sig := Active_List;
+      Active_List := Signal_End;
+      while Sig.Link /= null loop
+         Propagation.Table (Sig.Net).Updated := False;
+         Next_Sig := Sig.Link;
+         Sig.Link := null;
+
+         --  Maybe put SIG in the active list, if it will be active during
+         --  the next cycle.
+         --  This can happen only for 'quiet, 'stable or 'delayed.
+         case Sig.S.Mode_Sig is
+            when Mode_Stable
+              | Mode_Quiet
+              | Mode_Delayed =>
+               declare
+                  Trans : Transaction_Acc;
+               begin
+                  Trans := Sig.S.Attr_Trans.Next;
+                  if Trans /= null and then Trans.Time = Current_Time then
+                     Sig.Link := Active_List;
+                     Active_List := Sig;
+                  end if;
+               end;
+            when others =>
+               null;
+         end case;
+
+         Sig := Next_Sig;
+      end loop;
+   end Update_Signals;
+
+   procedure Run_Propagation_Init (Start : Signal_Net_Type)
+   is
+      I : Signal_Net_Type;
+      Sig : Ghdl_Signal_Ptr;
+   begin
+      I := Start;
+      loop
+         --  First: the driving value.
+         case Propagation.Table (I).Kind is
+            when Drv_One_Driver
+              | Eff_One_Driver =>
+               --  Nothing to do: drivers were already created.
+               null;
+            when Drv_One_Resolved
+              | Eff_One_Resolved =>
+               --  Execute the resolution function.
+               Sig := Propagation.Table (I).Sig;
+               if Sig.Nbr_Ports > 0 then
+                  Compute_Resolved_Signal (Sig.S.Resolv);
+               end if;
+            when Drv_One_Port
+              | Eff_One_Port =>
+               --  Copy value.
+               Sig := Propagation.Table (I).Sig;
+               Sig.Driving_Value := Sig.Ports (0).Driving_Value;
+            when Eff_Actual =>
+               null;
+            when Drv_Multiple
+              | Eff_Multiple =>
+               Compute_Resolved_Signal (Propagation.Table (I).Resolv);
+            when Imp_Guard
+              | Imp_Stable
+              | Imp_Quiet
+              | Imp_Transaction =>
+               null;
+            when Imp_Delayed =>
+               --  LRM 14.1
+               --  Assuming that the initial value of R is the same as the
+               --  initial value of S, [...]
+               Sig := Propagation.Table (I).Sig;
+               Sig.Driving_Value := Sig.Ports (0).Driving_Value;
+            when In_Conversion =>
+               null;
+            when Out_Conversion =>
+               Call_Conversion_Function (Propagation.Table (I).Conv);
+            when Prop_End =>
+               return;
+            when Drv_Error =>
+               Internal_Error ("init_signals");
+         end case;
+
+         --  Second: the effective value.
+         case Propagation.Table (I).Kind is
+            when Drv_One_Driver
+              | Drv_One_Port
+              | Drv_One_Resolved
+              | Drv_Multiple =>
+               null;
+            when Eff_One_Driver
+              | Eff_One_Port
+              | Eff_One_Resolved
+              | Imp_Delayed =>
+               Sig := Propagation.Table (I).Sig;
+               Sig.Value := Sig.Driving_Value;
+            when Eff_Multiple =>
+               declare
+                  Resolv : Resolved_Signal_Acc;
+               begin
+                  Resolv := Propagation.Table (I).Resolv;
+                  for I in Resolv.Sig_Range.First .. Resolv.Sig_Range.Last loop
+                     Sig := Sig_Table.Table (I);
+                     Sig.Value := Sig.Driving_Value;
+                  end loop;
+               end;
+            when Eff_Actual =>
+               Sig := Propagation.Table (I).Sig;
+               Sig.Value := Sig.S.Effective.Value;
+            when Imp_Guard =>
+               --  Guard signal is active iff one of its dependence is active.
+               Sig := Propagation.Table (I).Sig;
+               Sig.Driving_Value.B2 :=
+                 Sig.S.Guard_Func.all (Sig.S.Guard_Instance);
+               Sig.Value := Sig.Driving_Value;
+            when Imp_Stable
+              | Imp_Quiet
+              | Imp_Transaction =>
+               --  Already initialized during creation.
+               null;
+            when In_Conversion =>
+               Call_Conversion_Function (Propagation.Table (I).Conv);
+            when Out_Conversion =>
+               null;
+            when Prop_End =>
+               null;
+            when Drv_Error =>
+               Internal_Error ("init_signals(2)");
+         end case;
+
+         I := I + 1;
+      end loop;
+   end Run_Propagation_Init;
+
+   procedure Init_Signals
+   is
+      Sig : Ghdl_Signal_Ptr;
+   begin
+      for I in Sig_Table.First .. Sig_Table.Last loop
+         Sig := Sig_Table.Table (I);
+
+         case Sig.Net is
+            when Net_One_Driver =>
+               --  Nothing to do: drivers were already created.
+               null;
+
+            when Net_One_Resolved =>
+               if Sig.Nbr_Ports > 0 then
+                  Compute_Resolved_Signal (Sig.S.Resolv);
+                  Sig.Value := Sig.Driving_Value;
+               end if;
+
+            when No_Signal_Net =>
+               null;
+
+            when others =>
+               if Propagation.Table (Sig.Net).Updated then
+                  Propagation.Table (Sig.Net).Updated := False;
+                  Run_Propagation_Init (Sig.Net + 1);
+               end if;
+         end case;
+      end loop;
+
+   end Init_Signals;
+
+   procedure Init is
+   begin
+      Signal_End := new Ghdl_Signal'(Value => (Mode => Mode_B2,
+                                               B2 => False),
+                                     Driving_Value => (Mode => Mode_B2,
+                                                       B2 => False),
+                                     Last_Value => (Mode => Mode_B2,
+                                                    B2 => False),
+                                     Last_Event => 0,
+                                     Last_Active => 0,
+                                     Event => False,
+                                     Active => False,
+                                     Mode => Mode_B2,
+
+                                     Flags => (Propag => Propag_None,
+                                               Has_Active => False,
+                                               Is_Dumped => False,
+                                               Cyc_Event => False),
+
+                                     Net => No_Signal_Net,
+                                     Link => null,
+                                     Alink => null,
+                                     Flink => null,
+
+                                     Event_List => null,
+                                     Rti => null,
+
+                                     Nbr_Ports => 0,
+                                     Ports => null,
+
+                                     S => (Mode_Sig => Mode_End));
+
+      Active_List := Signal_End;
+      Future_List := Signal_End;
+
+      Boolean_Signal_Rti.Obj_Type := Std_Standard_Boolean_RTI_Ptr;
+      Bit_Signal_Rti.Obj_Type := Std_Standard_Bit_RTI_Ptr;
+   end Init;
+
+end Grt.Signals;
diff --git a/translate/grt/grt-signals.ads b/translate/grt/grt-signals.ads
new file mode 100644
index 000000000..c78bf52f2
--- /dev/null
+++ b/translate/grt/grt-signals.ads
@@ -0,0 +1,720 @@
+--  GHDL Run Time (GRT) - signals management.
+--  Copyright (C) 2002, 2003, 2004, 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;
+with Ada.Unchecked_Conversion;
+with GNAT.Table;
+with Grt.Types; use Grt.Types;
+with Grt.Rtis; use Grt.Rtis;
+
+package Grt.Signals is
+   pragma Suppress (All_Checks);
+
+   --  Kind of transaction.
+   type Transaction_Kind is
+     (
+      --  Normal transaction, with a value.
+      Trans_Value,
+      --  Null transaction.
+      Trans_Null,
+      --  Like a normal transaction, but without a value due to check error.
+      Trans_Error
+     );
+
+   type Transaction;
+   type Transaction_Acc is access Transaction;
+   type Transaction (Kind : Transaction_Kind) is record
+      Time : Std_Time;
+      Next : Transaction_Acc;
+      case Kind is
+         when Trans_Value =>
+            Val : Value_Union;
+         when Trans_Null =>
+            null;
+         when Trans_Error =>
+            --  FIXME: should have a location field, to be able to display
+            --  a message.
+            null;
+      end case;
+   end record;
+
+   --  A driver is bound to a process (PROC) and contains a list of
+   --  transactions.
+   type Driver_Type is record
+      First_Trans : Transaction_Acc;
+      Last_Trans : Transaction_Acc;
+      Proc : Process_Id;
+   end record;
+
+   type Driver_Acc is access all Driver_Type;
+   type Driver_Fat_Array is array (Ghdl_Index_Type) of aliased Driver_Type;
+   type Driver_Arr_Ptr is access Driver_Fat_Array;
+
+   --  Function access type used to evaluate the guard expression.
+   type Guard_Func_Acc is access function (This : System.Address)
+     return Ghdl_B2;
+
+   --  Simply linked list of processes to be resumed in case of events.
+
+   type Ghdl_Signal;
+   type Ghdl_Signal_Ptr is access Ghdl_Signal;
+
+   function To_Ghdl_Signal_Ptr is new Ada.Unchecked_Conversion
+     (Source => System.Address, Target => Ghdl_Signal_Ptr);
+
+   type Signal_Fat_Array is array (Ghdl_Index_Type) of Ghdl_Signal_Ptr;
+   type Signal_Arr_Ptr is access Signal_Fat_Array;
+
+   function To_Signal_Arr_Ptr is new Ada.Unchecked_Conversion
+     (Source => System.Address, Target => Signal_Arr_Ptr);
+
+   type Action_List;
+   type Action_List_Acc is access Action_List;
+   type Action_Kind is (Action_Signal, Action_Process);
+   type Action_List (Kind : Action_Kind) is record
+      Next : Action_List_Acc;
+      case Kind is
+         when Action_Signal =>
+            Sig : Ghdl_Signal_Ptr;
+         when Action_Process =>
+            Proc : Process_Id;
+      end case;
+   end record;
+
+   --  How to compute resolved signal.
+   type Resolved_Signal_Type is record
+      Resolv_Proc : System.Address;
+      Resolv_Inst : System.Address;
+      Resolv_Ptr : System.Address;
+      Sig_Range : Sig_Table_Range;
+      Disconnect_Time : Std_Time;
+   end record;
+
+   type Resolved_Signal_Acc is access Resolved_Signal_Type;
+
+   --  Signal conversion data.
+   type Sig_Conversion_Type is record
+      --  Function which performs the conversion.
+      Func : System.Address;
+      Instance : System.Address;
+
+      Src : Sig_Table_Range;
+      Dest : Sig_Table_Range;
+   end record;
+   type Sig_Conversion_Acc is access Sig_Conversion_Type;
+
+   --  Used to order the signals for the propagation of signals values.
+   type Propag_Order_Flag is
+     (
+      --  The signal was not yet ordered.
+      Propag_None,
+      --  The signal is being ordered for driving value.
+      --  This stage is used to catch loop (which can not occur).
+      Propag_Being_Driving,
+      --  The signal has been ordered for driving value.
+      Propag_Driving,
+      --  The signal is being ordered for effective value.
+      Propag_Being_Effective,
+      --  The signal has completly been ordered.
+      Propag_Done);
+
+   --  Each signal belongs to a signal_net.
+   --  Signals on the same net must be updated in order.
+   --  Signals on different nets have no direct relation-ship, and thus may
+   --  be updated without order.
+   --  Net NO_SIGNAL_NET is special: it groups all lonely signals.
+   type Signal_Net_Type is new Integer;
+   No_Signal_Net : constant Signal_Net_Type := 0;
+   Net_One_Driver : constant Signal_Net_Type := -1;
+   Net_One_Resolved : constant Signal_Net_Type := -2;
+
+   --  Flush the list of active signals.
+   procedure Flush_Active_List;
+
+   type Ghdl_Signal_Data (Mode_Sig : Mode_Signal_Type := Mode_Signal)
+   is record
+      case Mode_Sig is
+         when Mode_Signal_User =>
+            Nbr_Drivers : Ghdl_Index_Type;
+            Drivers : Driver_Arr_Ptr;
+
+            --  Signal which defines the effective value of this signal,
+            --  if any.
+            Effective : Ghdl_Signal_Ptr;
+
+            --  Null if not resolved.
+            Resolv : Resolved_Signal_Acc;
+
+         when Mode_Conv_In
+           | Mode_Conv_Out =>
+            --  Conversion paramaters for conv_in, conv_out.
+            Conv : Sig_Conversion_Acc;
+
+         when Mode_Stable
+           | Mode_Quiet
+           | Mode_Delayed =>
+            --  Time parameter for 'stable, 'quiet or 'delayed
+            Time : Std_Time;
+            Attr_Trans : Transaction_Acc;
+
+         when Mode_Guard =>
+            --  Guard function and instance used to compute the
+            --  guard expression.
+            Guard_Func : Guard_Func_Acc;
+            Guard_Instance : System.Address;
+
+         when Mode_Transaction
+           | Mode_End =>
+            null;
+      end case;
+   end record;
+   pragma Suppress (Discriminant_Check, On => Ghdl_Signal_Data);
+
+   type Ghdl_Signal_Flags is record
+      --  Status of the ordering.
+      Propag : Propag_Order_Flag;
+
+      --  If set, the activity of the signal is required by the user.
+      Has_Active : Boolean;
+
+      --  If set, the signal is dumped in a GHW file.
+      Is_Dumped : Boolean;
+
+      --  Set when an event occured.
+      --  Only reset by GHW file dumper.
+      Cyc_Event : Boolean;
+   end record;
+   pragma Pack (Ghdl_Signal_Flags);
+
+   type Ghdl_Signal is record
+      --  Fields known by ghdl.
+      Value : Value_Union;
+      Driving_Value : Value_Union;
+      Last_Value : Value_Union;
+      Last_Event : Std_Time;
+      Last_Active : Std_Time;
+      Event : Boolean;
+      Active : Boolean;
+
+      --  Internal fields.
+      --  Values mode of this signal.
+      Mode : Mode_Type;
+
+      --  Misc flags.
+      Flags : Ghdl_Signal_Flags;
+
+      --  Net of the signal.
+      Net : Signal_Net_Type;
+
+      --  Chain of signals.
+      --  Used to build nets.
+      --  This is also the simply linked list of future active signals.
+      Link : Ghdl_Signal_Ptr;
+
+      --  Chain of signals whose active flag was set.  Used to clear it.
+      Alink : Ghdl_Signal_Ptr;
+
+      --  Chain of signals that have a projected waveform in the real future.
+      Flink : Ghdl_Signal_Ptr;
+
+      --  List of processes to resume when there is an event on
+      --  this signal.
+      Event_List : Action_List_Acc;
+
+      --  Path of the signal (with its name) in the design hierarchy.
+      --  Used to get the type of the signal.
+      Rti : Ghdl_Rtin_Object_Acc;
+
+      --  For user signals: the sources of a signals are drivers
+      --  and connected ports.
+      --  For implicit signals: PORTS is used as dependence list.
+      Nbr_Ports : Ghdl_Index_Type;
+      Ports : Signal_Arr_Ptr;
+
+      --  Mode of the signal (in, out ...)
+      --Mode_Signal : Mode_Signal_Type;
+      S : Ghdl_Signal_Data;
+   end record;
+
+   --  Each simple signal declared can be accessed by SIG_TABLE.
+   package Sig_Table is new GNAT.Table
+     (Table_Component_Type => Ghdl_Signal_Ptr,
+      Table_Index_Type => Sig_Table_Index,
+      Table_Low_Bound => 0,
+      Table_Initial => 128,
+      Table_Increment => 100);
+
+   --  Return the next time at which a driver becomes active.
+   function Find_Next_Time return Std_Time;
+
+   --  Elementary propagation computation.
+   --  See LRM 12.6.2 and 12.6.3
+   type Propagation_Kind_Type is
+     (
+      --  How to compute driving value:
+      --  Default value.
+      Drv_Error,
+
+      --  One source, a driver and not resolved:
+      --  the driving value is the driver.
+      Drv_One_Driver,
+
+      --  Same as previous, and the effective value is the driving value.
+      Eff_One_Driver,
+
+      --  One source, a port and not resolved:
+      --  the driving value is the driving value of the port.
+      --  Dependence.
+      Drv_One_Port,
+
+      --  Same as previous, and the effective value is the driving value.
+      Eff_One_Port,
+
+      --  Several sources or resolved:
+      --  signal is not composite.
+      Drv_One_Resolved,
+      Eff_One_Resolved,
+
+      --  Use the resolution function, signal is composite.
+      Drv_Multiple,
+
+      --  Same as previous, but the effective value is the previous value.
+      Eff_Multiple,
+
+      --  The effective value is the actual associated.
+      Eff_Actual,
+
+      --  Implicit guard signal.
+      --  Its value must be evaluated after the effective value of its
+      --  dependences.
+      Imp_Guard,
+
+      --  Implicit stable.
+      --  Its value must be evaluated after the effective value of its
+      --  dependences.
+      Imp_Stable,
+
+      --  Implicit quiet.
+      --  Its value must be evaluated after the driving value of its
+      --  dependences.
+      Imp_Quiet,
+
+      --  Implicit transaction.
+      --  Its value must be evaluated after the driving value of its
+      --  dependences.
+      Imp_Transaction,
+
+      --  Implicit delayed
+      --  Its value must be evaluated after the driving value of its
+      --  dependences.
+      Imp_Delayed,
+
+      --  in_conversion.
+      --  Pseudo-signal which is set by conversion function.
+      In_Conversion,
+      Out_Conversion,
+
+      --  End of propagation.
+      Prop_End
+      );
+
+   type Propagation_Type (Kind : Propagation_Kind_Type := Drv_Error) is record
+      case Kind is
+         when Drv_Error =>
+            null;
+         when Drv_One_Driver
+           | Eff_One_Driver
+           | Drv_One_Port
+           | Eff_One_Port
+           | Imp_Guard
+           | Imp_Quiet
+           | Imp_Transaction
+           | Imp_Stable
+           | Imp_Delayed
+           | Eff_Actual
+           | Eff_One_Resolved
+           | Drv_One_Resolved =>
+            Sig : Ghdl_Signal_Ptr;
+         when Drv_Multiple
+           | Eff_Multiple =>
+            Resolv : Resolved_Signal_Acc;
+         when In_Conversion
+           | Out_Conversion =>
+            Conv : Sig_Conversion_Acc;
+         when Prop_End =>
+            Updated : Boolean;
+      end case;
+   end record;
+
+   package Propagation is new GNAT.Table
+     (Table_Component_Type => Propagation_Type,
+      Table_Index_Type => Signal_Net_Type,
+      Table_Low_Bound => 1,
+      Table_Initial => 128,
+      Table_Increment => 100);
+
+   --  Get the signal index of PTR.
+   function Signal_Ptr_To_Index (Ptr : Ghdl_Signal_Ptr) return Sig_Table_Index;
+
+   --  Compute propagation order of signals.
+   procedure Order_All_Signals;
+
+   --  Initialize the package (mainly the lists).
+   procedure Init;
+
+   --  Initialize all signals.
+   procedure Init_Signals;
+
+   --  Update signals.
+   procedure Update_Signals;
+
+   --  Add PROC in the list of processes to be resumed in case of event on
+   --  SIG.
+   procedure Resume_Process_If_Event
+     (Sig : Ghdl_Signal_Ptr; Proc : Process_Id);
+
+   procedure Ghdl_Signal_Name_Rti (Sig : Ghdl_Rti_Access;
+                                   Ctxt : Ghdl_Rti_Access;
+                                   Addr : System.Address);
+
+   procedure Ghdl_Signal_Merge_Rti (Sig : Ghdl_Signal_Ptr;
+                                    Rti : Ghdl_Rti_Access);
+
+   --  Performs some internal checks on signals (transaction order).
+   --  Internal_error is called in case of error.
+   procedure Ghdl_Signal_Internal_Checks;
+
+   --  Subprograms to be called by generated code.
+   procedure Ghdl_Signal_Simple_Assign_Error (Sign : Ghdl_Signal_Ptr);
+   procedure Ghdl_Signal_Start_Assign_Error (Sign : Ghdl_Signal_Ptr;
+                                             Rej : Std_Time;
+                                             After : Std_Time);
+
+   procedure Ghdl_Signal_Set_Disconnect (Sign : Ghdl_Signal_Ptr;
+                                         Time : Std_Time);
+
+   procedure Ghdl_Signal_Disconnect (Sign : Ghdl_Signal_Ptr);
+
+   procedure Ghdl_Signal_Start_Assign_Null (Sign : Ghdl_Signal_Ptr;
+                                            Rej : Std_Time;
+                                            After : Std_Time);
+
+   function Ghdl_Signal_Driving (Sig : Ghdl_Signal_Ptr) return Ghdl_B2;
+
+   function Ghdl_Create_Signal_B2
+     (Init_Val : Ghdl_B2;
+      Resolv_Func : System.Address;
+      Resolv_Inst : System.Address)
+     return Ghdl_Signal_Ptr;
+   procedure Ghdl_Signal_Init_B2 (Sig : Ghdl_Signal_Ptr; Init_Val : Ghdl_B2);
+   procedure Ghdl_Signal_Associate_B2 (Sig : Ghdl_Signal_Ptr; Val : Ghdl_B2);
+   procedure Ghdl_Signal_Simple_Assign_B2 (Sign : Ghdl_Signal_Ptr;
+                                           Val : Ghdl_B2);
+   procedure Ghdl_Signal_Start_Assign_B2 (Sign : Ghdl_Signal_Ptr;
+                                          Rej : Std_Time;
+                                          Val : Ghdl_B2;
+                                          After : Std_Time);
+   procedure Ghdl_Signal_Next_Assign_B2 (Sign : Ghdl_Signal_Ptr;
+                                         Val : Ghdl_B2;
+                                         After : Std_Time);
+   function Ghdl_Signal_Driving_Value_B2 (Sig : Ghdl_Signal_Ptr)
+                                         return Ghdl_B2;
+
+   function Ghdl_Create_Signal_E8
+     (Init_Val : Ghdl_E8;
+      Resolv_Func : System.Address;
+      Resolv_Inst : System.Address)
+     return Ghdl_Signal_Ptr;
+   procedure Ghdl_Signal_Init_E8 (Sig : Ghdl_Signal_Ptr; Init_Val : Ghdl_E8);
+   procedure Ghdl_Signal_Associate_E8 (Sig : Ghdl_Signal_Ptr; Val : Ghdl_E8);
+   procedure Ghdl_Signal_Simple_Assign_E8 (Sign : Ghdl_Signal_Ptr;
+                                           Val : Ghdl_E8);
+   procedure Ghdl_Signal_Start_Assign_E8 (Sign : Ghdl_Signal_Ptr;
+                                          Rej : Std_Time;
+                                          Val : Ghdl_E8;
+                                          After : Std_Time);
+   procedure Ghdl_Signal_Next_Assign_E8 (Sign : Ghdl_Signal_Ptr;
+                                         Val : Ghdl_E8;
+                                         After : Std_Time);
+   function Ghdl_Signal_Driving_Value_E8 (Sig : Ghdl_Signal_Ptr)
+                                         return Ghdl_E8;
+
+   function Ghdl_Create_Signal_I32
+     (Init_Val : Ghdl_I32;
+      Resolv_Func : System.Address;
+      Resolv_Inst : System.Address)
+     return Ghdl_Signal_Ptr;
+   procedure Ghdl_Signal_Init_I32 (Sig : Ghdl_Signal_Ptr; Init_Val : Ghdl_I32);
+   procedure Ghdl_Signal_Associate_I32 (Sig : Ghdl_Signal_Ptr; Val : Ghdl_I32);
+   procedure Ghdl_Signal_Simple_Assign_I32 (Sign : Ghdl_Signal_Ptr;
+                                            Val : Ghdl_I32);
+   procedure Ghdl_Signal_Start_Assign_I32 (Sign : Ghdl_Signal_Ptr;
+                                           Rej : Std_Time;
+                                           Val : Ghdl_I32;
+                                           After : Std_Time);
+   procedure Ghdl_Signal_Next_Assign_I32 (Sign : Ghdl_Signal_Ptr;
+                                          Val : Ghdl_I32;
+                                          After : Std_Time);
+   function Ghdl_Signal_Driving_Value_I32 (Sig : Ghdl_Signal_Ptr)
+                                         return Ghdl_I32;
+
+   function Ghdl_Create_Signal_I64
+     (Init_Val : Ghdl_I64;
+      Resolv_Func : System.Address;
+      Resolv_Inst : System.Address)
+     return Ghdl_Signal_Ptr;
+   procedure Ghdl_Signal_Init_I64 (Sig : Ghdl_Signal_Ptr; Init_Val : Ghdl_I64);
+   procedure Ghdl_Signal_Associate_I64 (Sig : Ghdl_Signal_Ptr; Val : Ghdl_I64);
+   procedure Ghdl_Signal_Simple_Assign_I64 (Sign : Ghdl_Signal_Ptr;
+                                            Val : Ghdl_I64);
+   procedure Ghdl_Signal_Start_Assign_I64 (Sign : Ghdl_Signal_Ptr;
+                                           Rej : Std_Time;
+                                           Val : Ghdl_I64;
+                                           After : Std_Time);
+   procedure Ghdl_Signal_Next_Assign_I64 (Sign : Ghdl_Signal_Ptr;
+                                          Val : Ghdl_I64;
+                                          After : Std_Time);
+   function Ghdl_Signal_Driving_Value_I64 (Sig : Ghdl_Signal_Ptr)
+                                          return Ghdl_I64;
+
+   function Ghdl_Create_Signal_F64
+     (Init_Val : Ghdl_F64;
+      Resolv_Func : System.Address;
+      Resolv_Inst : System.Address)
+     return Ghdl_Signal_Ptr;
+   procedure Ghdl_Signal_Init_F64 (Sig : Ghdl_Signal_Ptr; Init_Val : Ghdl_F64);
+   procedure Ghdl_Signal_Associate_F64 (Sig : Ghdl_Signal_Ptr; Val : Ghdl_F64);
+   procedure Ghdl_Signal_Simple_Assign_F64 (Sign : Ghdl_Signal_Ptr;
+                                            Val : Ghdl_F64);
+   procedure Ghdl_Signal_Start_Assign_F64 (Sign : Ghdl_Signal_Ptr;
+                                           Rej : Std_Time;
+                                           Val : Ghdl_F64;
+                                           After : Std_Time);
+   procedure Ghdl_Signal_Next_Assign_F64 (Sign : Ghdl_Signal_Ptr;
+                                          Val : Ghdl_F64;
+                                          After : Std_Time);
+   function Ghdl_Signal_Driving_Value_F64 (Sig : Ghdl_Signal_Ptr)
+                                         return Ghdl_F64;
+
+   --  Add a driver to SIGN for the current process.
+   procedure Ghdl_Process_Add_Driver (Sign : Ghdl_Signal_Ptr);
+
+   --  Used for connexions:
+   --  SRC is a source for TARG.
+   procedure Ghdl_Signal_Add_Source (Targ : Ghdl_Signal_Ptr;
+                                     Src : Ghdl_Signal_Ptr);
+
+   --  Add an in conversion (from SRC to DEST using function FUNC).
+   procedure Ghdl_Signal_In_Conversion (Func : System.Address;
+                                        Instance : System.Address;
+                                        Src : Ghdl_Signal_Ptr;
+                                        Src_Len : Ghdl_Index_Type;
+                                        Dst : Ghdl_Signal_Ptr;
+                                        Dst_Len : Ghdl_Index_Type);
+   procedure Ghdl_Signal_Out_Conversion (Func : System.Address;
+                                         Instance : System.Address;
+                                         Src : Ghdl_Signal_Ptr;
+                                         Src_Len : Ghdl_Index_Type;
+                                         Dst : Ghdl_Signal_Ptr;
+                                         Dst_Len : Ghdl_Index_Type);
+
+   --  Mark the next signals as resolved.
+   procedure Ghdl_Signal_Create_Resolution (Proc : System.Address;
+                                            Instance : System.Address;
+                                            Sig : System.Address;
+                                            Nbr_Sig : Ghdl_Index_Type);
+
+   --  The effective value of TARG is the effective value of SRC.
+   procedure Ghdl_Signal_Effective_Value (Targ : Ghdl_Signal_Ptr;
+                                          Src : Ghdl_Signal_Ptr);
+
+   --  Create a new 'stable (VAL) signal.
+   function Ghdl_Create_Stable_Signal (Val : Std_Time) return Ghdl_Signal_Ptr;
+   --  Create a new 'quiet (VAL) signal.
+   function Ghdl_Create_Quiet_Signal (Val : Std_Time) return Ghdl_Signal_Ptr;
+
+   --  Create a new 'transaction signal.
+   function Ghdl_Create_Transaction_Signal return Ghdl_Signal_Ptr;
+
+   --  Create a new SIG'delayed (VAL) signal.
+   function Ghdl_Create_Delayed_Signal (Sig : Ghdl_Signal_Ptr; Val : Std_Time)
+                                       return Ghdl_Signal_Ptr;
+
+   --  Add SIG in the set of prefix for the last created signal.
+   procedure Ghdl_Signal_Attribute_Register_Prefix (Sig : Ghdl_Signal_Ptr);
+
+   --  Create a new implicitly defined GUARD signal.
+   function Ghdl_Signal_Create_Guard (This : System.Address;
+                                      Proc : Guard_Func_Acc)
+     return Ghdl_Signal_Ptr;
+   --  Add SIG to the list of referenced signals that appear in the guard
+   --  expression.
+   procedure Ghdl_Signal_Guard_Dependence (Sig : Ghdl_Signal_Ptr);
+
+   --  Return number of ports/drivers.
+   function Ghdl_Signal_Get_Nbr_Ports (Sig : Ghdl_Signal_Ptr)
+                                      return Ghdl_Index_Type;
+   function Ghdl_Signal_Get_Nbr_Drivers (Sig : Ghdl_Signal_Ptr)
+                                        return Ghdl_Index_Type;
+
+   function Ghdl_Signal_Read_Port
+     (Sig : Ghdl_Signal_Ptr; Index : Ghdl_Index_Type)
+     return Ghdl_Value_Ptr;
+   function Ghdl_Signal_Read_Driver
+     (Sig : Ghdl_Signal_Ptr; Index : Ghdl_Index_Type)
+     return Ghdl_Value_Ptr;
+
+   --  Statistics.
+   Nbr_Active : Ghdl_I32;
+   Nbr_Events: Ghdl_I32;
+   function Get_Nbr_Future return Ghdl_I32;
+private
+   pragma Export (C, Ghdl_Signal_Name_Rti,
+                  "__ghdl_signal_name_rti");
+   pragma Export (C, Ghdl_Signal_Merge_Rti,
+                  "__ghdl_signal_merge_rti");
+
+   pragma Export (C, Ghdl_Signal_Simple_Assign_Error,
+                  "__ghdl_signal_simple_assign_error");
+   pragma Export (C, Ghdl_Signal_Start_Assign_Error,
+                  "__ghdl_signal_start_assign_error");
+
+   pragma Export (C, Ghdl_Signal_Start_Assign_Null,
+                  "__ghdl_signal_start_assign_null");
+
+   pragma Export (C, Ghdl_Signal_Set_Disconnect,
+                  "__ghdl_signal_set_disconnect");
+   pragma Export (C, Ghdl_Signal_Disconnect,
+                  "__ghdl_signal_disconnect");
+
+   pragma Export (C, Ghdl_Signal_Driving,
+                  "__ghdl_signal_driving");
+
+   pragma Export (C, Ghdl_Create_Signal_B2,
+                  "__ghdl_create_signal_b2");
+   pragma Export (C, Ghdl_Signal_Init_B2,
+                  "__ghdl_signal_init_b2");
+   pragma Export (C, Ghdl_Signal_Associate_B2,
+                  "__ghdl_signal_associate_b2");
+   pragma Export (C, Ghdl_Signal_Simple_Assign_B2,
+                  "__ghdl_signal_simple_assign_b2");
+   pragma Export (C, Ghdl_Signal_Start_Assign_B2,
+                  "__ghdl_signal_start_assign_b2");
+   pragma Export (C, Ghdl_Signal_Next_Assign_B2,
+                  "__ghdl_signal_next_assign_b2");
+   pragma Export (C, Ghdl_Signal_Driving_Value_B2,
+                  "__ghdl_signal_driving_value_b2");
+
+   pragma Export (C, Ghdl_Create_Signal_E8,
+                  "__ghdl_create_signal_e8");
+   pragma Export (C, Ghdl_Signal_Init_E8,
+                  "__ghdl_signal_init_e8");
+   pragma Export (C, Ghdl_Signal_Associate_E8,
+                  "__ghdl_signal_associate_e8");
+   pragma Export (C, Ghdl_Signal_Simple_Assign_E8,
+                  "__ghdl_signal_simple_assign_e8");
+   pragma Export (C, Ghdl_Signal_Start_Assign_E8,
+                  "__ghdl_signal_start_assign_e8");
+   pragma Export (C, Ghdl_Signal_Next_Assign_E8,
+                  "__ghdl_signal_next_assign_e8");
+   pragma Export (C, Ghdl_Signal_Driving_Value_E8,
+                  "__ghdl_signal_driving_value_e8");
+
+   pragma Export (C, Ghdl_Create_Signal_I32,
+                  "__ghdl_create_signal_i32");
+   pragma Export (C, Ghdl_Signal_Init_I32,
+                  "__ghdl_signal_init_i32");
+   pragma Export (C, Ghdl_Signal_Associate_I32,
+                  "__ghdl_signal_associate_i32");
+   pragma Export (C, Ghdl_Signal_Simple_Assign_I32,
+                  "__ghdl_signal_simple_assign_i32");
+   pragma Export (C, Ghdl_Signal_Start_Assign_I32,
+                  "__ghdl_signal_start_assign_i32");
+   pragma Export (C, Ghdl_Signal_Next_Assign_I32,
+                  "__ghdl_signal_next_assign_i32");
+   pragma Export (C, Ghdl_Signal_Driving_Value_I32,
+                  "__ghdl_signal_driving_value_i32");
+
+   pragma Export (C, Ghdl_Create_Signal_I64,
+                  "__ghdl_create_signal_i64");
+   pragma Export (C, Ghdl_Signal_Init_I64,
+                  "__ghdl_signal_init_i64");
+   pragma Export (C, Ghdl_Signal_Associate_I64,
+                  "__ghdl_signal_associate_i64");
+   pragma Export (C, Ghdl_Signal_Simple_Assign_I64,
+                  "__ghdl_signal_simple_assign_i64");
+   pragma Export (C, Ghdl_Signal_Start_Assign_I64,
+                  "__ghdl_signal_start_assign_i64");
+   pragma Export (C, Ghdl_Signal_Next_Assign_I64,
+                  "__ghdl_signal_next_assign_i64");
+   pragma Export (C, Ghdl_Signal_Driving_Value_I64,
+                  "__ghdl_signal_driving_value_i64");
+
+   pragma Export (C, Ghdl_Create_Signal_F64,
+                  "__ghdl_create_signal_f64");
+   pragma Export (C, Ghdl_Signal_Init_F64,
+                  "__ghdl_signal_init_f64");
+   pragma Export (C, Ghdl_Signal_Associate_F64,
+                  "__ghdl_signal_associate_f64");
+   pragma Export (C, Ghdl_Signal_Simple_Assign_F64,
+                  "__ghdl_signal_simple_assign_f64");
+   pragma Export (C, Ghdl_Signal_Start_Assign_F64,
+                  "__ghdl_signal_start_assign_f64");
+   pragma Export (C, Ghdl_Signal_Next_Assign_F64,
+                  "__ghdl_signal_next_assign_f64");
+   pragma Export (C, Ghdl_Signal_Driving_Value_F64,
+                  "__ghdl_signal_driving_value_f64");
+
+   pragma Export (C, Ghdl_Process_Add_Driver,
+                  "__ghdl_process_add_driver");
+   pragma Export (C, Ghdl_Signal_Add_Source,
+                  "__ghdl_signal_add_source");
+   pragma Export (C, Ghdl_Signal_Effective_Value,
+                  "__ghdl_signal_effective_value");
+   pragma Export (C, Ghdl_Signal_In_Conversion,
+                  "__ghdl_signal_in_conversion");
+   pragma Export (C, Ghdl_Signal_Out_Conversion,
+                  "__ghdl_signal_out_conversion");
+
+   pragma Export (C, Ghdl_Signal_Create_Resolution,
+                  "__ghdl_signal_create_resolution");
+
+   pragma Export (C, Ghdl_Create_Stable_Signal,
+                  "__ghdl_create_stable_signal");
+   pragma Export (C, Ghdl_Create_Quiet_Signal,
+                  "__ghdl_create_quiet_signal");
+   pragma Export (C, Ghdl_Create_Transaction_Signal,
+                  "__ghdl_create_transaction_signal");
+   pragma Export (C, Ghdl_Signal_Attribute_Register_Prefix,
+                  "__ghdl_signal_attribute_register_prefix");
+   pragma Export (C, Ghdl_Create_Delayed_Signal,
+                  "__ghdl_create_delayed_signal");
+
+   pragma Export (C, Ghdl_Signal_Create_Guard,
+                  "__ghdl_signal_create_guard");
+   pragma Export (C, Ghdl_Signal_Guard_Dependence,
+                  "__ghdl_signal_guard_dependence");
+
+   pragma Export (C, Ghdl_Signal_Get_Nbr_Ports,
+                  "__ghdl_signal_get_nbr_ports");
+   pragma Export (C, Ghdl_Signal_Get_Nbr_Drivers,
+                  "__ghdl_signal_get_nbr_drivers");
+   pragma Export (C, Ghdl_Signal_Read_Port,
+                  "__ghdl_signal_read_port");
+   pragma Export (C, Ghdl_Signal_Read_Driver,
+                  "__ghdl_signal_read_driver");
+end Grt.Signals;
diff --git a/translate/grt/grt-stack2.adb b/translate/grt/grt-stack2.adb
new file mode 100644
index 000000000..17bb2c990
--- /dev/null
+++ b/translate/grt/grt-stack2.adb
@@ -0,0 +1,198 @@
+--  GHDL Run Time (GRT) - secondary stack.
+--  Copyright (C) 2002, 2003, 2004, 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 Ada.Unchecked_Conversion;
+with Ada.Unchecked_Deallocation;
+with Grt.Errors; use Grt.Errors;
+with Grt.Stdio;
+with Grt.Astdio;
+
+package body Grt.Stack2 is
+   --  This should be storage_elements.storage_element, but I don't want to
+   --  use system.storage_elements package (not pure).  Unfortunatly, this is
+   --  currently a failure (storage_elements is automagically used).
+   type Memory is array (Mark_Id range <>) of Character;
+
+   type Chunk_Type (First, Last : Mark_Id);
+   type Chunk_Acc is access all Chunk_Type;
+   type Chunk_Type (First, Last : Mark_Id) is record
+      Next : Chunk_Acc;
+      Mem : Memory (First .. Last);
+   end record;
+
+   type Stack2_Type is record
+      First_Chunk : Chunk_Acc;
+      Last_Chunk : Chunk_Acc;
+      Top : Mark_Id;
+   end record;
+   type Stack2_Acc is access all Stack2_Type;
+
+   function To_Acc is new Ada.Unchecked_Conversion
+     (Source => Stack2_Ptr, Target => Stack2_Acc);
+   function To_Addr is new Ada.Unchecked_Conversion
+     (Source => Stack2_Acc, Target => Stack2_Ptr);
+
+   procedure Free is new Ada.Unchecked_Deallocation
+     (Object => Chunk_Type, Name => Chunk_Acc);
+
+   function Mark (S : Stack2_Ptr) return Mark_Id
+   is
+      S2 : Stack2_Acc;
+   begin
+      S2 := To_Acc (S);
+      return S2.Top;
+   end Mark;
+
+   procedure Release (S : Stack2_Ptr; Mark : Mark_Id)
+   is
+      S2 : Stack2_Acc;
+   begin
+      S2 := To_Acc (S);
+      S2.Top := Mark;
+   end Release;
+
+   function Allocate (S : Stack2_Ptr; Size : Ghdl_Index_Type)
+     return System.Address
+   is
+      pragma Suppress (All_Checks);
+
+      S2 : Stack2_Acc;
+      Chunk : Chunk_Acc;
+      N_Chunk : Chunk_Acc;
+
+      Max_Align : constant Mark_Id := Mark_Id (Standard'Maximum_Alignment);
+      Max_Size  : constant Mark_Id :=
+        ((Mark_Id (Size) + Max_Align - 1) / Max_Align) * Max_Align;
+
+      Res : System.Address;
+   begin
+      S2 := To_Acc (S);
+
+      --  Find the chunk to which S2.TOP belong.
+      Chunk := S2.First_Chunk;
+      loop
+         exit when S2.Top >= Chunk.First and S2.Top <= Chunk.Last;
+         Chunk := Chunk.Next;
+         exit when Chunk = null;
+      end loop;
+
+      if Chunk /= null then
+         --  If there is enough place in it, allocate from the chunk.
+         if S2.Top + Max_Size <= Chunk.Last then
+            Res := Chunk.Mem (S2.Top)'Address;
+            S2.Top := S2.Top + Max_Size;
+            return Res;
+         end if;
+
+         --  If there is not enough place in it:
+         --    find a chunk which has enough room, deallocate skipped chunk.
+         loop
+            N_Chunk := Chunk.Next;
+            exit when N_Chunk = null;
+            if N_Chunk.Last - N_Chunk.First + 1 < Max_Size then
+               --  Not enough place in this chunk.
+               Chunk.Next := N_Chunk.Next;
+               Free (N_Chunk);
+               if Chunk.Next = null then
+                  S2.Last_Chunk := Chunk;
+                  exit;
+               end if;
+            else
+               Res := N_Chunk.Mem (N_Chunk.First)'Address;
+               S2.Top := N_Chunk.First + Max_Size;
+               return Res;
+            end if;
+         end loop;
+      end if;
+
+      --    If not such chunk, allocate a chunk
+      S2.Top := S2.Last_Chunk.Last + 1;
+      Chunk := new Chunk_Type (First => S2.Top,
+                               Last => S2.Top + Max_Size - 1);
+      Chunk.Next := null;
+      S2.Last_Chunk.Next := Chunk;
+      S2.Last_Chunk := Chunk;
+      S2.Top := Chunk.Last + 1;
+      return Chunk.Mem (Chunk.First)'Address;
+   end Allocate;
+
+   function Create return Stack2_Ptr is
+      Res : Stack2_Acc;
+      Chunk : Chunk_Acc;
+   begin
+      Chunk := new Chunk_Type (First => 1, Last => 8 * 1024);
+      Chunk.Next := null;
+      Res := new Stack2_Type'(First_Chunk => Chunk,
+                              Last_Chunk => Chunk,
+                              Top => 1);
+      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);
+
+   procedure Dump_Stack2 (S : Stack2_Ptr)
+   is
+      use Grt.Astdio;
+      use Grt.Stdio;
+      use System;
+      function To_Address is new Ada.Unchecked_Conversion
+        (Source => Chunk_Acc, Target => Address);
+      function To_Address is new Ada.Unchecked_Conversion
+        (Source => Mark_Id, Target => Address);
+      S2 : Stack2_Acc;
+      Chunk : Chunk_Acc;
+   begin
+      S2 := To_Acc (S);
+      Put ("Stack 2 at ");
+      Put (stdout, Address (S));
+      New_Line;
+      Put ("First Chunk at ");
+      Put (stdout, To_Address (S2.First_Chunk));
+      Put (", last chunk at ");
+      Put (stdout, To_Address (S2.Last_Chunk));
+      Put (", top at ");
+      Put (stdout, To_Address (S2.Top));
+      New_Line;
+      Chunk := S2.First_Chunk;
+      while Chunk /= null loop
+         Put ("Chunk ");
+         Put (stdout, To_Address (Chunk));
+         Put (": first: ");
+         Put (stdout, To_Address (Chunk.First));
+         Put (", last: ");
+         Put (stdout, To_Address (Chunk.Last));
+         Put (", len: ");
+         Put (stdout, To_Address (Chunk.Last - Chunk.First + 1));
+         Put (", next = ");
+         Put (stdout, To_Address (Chunk.Next));
+         New_Line;
+         Chunk := Chunk.Next;
+      end loop;
+   end Dump_Stack2;
+end Grt.Stack2;
diff --git a/translate/grt/grt-stack2.ads b/translate/grt/grt-stack2.ads
new file mode 100644
index 000000000..3be035b31
--- /dev/null
+++ b/translate/grt/grt-stack2.ads
@@ -0,0 +1,36 @@
+--  GHDL Run Time (GRT) - secondary stack.
+--  Copyright (C) 2002, 2003, 2004, 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;
+with Grt.Types; use Grt.Types;
+
+--  Secondary stack management.
+package Grt.Stack2 is
+   type Stack2_Ptr is new System.Address;
+   Null_Stack2_Ptr : constant Stack2_Ptr := Stack2_Ptr (System.Null_Address);
+
+   type Mark_Id is new Integer_Address;
+
+   function Mark (S : Stack2_Ptr) return Mark_Id;
+   procedure Release (S : Stack2_Ptr; Mark : Mark_Id);
+   function Allocate (S : Stack2_Ptr; Size : Ghdl_Index_Type)
+     return System.Address;
+   function Create return Stack2_Ptr;
+
+   --  Check S is empty.
+   procedure Check_Empty (S : Stack2_Ptr);
+end Grt.Stack2;
diff --git a/translate/grt/grt-stacks.adb b/translate/grt/grt-stacks.adb
new file mode 100644
index 000000000..a6e53f8f3
--- /dev/null
+++ b/translate/grt/grt-stacks.adb
@@ -0,0 +1,36 @@
+--  GHDL Run Time (GRT) - process stacks.
+--  Copyright (C) 2002, 2003, 2004, 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.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/translate/grt/grt-stacks.ads b/translate/grt/grt-stacks.ads
new file mode 100644
index 000000000..2624f5c2b
--- /dev/null
+++ b/translate/grt/grt-stacks.ads
@@ -0,0 +1,67 @@
+--  GHDL Run Time (GRT) - process stacks.
+--  Copyright (C) 2002, 2003, 2004, 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; use System;
+
+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.
+   procedure Stack_Init;
+
+   --  Create a new stack, which on first execution will call FUNC with
+   --  an argument ARG.
+   function Stack_Create (Func : Address; Arg : Address) 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
+   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");
+   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/translate/grt/grt-stats.adb b/translate/grt/grt-stats.adb
new file mode 100644
index 000000000..9e3259cd0
--- /dev/null
+++ b/translate/grt/grt-stats.adb
@@ -0,0 +1,326 @@
+--  GHDL Run Time (GRT) - statistics.
+--  Copyright (C) 2002, 2003, 2004, 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; use System;
+with Grt.Stdio; use Grt.Stdio;
+with Grt.Astdio; use Grt.Astdio;
+with Grt.Signals;
+with Grt.Processes;
+with Grt.Types; use Grt.Types;
+with Grt.Disp;
+
+package body Grt.Stats is
+   type Clock_T is new Integer;
+
+   type Time_Stats is record
+      Wall : Clock_T;
+      User : Clock_T;
+      Sys : Clock_T;
+   end record;
+
+   --  Number of CLOCK_T per second.
+   One_Second : Clock_T;
+
+
+   --  Get number of seconds per CLOCK_T.
+   function Get_Clk_Tck return Clock_T;
+   pragma Import (C, Get_Clk_Tck, "grt_get_clk_tck");
+
+   --  Get wall, user and system times.
+   --  This is a binding to times(2).
+   procedure Get_Times (Wall : Address; User : Address; Sys : Address);
+   pragma Import (C, Get_Times, "grt_get_times");
+
+   procedure Get_Stats (Stats : out Time_Stats)
+   is
+   begin
+      Get_Times (Stats.Wall'Address, Stats.User'Address, Stats.Sys'Address);
+   end Get_Stats;
+
+   function "-" (L : Time_Stats; R : Time_Stats) return Time_Stats
+   is
+   begin
+      return Time_Stats'(Wall => L.Wall - R.Wall,
+                         User => L.User - R.User,
+                         Sys => L.Sys - R.Sys);
+   end "-";
+
+   function "+" (L : Time_Stats; R : Time_Stats) return Time_Stats
+   is
+   begin
+      return Time_Stats'(Wall => L.Wall + R.Wall,
+                         User => L.User + R.User,
+                         Sys => L.Sys + R.Sys);
+   end "+";
+
+   procedure Put (Stream : FILEs; Val : Clock_T)
+   is
+      Fmt : constant String := "%3d.%03d" & Character'Val (0);
+
+      procedure fprintf (Stream : FILEs; Fmt : Address; A, B : Clock_T);
+      pragma Import (C, fprintf);
+
+      Sec : Clock_T;
+      Ms : Clock_T;
+   begin
+      Sec := Val / One_Second;
+
+      --  Avoid overflow.
+      Ms := ((Val mod One_Second) * 1000) / One_Second;
+
+      fprintf (Stream, Fmt'Address, Sec, Ms);
+   end Put;
+
+   procedure Put (Stream : FILEs; T : Time_Stats) is
+   begin
+      Put (Stream, "wall: ");
+      Put (Stream, T.Wall);
+      Put (Stream, "  user: ");
+      Put (Stream, T.User);
+      Put (Stream, "  sys: ");
+      Put (Stream, T.Sys);
+   end Put;
+
+   --  Stats at origin.
+   Start_Time : Time_Stats;
+   End_Elab_Time : Time_Stats;
+   End_Order_Time : Time_Stats;
+
+   Start_Proc_Time : Time_Stats;
+   Proc_Times : Time_Stats;
+
+   Start_Update_Time : Time_Stats;
+   Update_Times : Time_Stats;
+
+   Start_Next_Time_Time : Time_Stats;
+   Next_Time_Times : 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);
+   end Start_Elaboration;
+
+   procedure Start_Order is
+   begin
+      Get_Stats (End_Elab_Time);
+   end Start_Order;
+
+   procedure Start_Cycles is
+   begin
+      Get_Stats (End_Order_Time);
+   end Start_Cycles;
+
+   procedure Start_Processes is
+   begin
+      Get_Stats (Start_Proc_Time);
+   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);
+   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);
+   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 End_Simulation
+   is
+      Now : Time_Stats;
+   begin
+      Get_Stats (Now);
+      Simu_Time := Now - Start_Time;
+   end End_Simulation;
+
+   procedure Disp_Signals_Stats
+   is
+      use Grt.Signals;
+      Nbr_No_Drivers : Ghdl_I32;
+      Nbr_Resolv : Ghdl_I32;
+      Nbr_Multi_Src : Ghdl_I32;
+      Nbr_Active : Ghdl_I32;
+
+      type Propagation_Kind_Array is array (Propagation_Kind_Type) of Ghdl_I32;
+      Propag_Count : Propagation_Kind_Array;
+
+      type Mode_Array is array (Mode_Type) of Ghdl_I32;
+      Mode_Counts : Mode_Array;
+
+      type Mode_Name_Type is array (Mode_Type) of String (1 .. 4);
+      Mode_Names : constant Mode_Name_Type := (Mode_B2 => "B2: ",
+                                               Mode_E8 => "E8: ",
+                                               Mode_E32 => "E32:",
+                                               Mode_I32 => "I32:",
+                                               Mode_I64 => "I64:",
+                                               Mode_F64 => "F64:");
+   begin
+      Put (stdout, "Number of simple signals: ");
+      Put_I32 (stdout, Ghdl_I32 (Sig_Table.Last - Sig_Table.First + 1));
+      New_Line;
+      Put (stdout, "Number of signals with projected wave: ");
+      Put_I32 (stdout, Get_Nbr_Future);
+      New_Line;
+
+      Nbr_No_Drivers := 0;
+      Nbr_Resolv := 0;
+      Nbr_Multi_Src := 0;
+      Nbr_Active := 0;
+      Mode_Counts := (others => 0);
+      for I in Sig_Table.First .. Sig_Table.Last loop
+         declare
+            Sig : Ghdl_Signal_Ptr;
+         begin
+            Sig := Sig_Table.Table (I);
+            if Sig.S.Mode_Sig in Mode_Signal_User then
+               if Sig.S.Nbr_Drivers = 0 then
+                  Nbr_No_Drivers := Nbr_No_Drivers + 1;
+               end if;
+               if Sig.S.Nbr_Drivers + Sig.Nbr_Ports > 1 then
+                  Nbr_Multi_Src := Nbr_Multi_Src + 1;
+               end if;
+               if Sig.S.Resolv /= null then
+                  Nbr_Resolv := Nbr_Resolv + 1;
+               end if;
+            end if;
+            Mode_Counts (Sig.Mode) := Mode_Counts (Sig.Mode) + 1;
+            if Sig.Flags.Has_Active then
+               Nbr_Active := Nbr_Active + 1;
+            end if;
+         end;
+      end loop;
+      Put (stdout, "Number of non-driven simple signals: ");
+      Put_I32 (stdout, Nbr_No_Drivers);
+      New_Line;
+      Put (stdout, "Number of resolved simple signals: ");
+      Put_I32 (stdout, Nbr_Resolv);
+      New_Line;
+      Put (stdout, "Number of multi-sourced signals: ");
+      Put_I32 (stdout, Nbr_Multi_Src);
+      New_Line;
+      Put (stdout, "Number of signals whose activity is managed: ");
+      Put_I32 (stdout, Nbr_Active);
+      New_Line;
+      Put (stdout, "Number of signals per mode:");
+      New_Line;
+      for I in Mode_Type loop
+         Put (stdout, "  ");
+         Put (stdout, Mode_Names (I));
+         Put (stdout, "  ");
+         Put_I32 (stdout, Mode_Counts (I));
+         New_Line;
+      end loop;
+      New_Line;
+
+      Propag_Count := (others => 0);
+      for I in Propagation.First .. Propagation.Last loop
+         Propag_Count (Propagation.Table (I).Kind) :=
+           Propag_Count (Propagation.Table (I).Kind) + 1;
+      end loop;
+
+      Put (stdout, "Propagation table length: ");
+      Put_I32 (stdout, Ghdl_I32 (Grt.Signals.Propagation.Last));
+      New_Line;
+      Put (stdout, "Propagation table count:");
+      New_Line;
+      for I in Propagation_Kind_Type loop
+         if Propag_Count (I) /= 0 then
+            Put (stdout, "  ");
+            Grt.Disp.Disp_Propagation_Kind (I);
+            Put (stdout, ": ");
+            Put_I32 (stdout, Propag_Count (I));
+            New_Line;
+         end if;
+      end loop;
+   end Disp_Signals_Stats;
+
+   --  Disp all statistics.
+   procedure Disp_Stats is
+   begin
+      Put (stdout, "total:          ");
+      Put (stdout, Simu_Time);
+      New_Line (stdout);
+      Put (stdout, " elab:          ");
+      Put (stdout, End_Elab_Time - Start_Time);
+      New_Line (stdout);
+      Put (stdout, " internal elab: ");
+      Put (stdout, End_Order_Time - End_Elab_Time);
+      New_Line (stdout);
+      Put (stdout, " cycle (sum):   ");
+      Put (stdout, Proc_Times + Update_Times + Next_Time_Times);
+      New_Line (stdout);
+      Put (stdout, "  processes:    ");
+      Put (stdout, Proc_Times);
+      New_Line (stdout);
+      Put (stdout, "  update:       ");
+      Put (stdout, Update_Times);
+      New_Line (stdout);
+      Put (stdout, "  next compute: ");
+      Put (stdout, Next_Time_Times);
+      New_Line (stdout);
+
+      Disp_Signals_Stats;
+
+      Put (stdout, "Number of delta cycles: ");
+      Put_I32 (stdout, Ghdl_I32 (Processes.Nbr_Delta_Cycles));
+      New_Line;
+      Put (stdout, "Number of non-delta cycles: ");
+      Put_I32 (stdout, Ghdl_I32 (Processes.Nbr_Cycles));
+      New_Line;
+
+      Put (stdout, "Nbr of events: ");
+      Put_I32 (stdout, Signals.Nbr_Events);
+      New_Line;
+      Put (stdout, "Nbr of active: ");
+      Put_I32 (stdout, Signals.Nbr_Active);
+      New_Line;
+
+      Put (stdout, "Number of processes: ");
+      Put_I32 (stdout, Ghdl_I32 (Grt.Processes.Get_Nbr_Processes));
+      New_Line;
+
+   end Disp_Stats;
+end Grt.Stats;
diff --git a/translate/grt/grt-stats.ads b/translate/grt/grt-stats.ads
new file mode 100644
index 000000000..c03f11b02
--- /dev/null
+++ b/translate/grt/grt-stats.ads
@@ -0,0 +1,44 @@
+--  GHDL Run Time (GRT) - statistics.
+--  Copyright (C) 2002, 2003, 2004, 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.
+
+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;
+
+   procedure End_Simulation;
+
+   --  Disp all statistics.
+   procedure Disp_Stats;
+end Grt.Stats;
+
+
+
diff --git a/translate/grt/grt-stdio.ads b/translate/grt/grt-stdio.ads
new file mode 100644
index 000000000..fad33226b
--- /dev/null
+++ b/translate/grt/grt-stdio.ads
@@ -0,0 +1,110 @@
+--  GHDL Run Time (GRT) - stdio binding.
+--  Copyright (C) 2002, 2003, 2004, 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;
+
+--  This package provides a thin binding to the stdio.h of the C library.
+--  It mimics GNAT package Interfaces.C_Streams.
+--  The purpose of this package is to remove dependencies on the GNAT run time.
+
+package Grt.Stdio is
+   pragma Preelaborate (Grt.Stdio);
+
+   --  Type FILE *.
+   type FILEs is new System.Address;
+
+   --  NULL for a stream.
+   NULL_Stream : constant FILEs;
+
+   --  Predefined streams.
+   function stdout return FILEs;
+   function stderr return FILEs;
+   function stdin return FILEs;
+
+   --  Type void * and char *.
+   subtype voids is System.Address;
+   subtype chars is System.Address;
+   subtype long is Long_Integer;
+
+   --  Type size_t.
+   type size_t is mod 2 ** Standard'Address_Size;
+
+   --  Type int.  It is an alias on Integer for simplicity.
+   subtype int is Integer;
+
+   --  The following subprograms are translation of the C prototypes.
+
+   function fopen (path: chars; mode : chars) return FILEs;
+
+   function fwrite (buffer : voids;
+                    size : size_t;
+                    count : size_t;
+                    stream : FILEs)
+                   return size_t;
+
+   function fread (buffer : voids;
+                   size : size_t;
+                   count : size_t;
+                   stream : FILEs)
+                  return size_t;
+
+   function fputc (c : int; stream : FILEs) return int;
+   procedure fputc (c : int; stream : FILEs);
+
+   function fputs (s : chars; stream : FILEs) return int;
+
+   function fgetc (stream : FILEs) return int;
+   function fgets (s : chars; size : int; stream : FILEs) return chars;
+   function ungetc (c : int; stream : FILEs) return int;
+
+   function fflush (stream : FILEs) return int;
+   procedure fflush (stream : FILEs);
+
+   function feof (stream : FILEs) return int;
+
+   function ftell (stream : FILEs) return long;
+
+   function fclose (stream : FILEs) return int;
+   procedure fclose (Stream : FILEs);
+private
+   --  This is a little bit dubious, but this package should be preelaborated,
+   --  and Null_Address is not static (since defined in the private part
+   --  of System).
+   --  I am pretty sure the C definition of NULL is 0.
+   NULL_Stream : constant FILEs := FILEs (System'To_Address (0));
+
+   pragma Import (C, fopen);
+
+   pragma Import (C, fwrite);
+   pragma Import (C, fread);
+
+   pragma Import (C, fputs);
+   pragma Import (C, fputc);
+
+   pragma Import (C, fgetc);
+   pragma Import (C, fgets);
+   pragma Import (C, ungetc);
+
+   pragma Import (C, fflush);
+   pragma Import (C, feof);
+   pragma Import (C, ftell);
+   pragma Import (C, fclose);
+
+   pragma Import (C, stdout, "__ghdl_get_stdout");
+   pragma Import (C, stderr, "__ghdl_get_stderr");
+   pragma Import (C, stdin, "__ghdl_get_stdin");
+end Grt.Stdio;
diff --git a/translate/grt/grt-types.ads b/translate/grt/grt-types.ads
new file mode 100644
index 000000000..5c8191070
--- /dev/null
+++ b/translate/grt/grt-types.ads
@@ -0,0 +1,294 @@
+--  GHDL Run Time (GRT) - common types.
+--  Copyright (C) 2002, 2003, 2004, 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; use System;
+with Ada.Unchecked_Conversion;
+with Ada.Unchecked_Deallocation;
+with Interfaces; use Interfaces;
+
+package Grt.Types is
+   pragma Preelaborate (Grt.Types);
+
+   type Ghdl_B2 is new Boolean;
+   type Ghdl_E8 is new Unsigned_8;
+   type Ghdl_U32 is new Unsigned_32;
+   subtype Ghdl_E32 is Ghdl_U32;
+   type Ghdl_I32 is new Integer_32;
+   type Ghdl_I64 is new Integer_64;
+   type Ghdl_U64 is new Unsigned_64;
+   type Ghdl_F64 is new IEEE_Float_64;
+
+   type Ghdl_Ptr is new Address;
+   type Ghdl_Index_Type is mod 2 ** Word_Size;
+   subtype Ghdl_Real is Ghdl_F64;
+
+   type Ghdl_Dir_Type is (Dir_To, Dir_Downto);
+   for Ghdl_Dir_Type use (Dir_To => 0, Dir_Downto => 1);
+   for Ghdl_Dir_Type'Size use 8;
+
+   --  Access to an unconstrained string.
+   type String_Access is access String;
+   procedure Unchecked_Deallocation is new Ada.Unchecked_Deallocation
+     (Name => String_Access, Object => String);
+
+   subtype Std_Integer is Ghdl_I32;
+
+   type Std_Time is new Ghdl_I64;
+   Bad_Time : constant Std_Time := Std_Time'First;
+
+   type Std_Integer_Trt is record
+      Left : Std_Integer;
+      Right : Std_Integer;
+      Dir : Ghdl_Dir_Type;
+      Length : Ghdl_Index_Type;
+   end record;
+
+   subtype Std_Character is Character;
+   type Std_String_Base is array (Ghdl_Index_Type) of Std_Character;
+   type Std_String_Basep is access Std_String_Base;
+
+   type Std_String_Bound is record
+      Dim_1 : Std_Integer_Trt;
+   end record;
+   type Std_String_Boundp is access Std_String_Bound;
+
+   type Std_String is record
+      Base : Std_String_Basep;
+      Bounds : Std_String_Boundp;
+   end record;
+
+   --  An unconstrained array.
+   --  It is in fact a fat pointer to the base and the bounds.
+   type Ghdl_Uc_Array is record
+      Base : Address;
+      Bounds : Address;
+   end record;
+   type Ghdl_Uc_Array_Acc is access Ghdl_Uc_Array;
+   function To_Ghdl_Uc_Array_Acc is new Ada.Unchecked_Conversion
+     (Source => Address, Target => Ghdl_Uc_Array_Acc);
+
+   type Std_String_Ptr is access Std_String;
+
+   --  Verilog types.
+
+   type Ghdl_Logic32 is record
+      Val : Ghdl_U32;
+      Xz : Ghdl_U32;
+   end record;
+   type Ghdl_Logic32_Ptr is access Ghdl_Logic32;
+   type Ghdl_Logic32_Vec is array (Ghdl_U32) of Ghdl_Logic32;
+   type Ghdl_Logic32_Vptr is access Ghdl_Logic32_Vec;
+
+   function To_Ghdl_Logic32_Vptr is new Ada.Unchecked_Conversion
+     (Source => Address, Target => Ghdl_Logic32_Vptr);
+
+   function To_Ghdl_Logic32_Ptr is new Ada.Unchecked_Conversion
+     (Source => Address, Target => Ghdl_Logic32_Ptr);
+
+   --  Mimics C strings (NUL ended).
+   --  Note: this is 1 based.
+   type Ghdl_C_String is access String (Positive);
+   NUL : constant Character := Character'Val (0);
+
+   Nl : constant Character := Character'Val (10);  -- LF, nl or '\n'.
+
+   function strlen (Str : Ghdl_C_String) return Natural;
+   pragma Import (C, strlen);
+
+   function Strcmp (L , R : Ghdl_C_String) return Integer;
+   pragma Import (C, Strcmp);
+
+   function To_Ghdl_C_String is new Ada.Unchecked_Conversion
+     (Source => Address, Target => Ghdl_C_String);
+
+   --  Str_len.
+   type String_Ptr is access String (1 .. Natural'Last);
+   type Ghdl_Str_Len_Type is record
+      Len : Natural;
+      Str : String_Ptr;
+   end record;
+   --  Same as previous one, but using 'address.
+   type Ghdl_Str_Len_Address_Type is record
+      Len : Natural;
+      Str : Address;
+   end record;
+   type Ghdl_Str_Len_Ptr is access constant Ghdl_Str_Len_Type;
+   type Ghdl_Str_Len_Array is array (Natural) of Ghdl_Str_Len_Type;
+   type Ghdl_Str_Len_Array_Ptr is access all Ghdl_Str_Len_Array;
+
+   --  Location is used for errors/messages.
+   type Ghdl_Location is record
+      Filename : Ghdl_C_String;
+      Line : Integer;
+      Col : Integer;
+   end record;
+   type Ghdl_Location_Ptr is access Ghdl_Location;
+
+   --  Identifier for a process.
+   type Process_Id is new Integer;
+   Nul_Process_Id : constant Process_Id := 0;
+
+   --  Signal index.
+   type Sig_Table_Index is new Integer;
+
+   --  A range of signals.
+   type Sig_Table_Range is record
+      First, Last : Sig_Table_Index;
+   end record;
+
+   --  Simple values, used for signals.
+   type Mode_Type is
+     (Mode_B2, Mode_E8, Mode_E32, Mode_I32, Mode_I64, Mode_F64);
+
+   type Ghdl_B2_Array is array (Ghdl_Index_Type range <>) of Ghdl_B2;
+   type Ghdl_E8_Array is array (Ghdl_Index_Type range <>) of Ghdl_E8;
+   type Ghdl_I32_Array is array (Ghdl_Index_Type range <>) of Ghdl_I32;
+
+   type Value_Union (Mode : Mode_Type := Mode_B2) is record
+      case Mode is
+         when Mode_B2 =>
+            B2 : Ghdl_B2;
+         when Mode_E8 =>
+            E8 : Ghdl_E8;
+         when Mode_E32 =>
+            E32 : Ghdl_E32;
+         when Mode_I32 =>
+            I32 : Ghdl_I32;
+         when Mode_I64 =>
+            I64 : Ghdl_I64;
+         when Mode_F64 =>
+            F64 : Ghdl_F64;
+      end case;
+   end record;
+   pragma Unchecked_Union (Value_Union);
+
+   type Ghdl_Value_Ptr is access Value_Union;
+   function To_Ghdl_Value_Ptr is new Ada.Unchecked_Conversion
+     (Source => Address, Target => Ghdl_Value_Ptr);
+
+   --  Ranges.
+   type Ghdl_Range_B2 is record
+      Left : Ghdl_B2;
+      Right : Ghdl_B2;
+      Dir : Ghdl_Dir_Type;
+      Len : Ghdl_Index_Type;
+   end record;
+
+   type Ghdl_Range_E8 is record
+      Left : Ghdl_E8;
+      Right : Ghdl_E8;
+      Dir : Ghdl_Dir_Type;
+      Len : Ghdl_Index_Type;
+   end record;
+
+   type Ghdl_Range_E32 is record
+      Left : Ghdl_E32;
+      Right : Ghdl_E32;
+      Dir : Ghdl_Dir_Type;
+      Len : Ghdl_Index_Type;
+   end record;
+
+   type Ghdl_Range_I32 is record
+      Left : Ghdl_I32;
+      Right : Ghdl_I32;
+      Dir : Ghdl_Dir_Type;
+      Len : Ghdl_Index_Type;
+   end record;
+
+   type Ghdl_Range_I64 is record
+      Left : Ghdl_I64;
+      Right : Ghdl_I64;
+      Dir : Ghdl_Dir_Type;
+      Len : Ghdl_Index_Type;
+   end record;
+
+   type Ghdl_Range_F64 is record
+      Left : Ghdl_F64;
+      Right : Ghdl_F64;
+      Dir : Ghdl_Dir_Type;
+   end record;
+
+   type Ghdl_Range_Type (K : Mode_Type := Mode_B2)
+   is record
+      case K is
+         when Mode_B2 =>
+            B2 : Ghdl_Range_B2;
+         when Mode_E8 =>
+            E8 : Ghdl_Range_E8;
+         when Mode_E32 =>
+            E32 : Ghdl_Range_E32;
+         when Mode_I32 =>
+            I32 : Ghdl_Range_I32;
+         when Mode_I64 =>
+            P64 : Ghdl_Range_I64;
+         when Mode_F64 =>
+            F64 : Ghdl_Range_F64;
+      end case;
+   end record;
+   pragma Unchecked_Union (Ghdl_Range_Type);
+
+   type Ghdl_Range_Ptr is access all Ghdl_Range_Type;
+
+   function To_Ghdl_Range_Ptr is new Ada.Unchecked_Conversion
+     (Source => Address, Target => Ghdl_Range_Ptr);
+
+   type Ghdl_Range_Array is array (Ghdl_Index_Type range <>) of Ghdl_Range_Ptr;
+
+   --  Mode of a signal.
+   type Mode_Signal_Type is
+     (Mode_Signal,
+      Mode_Linkage, Mode_Buffer, Mode_Out, Mode_Inout, Mode_In,
+      Mode_Stable, Mode_Quiet, Mode_Transaction, Mode_Delayed, Mode_Guard,
+      Mode_Conv_In, Mode_Conv_Out,
+      Mode_End);
+
+   subtype Mode_Signal_Port is
+     Mode_Signal_Type range Mode_Linkage .. Mode_In;
+
+   --  Not implicit signals.
+   subtype Mode_Signal_User is
+     Mode_Signal_Type range Mode_Signal .. Mode_In;
+
+   --  Implicit signals.
+   subtype Mode_Signal_Implicit is
+     Mode_Signal_Type range Mode_Stable .. Mode_Guard;
+
+   --  Kind of a signal.
+   type Kind_Signal_Type is
+     (Kind_Signal_No, Kind_Signal_Register, Kind_Signal_Bus);
+   pragma Convention (C, Kind_Signal_Type);
+
+   --  Note: we could use system.storage_elements, but unfortunatly,
+   --  this doesn't work with pragma no_run_time (gnat 3.15p).
+   type Integer_Address is mod Memory_Size;
+
+   function To_Address is new Ada.Unchecked_Conversion
+     (Source => Integer_Address, Target => Address);
+
+   function To_Integer is new Ada.Unchecked_Conversion
+     (Source => Address, Target => Integer_Address);
+
+   --  The NOW value.
+   Current_Time : Std_Time;
+   --  Copy of Current_Time before updating it.
+   --  To be used by hooks.
+   Cycle_Time : Std_Time;
+   --  The current delta cycle number.
+   Current_Delta : Integer;
+private
+   pragma Export (C, Current_Time, "__ghdl_now");
+end Grt.Types;
diff --git a/translate/grt/grt-values.adb b/translate/grt/grt-values.adb
new file mode 100644
index 000000000..404a2a42e
--- /dev/null
+++ b/translate/grt/grt-values.adb
@@ -0,0 +1,215 @@
+--  GHDL Run Time (GRT) - 'value subprograms.
+--  Copyright (C) 2002, 2003, 2004, 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.Errors; use Grt.Errors;
+
+package body Grt.Values is
+
+   NBSP : constant Character := Character'Val (160);
+   HT : constant Character := Character'Val (9);
+
+   function Ghdl_Value_I32 (Str : Std_String_Ptr) return Ghdl_I32
+   is
+      S : constant Std_String_Basep := Str.Base;
+      Len : constant Ghdl_Index_Type := Str.Bounds.Dim_1.Length;
+      Pos : Ghdl_Index_Type := 0;
+      C : Character;
+      Sep : Character;
+      Val, D, Base : Ghdl_I32;
+      Exp : Integer;
+   begin
+      --  LRM 14.1
+      --  Leading [and trailing] whitespace is allowed and ignored.
+      --
+      --  GHDL: allow several leading whitespace.
+      while Pos < Len loop
+         case S (Pos) is
+            when ' '
+              | NBSP
+              | HT =>
+               Pos := Pos + 1;
+            when others =>
+               exit;
+         end case;
+      end loop;
+
+      if Pos = Len then
+         Error_E ("'value: empty string");
+      end if;
+      C := S (Pos);
+
+      --  Be user friendly.
+      if C = '-' or C = '+' then
+         Error_E ("'value: leading sign +/- not allowed");
+      end if;
+
+      Val := 0;
+      loop
+         if C in '0' .. '9' then
+            Val := Val * 10 + Character'Pos (C) - Character'Pos ('0');
+            Pos := Pos + 1;
+            exit when Pos >= Len;
+            C := S (Pos);
+         else
+            Error_E ("'value: decimal digit expected");
+         end if;
+         case C is
+            when '_' =>
+               Pos := Pos + 1;
+               if Pos >= Len then
+                  Error_E ("'value: trailing underscore");
+               end if;
+               C := S (Pos);
+            when '#'
+              | ':'
+              | 'E'
+              | 'e' =>
+               exit;
+            when ' '
+              | NBSP
+              | HT =>
+               Pos := Pos + 1;
+               exit;
+            when others =>
+               null;
+         end case;
+      end loop;
+
+      if Pos >= Len then
+         return Val;
+      end if;
+
+      if C = '#' or C = ':' then
+         Base := Val;
+         Val := 0;
+         Sep := C;
+         Pos := Pos + 1;
+         if Base < 2 or Base > 16 then
+            Error_E ("'value: bad base");
+         end if;
+         if Pos >= Len then
+            Error_E ("'value: missing based integer");
+         end if;
+         C := S (Pos);
+         loop
+            case C is
+               when '0' .. '9' =>
+                  D := Character'Pos (C) - Character'Pos ('0');
+               when 'a' .. 'f' =>
+                  D := Character'Pos (C) - Character'Pos ('a') + 10;
+               when 'A' .. 'F' =>
+                  D := Character'Pos (C) - Character'Pos ('A') + 10;
+               when others =>
+                  Error_E ("'value: digit expected");
+            end case;
+            if D > Base then
+               Error_E ("'value: digit greather than base");
+            end if;
+            Val := Val * Base + D;
+            Pos := Pos + 1;
+            if Pos >= Len then
+               Error_E ("'value: missing end sign number");
+            end if;
+            C := S (Pos);
+            if C = '#' or C = ':' then
+               if C /= Sep then
+                  Error_E ("'value: sign number mismatch");
+               end if;
+               Pos := Pos + 1;
+               exit;
+            elsif C = '_' then
+               Pos := Pos + 1;
+               if Pos >= Len then
+                  Error_E ("'value: no character after underscore");
+               end if;
+               C := S (Pos);
+            end if;
+         end loop;
+      else
+         Base := 10;
+      end if;
+
+      -- Handle exponent.
+      if C = 'e' or C = 'E' then
+         Pos := Pos + 1;
+         if Pos >= Len then
+            Error_E ("'value: no character after exponent");
+         end if;
+         C := S (Pos);
+         if C = '+' then
+            Pos := Pos + 1;
+            if Pos >= Len then
+               Error_E ("'value: no character after sign");
+            end if;
+            C := S (Pos);
+         elsif C = '-' then
+            Error_E ("'value: negativ exponent not allowed");
+         end if;
+         Exp := 0;
+         loop
+            if C in '0' .. '9' then
+               Exp := Exp * 10 + Character'Pos (C) - Character'Pos ('0');
+               Pos := Pos + 1;
+               exit when Pos >= Len;
+               C := S (Pos);
+            else
+               Error_E ("'value: decimal digit expected");
+            end if;
+            case C is
+               when '_' =>
+                  Pos := Pos + 1;
+                  if Pos >= Len then
+                     Error_E ("'value: trailing underscore");
+                  end if;
+                  C := S (Pos);
+               when ' '
+                 | NBSP
+                 | HT =>
+                  Pos := Pos + 1;
+                  exit;
+               when others =>
+                  null;
+            end case;
+         end loop;
+         while Exp > 0 loop
+            if Exp mod 2 = 1 then
+               Val := Val * Base;
+            end if;
+            Exp := Exp / 2;
+            Base := Base * Base;
+         end loop;
+      end if;
+
+      --  LRM 14.1
+      --  [Leading] and trailing whitespace is allowed and ignored.
+      --
+      --  GHDL: allow several leading whitespace.
+      while Pos < Len loop
+         case S (Pos) is
+            when ' '
+              | NBSP
+              | HT =>
+               Pos := Pos + 1;
+            when others =>
+               Error_E ("'value: trailing characters after blank");
+         end case;
+      end loop;
+
+      return Val;
+   end Ghdl_Value_I32;
+
+end Grt.Values;
diff --git a/translate/grt/grt-values.ads b/translate/grt/grt-values.ads
new file mode 100644
index 000000000..25bde5abf
--- /dev/null
+++ b/translate/grt/grt-values.ads
@@ -0,0 +1,25 @@
+--  GHDL Run Time (GRT) - 'value subprograms.
+--  Copyright (C) 2002, 2003, 2004, 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;
+--  with Grt.Rtis; use Grt.Rtis;
+
+package Grt.Values is
+   function Ghdl_Value_I32 (Str : Std_String_Ptr) return Ghdl_I32;
+private
+   pragma Export (C, Ghdl_Value_I32, "__ghdl_value_i32");
+end Grt.Values;
diff --git a/translate/grt/grt-vcd.adb b/translate/grt/grt-vcd.adb
new file mode 100644
index 000000000..66f248c5d
--- /dev/null
+++ b/translate/grt/grt-vcd.adb
@@ -0,0 +1,716 @@
+--  GHDL Run Time (GRT) - VCD generator.
+--  Copyright (C) 2002, 2003, 2004, 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 Interfaces;
+with Grt.Stdio; use Grt.Stdio;
+with System; use System;
+with Grt.Errors; use Grt.Errors;
+with Grt.Types; use Grt.Types;
+with Grt.Signals; use Grt.Signals;
+with GNAT.Table;
+with Grt.Astdio; use Grt.Astdio;
+with Grt.Hooks; use Grt.Hooks;
+with Grt.Avhpi; use Grt.Avhpi;
+with Grt.Rtis; use Grt.Rtis;
+with Grt.Rtis_Addr; use Grt.Rtis_Addr;
+with Grt.Rtis_Types; use Grt.Rtis_Types;
+
+package body Grt.Vcd is
+   --  VCD filename.
+   Vcd_Filename : String_Access := null;
+   --  Stream corresponding to the VCD filename.
+   Vcd_Stream : FILEs;
+
+   --  Index type of the table of vcd variables to dump.
+   type Vcd_Index_Type is new Integer;
+
+   --  Return TRUE if OPT is an option for VCD.
+   function Vcd_Option (Opt : String) return Boolean
+   is
+      F : Natural := Opt'First;
+   begin
+      if Opt'Length < 5 or else Opt (F .. F + 4) /= "--vcd" then
+         return False;
+      end if;
+      if Opt'Length > 6 and then Opt (F + 5) = '=' then
+         --  Add an extra NUL character.
+         Vcd_Filename := new String (1 .. Opt'Length - 6 + 1);
+         Vcd_Filename (1 .. Opt'Length - 6) := Opt (F + 6 .. Opt'Last);
+         Vcd_Filename (Vcd_Filename'Last) := NUL;
+         return True;
+      else
+         return False;
+      end if;
+   end Vcd_Option;
+
+   procedure Vcd_Help is
+   begin
+      Put_Line (" --vcd=FILENAME     dump signal values into a VCD file");
+   end Vcd_Help;
+
+   procedure Vcd_Put (Str : String)
+   is
+      R : size_t;
+   begin
+      R := fwrite (Str'Address, Str'Length, 1, Vcd_Stream);
+   end Vcd_Put;
+
+   procedure Vcd_Putc (C : Character)
+   is
+      R : int;
+   begin
+      R := fputc (Character'Pos (C), Vcd_Stream);
+   end Vcd_Putc;
+
+   procedure Vcd_Newline is
+   begin
+      Vcd_Putc (Nl);
+   end Vcd_Newline;
+
+   procedure Vcd_Putline (Str : String) is
+   begin
+      Vcd_Put (Str);
+      Vcd_Newline;
+   end Vcd_Putline;
+
+--    procedure Vcd_Put (Str : Ghdl_Str_Len_Type)
+--    is
+--    begin
+--       Put_Str_Len (Vcd_Stream, Str);
+--    end Vcd_Put;
+
+   procedure Vcd_Put_I32 (V : Ghdl_I32)
+   is
+   begin
+      Put_I32 (Vcd_Stream, V);
+   end Vcd_Put_I32;
+
+   procedure Vcd_Put_Idcode (N : Vcd_Index_Type)
+   is
+      Str : String (1 .. 8);
+      V, R : Vcd_Index_Type;
+      L : Natural;
+   begin
+      L := 0;
+      V := N;
+      loop
+         R := V mod 93;
+         V := V / 93;
+         L := L + 1;
+         Str (L) := Character'Val (33 + R);
+         exit when V = 0;
+      end loop;
+      Vcd_Put (Str (1 .. L));
+   end Vcd_Put_Idcode;
+
+   procedure Vcd_Put_Name (Obj : VhpiHandleT)
+   is
+      Name : String (1 .. 128);
+      Name_Len : Integer;
+   begin
+      Vhpi_Get_Str (VhpiNameP, Obj, Name, Name_Len);
+      if Name_Len <= Name'Last then
+         Vcd_Put (Name (1 .. Name_Len));
+      else
+         --  Truncate.
+         Vcd_Put (Name);
+      end if;
+   end Vcd_Put_Name;
+
+   procedure Vcd_Put_End is
+   begin
+      Vcd_Putline ("$end");
+   end Vcd_Put_End;
+
+   --  Called before elaboration.
+   procedure Vcd_Init
+   is
+      Mode : constant String := "wt" & NUL;
+   begin
+      if Vcd_Filename = null then
+         Vcd_Stream := NULL_Stream;
+         return;
+      end if;
+      if Vcd_Filename.all = "-" & NUL then
+         Vcd_Stream := stdout;
+      else
+         Vcd_Stream := fopen (Vcd_Filename.all'Address, Mode'Address);
+         if Vcd_Stream = NULL_Stream then
+            Error_C ("cannot open ");
+            Error_E (Vcd_Filename (Vcd_Filename'First
+                                   .. Vcd_Filename'Last - 1));
+            return;
+         end if;
+      end if;
+      Vcd_Putline ("$date");
+      Vcd_Put ("  ");
+      declare
+         type time_t is new Interfaces.Integer_64;
+         Cur_Time : time_t;
+
+         function time (Addr : Address) return time_t;
+         pragma Import (C, time);
+
+         function ctime (Timep: Address) return chars;
+         pragma Import (C, ctime);
+
+         R : int;
+      begin
+         Cur_Time := time (Null_Address);
+         R := fputs (ctime (Cur_Time'Address), Vcd_Stream);
+         -- Note: ctime already append a LF.
+      end;
+      Vcd_Put_End;
+      Vcd_Putline ("$version");
+      Vcd_Putline ("  GHDL v0");
+      Vcd_Put_End;
+      Vcd_Putline ("$timescale");
+      Vcd_Putline ("  1 fs");
+      Vcd_Put_End;
+   end Vcd_Init;
+
+   package Vcd_Table is new GNAT.Table
+     (Table_Component_Type => Verilog_Wire_Info,
+      Table_Index_Type => Vcd_Index_Type,
+      Table_Low_Bound => 0,
+      Table_Initial => 32,
+      Table_Increment => 100);
+
+   procedure Avhpi_Error (Err : AvhpiErrorT)
+   is
+      pragma Unreferenced (Err);
+   begin
+      Put_Line ("Vcd.Avhpi_Error!");
+      null;
+   end Avhpi_Error;
+
+   function Rti_To_Vcd_Kind (Rti : Ghdl_Rti_Access) return Vcd_Var_Kind
+   is
+      Rti1 : Ghdl_Rti_Access;
+   begin
+      if Rti.Kind = Ghdl_Rtik_Subtype_Scalar then
+         Rti1 := To_Ghdl_Rtin_Subtype_Scalar_Acc (Rti).Basetype;
+      else
+         Rti1 := Rti;
+      end if;
+
+      if Rti1 = Std_Standard_Boolean_RTI_Ptr then
+         return Vcd_Bool;
+      end if;
+      if Rti1 = Std_Standard_Bit_RTI_Ptr then
+         return Vcd_Bit;
+      end if;
+      if Rti1 = Ieee_Std_Logic_1164_Std_Ulogic_RTI_Ptr then
+         return Vcd_Stdlogic;
+      end if;
+      if Rti1.Kind = Ghdl_Rtik_Type_I32 then
+         return Vcd_Integer32;
+      end if;
+      return Vcd_Bad;
+   end Rti_To_Vcd_Kind;
+
+   function Rti_To_Vcd_Kind (Rti : Ghdl_Rtin_Type_Array_Acc)
+                            return Vcd_Var_Kind
+   is
+      It : Ghdl_Rti_Access;
+   begin
+      if Rti.Nbr_Dim /= 1 then
+         return Vcd_Bad;
+      end if;
+      It := Rti.Indexes (0);
+      if It.Kind /= Ghdl_Rtik_Subtype_Scalar then
+         return Vcd_Bad;
+      end if;
+      if To_Ghdl_Rtin_Subtype_Scalar_Acc (It).Basetype.Kind
+        /= Ghdl_Rtik_Type_I32
+      then
+         return Vcd_Bad;
+      end if;
+      case Rti_To_Vcd_Kind (Rti.Element) is
+         when Vcd_Bit =>
+            return Vcd_Bitvector;
+         when Vcd_Stdlogic =>
+            return Vcd_Stdlogic_Vector;
+         when others =>
+            return Vcd_Bad;
+      end case;
+   end Rti_To_Vcd_Kind;
+
+   procedure Get_Verilog_Wire (Sig : VhpiHandleT; Info : out Verilog_Wire_Info)
+   is
+      Sig_Type : VhpiHandleT;
+      Sig_Rti : Ghdl_Rtin_Object_Acc;
+      Rti : Ghdl_Rti_Access;
+      Error : AvhpiErrorT;
+      Sig_Addr : Address;
+   begin
+      Sig_Rti := To_Ghdl_Rtin_Object_Acc (Avhpi_Get_Rti (Sig));
+
+      --  Extract type of the signal.
+      Vhpi_Handle (VhpiSubtype, Sig, Sig_Type, Error);
+      if Error /= AvhpiErrorOk then
+         Avhpi_Error (Error);
+         return;
+      end if;
+
+      Rti := Avhpi_Get_Rti (Sig_Type);
+      Sig_Addr := Avhpi_Get_Address (Sig);
+      Info.Kind := Vcd_Bad;
+      case Rti.Kind is
+         when Ghdl_Rtik_Type_B2
+           | Ghdl_Rtik_Type_E8
+           | Ghdl_Rtik_Subtype_Scalar =>
+            Info.Kind := Rti_To_Vcd_Kind (Rti);
+            Info.Addr := Sig_Addr;
+            Info.Irange := null;
+         when Ghdl_Rtik_Subtype_Array =>
+            declare
+               St : Ghdl_Rtin_Subtype_Array_Acc;
+            begin
+               St := To_Ghdl_Rtin_Subtype_Array_Acc (Rti);
+               Info.Kind := Rti_To_Vcd_Kind (St.Basetype);
+               Info.Addr := Sig_Addr;
+               Info.Irange := To_Ghdl_Range_Ptr
+                 (Loc_To_Addr (St.Common.Depth, St.Bounds,
+                               Avhpi_Get_Context (Sig)));
+            end;
+         when Ghdl_Rtik_Subtype_Array_Ptr =>
+            declare
+               St : Ghdl_Rtin_Subtype_Array_Acc;
+            begin
+               St := To_Ghdl_Rtin_Subtype_Array_Acc (Rti);
+               Info.Kind := Rti_To_Vcd_Kind (St.Basetype);
+               Info.Addr := To_Addr_Acc (Sig_Addr).all;
+               Info.Irange := To_Ghdl_Range_Ptr
+                 (Loc_To_Addr (St.Common.Depth, St.Bounds,
+                               Avhpi_Get_Context (Sig)));
+            end;
+         when Ghdl_Rtik_Type_Array =>
+            declare
+               Uc : Ghdl_Uc_Array_Acc;
+            begin
+               Info.Kind := Rti_To_Vcd_Kind
+                 (To_Ghdl_Rtin_Type_Array_Acc (Rti));
+               Uc := To_Ghdl_Uc_Array_Acc (Sig_Addr);
+               Info.Addr := Uc.Base;
+               Info.Irange := To_Ghdl_Range_Ptr (Uc.Bounds);
+            end;
+         when others =>
+            Info.Irange := null;
+      end case;
+
+      --  Do not allow null-array.
+      if Info.Irange /= null and then Info.Irange.I32.Len = 0 then
+         Info.Kind := Vcd_Bad;
+         Info.Irange := null;
+         return;
+      end if;
+
+      if Vhpi_Get_Kind (Sig) = VhpiPortDeclK then
+         case Vhpi_Get_Mode (Sig) is
+            when VhpiInMode
+              | VhpiInoutMode
+              | VhpiBufferMode
+              | VhpiLinkageMode =>
+               Info.Val := Vcd_Effective;
+            when VhpiOutMode =>
+               Info.Val := Vcd_Driving;
+            when VhpiErrorMode =>
+               Info.Kind := Vcd_Bad;
+         end case;
+      else
+         Info.Val := Vcd_Effective;
+      end if;
+   end Get_Verilog_Wire;
+
+   procedure Add_Signal (Sig : VhpiHandleT)
+   is
+      N : Vcd_Index_Type;
+      Vcd_El : Verilog_Wire_Info;
+   begin
+      Get_Verilog_Wire (Sig, Vcd_El);
+
+      if Vcd_El.Kind = Vcd_Bad then
+         Vcd_Put ("$comment ");
+         Vcd_Put_Name (Sig);
+         Vcd_Put (" is not handled");
+         --Vcd_Put (Ghdl_Type_Kind'Image (Desc.Kind));
+         Vcd_Putc (' ');
+         Vcd_Put_End;
+         return;
+      else
+         Vcd_Table.Increment_Last;
+         N := Vcd_Table.Last;
+
+         Vcd_Table.Table (N) := Vcd_El;
+         Vcd_Put ("$var ");
+         case Vcd_El.Kind is
+            when Vcd_Integer32 =>
+               Vcd_Put ("integer 32");
+            when Vcd_Bool
+              | Vcd_Bit
+              | Vcd_Stdlogic =>
+               Vcd_Put ("reg 1");
+            when Vcd_Bitvector
+              | Vcd_Stdlogic_Vector =>
+               Vcd_Put ("reg ");
+               Vcd_Put_I32 (Ghdl_I32 (Vcd_El.Irange.I32.Len));
+            when Vcd_Bad =>
+               null;
+         end case;
+         Vcd_Putc (' ');
+         Vcd_Put_Idcode (N);
+         Vcd_Putc (' ');
+         Vcd_Put_Name (Sig);
+         if Vcd_El.Irange /= null then
+            Vcd_Putc ('[');
+            Vcd_Put_I32 (Vcd_El.Irange.I32.Left);
+            Vcd_Putc (':');
+            Vcd_Put_I32 (Vcd_El.Irange.I32.Right);
+            Vcd_Putc (']');
+         end if;
+         Vcd_Putc (' ');
+         Vcd_Put_End;
+         if Boolean'(False) then
+            Vcd_Put ("$comment ");
+            Vcd_Put_Name (Sig);
+            Vcd_Put (" is ");
+            case Vcd_El.Val is
+               when Vcd_Effective =>
+                  Vcd_Put ("effective ");
+               when Vcd_Driving =>
+                  Vcd_Put ("driving ");
+            end case;
+            Vcd_Put_End;
+         end if;
+      end if;
+   end Add_Signal;
+
+   procedure Vcd_Put_Hierarchy (Inst : VhpiHandleT)
+   is
+      Decl_It : VhpiHandleT;
+      Decl : VhpiHandleT;
+      Error : AvhpiErrorT;
+   begin
+      Vhpi_Iterator (VhpiDecls, Inst, Decl_It, Error);
+      if Error /= AvhpiErrorOk then
+         Avhpi_Error (Error);
+         return;
+      end if;
+
+      --  Extract signals.
+      loop
+         Vhpi_Scan (Decl_It, Decl, Error);
+         exit when Error = AvhpiErrorIteratorEnd;
+         if Error /= AvhpiErrorOk then
+            Avhpi_Error (Error);
+            return;
+         end if;
+
+         case Vhpi_Get_Kind (Decl) is
+            when VhpiPortDeclK
+              | VhpiSigDeclK =>
+               Add_Signal (Decl);
+            when others =>
+               null;
+         end case;
+      end loop;
+
+      --  Extract sub-scopes.
+      Vhpi_Iterator (VhpiInternalRegions, Inst, Decl_It, Error);
+      if Error /= AvhpiErrorOk then
+         Avhpi_Error (Error);
+         return;
+      end if;
+
+      loop
+         Vhpi_Scan (Decl_It, Decl, Error);
+         exit when Error = AvhpiErrorIteratorEnd;
+         if Error /= AvhpiErrorOk then
+            Avhpi_Error (Error);
+            return;
+         end if;
+
+         case Vhpi_Get_Kind (Decl) is
+            when VhpiIfGenerateK
+              | VhpiForGenerateK
+              | VhpiBlockStmtK
+              | VhpiCompInstStmtK =>
+               Vcd_Put ("$scope module ");
+               Vcd_Put_Name (Decl);
+               Vcd_Putc (' ');
+               Vcd_Put_End;
+               Vcd_Put_Hierarchy (Decl);
+               Vcd_Put ("$upscope ");
+               Vcd_Put_End;
+            when others =>
+               null;
+         end case;
+      end loop;
+
+   end Vcd_Put_Hierarchy;
+
+   procedure Vcd_Put_Bit (V : Ghdl_B2)
+   is
+      C : Character;
+   begin
+      if V then
+         C := '1';
+      else
+         C := '0';
+      end if;
+      Vcd_Putc (C);
+   end Vcd_Put_Bit;
+
+   procedure Vcd_Put_Stdlogic (V : Ghdl_E8)
+   is
+      type Map_Type is array (Ghdl_E8 range 0 .. 8) of Character;
+      --                             "UX01ZWLH-"
+   -- Map_Vlg : constant Map_Type := "xx01zz01x";
+      Map_Std : constant Map_Type := "UX01ZWLH-";
+   begin
+      if V not in Map_Type'Range then
+         Vcd_Putc ('?');
+      else
+         Vcd_Putc (Map_Std (V));
+      end if;
+   end Vcd_Put_Stdlogic;
+
+   procedure Vcd_Put_Integer32 (V : Ghdl_U32)
+   is
+      Val : Ghdl_U32;
+      N : Natural;
+   begin
+      Val := V;
+      N := 32;
+      while N > 1 loop
+         exit when (Val and 16#8000_0000#) /= 0;
+         Val := Val * 2;
+         N := N - 1;
+      end loop;
+
+      while N > 0 loop
+         if (Val and 16#8000_0000#) /= 0 then
+            Vcd_Putc ('1');
+         else
+            Vcd_Putc ('0');
+         end if;
+         Val := Val * 2;
+         N := N - 1;
+      end loop;
+   end Vcd_Put_Integer32;
+
+   procedure Vcd_Put_Var (I : Vcd_Index_Type)
+   is
+      Addr : Address;
+      V : Verilog_Wire_Info renames Vcd_Table.Table (I);
+      Len : Ghdl_Index_Type;
+   begin
+      Addr := V.Addr;
+      if V.Irange = null then
+         Len := 1;
+      else
+         Len := V.Irange.I32.Len;
+      end if;
+      case V.Val is
+         when Vcd_Effective =>
+            case V.Kind is
+               when Vcd_Bit
+                 | Vcd_Bool =>
+                  Vcd_Put_Bit (To_Signal_Arr_Ptr (Addr)(0).Value.B2);
+               when Vcd_Stdlogic =>
+                  Vcd_Put_Stdlogic (To_Signal_Arr_Ptr (Addr)(0).Value.E8);
+               when Vcd_Integer32 =>
+                  Vcd_Putc ('b');
+                  Vcd_Put_Integer32 (To_Signal_Arr_Ptr (Addr)(0).Value.E32);
+               when Vcd_Bitvector =>
+                  Vcd_Putc ('b');
+                  for J in 0 .. Len - 1 loop
+                     Vcd_Put_Bit (To_Signal_Arr_Ptr (Addr)(J).Value.B2);
+                  end loop;
+                  Vcd_Putc (' ');
+               when Vcd_Stdlogic_Vector =>
+                  Vcd_Putc ('b');
+                  for J in 0 .. Len - 1 loop
+                     Vcd_Put_Stdlogic (To_Signal_Arr_Ptr (Addr)(J).Value.E8);
+                  end loop;
+                  Vcd_Putc (' ');
+               when Vcd_Bad =>
+                  null;
+            end case;
+         when Vcd_Driving =>
+            case V.Kind is
+               when Vcd_Bit
+                 | Vcd_Bool =>
+                  Vcd_Put_Bit
+                    (To_Signal_Arr_Ptr (Addr)(0).Driving_Value.B2);
+               when Vcd_Stdlogic =>
+                  Vcd_Put_Stdlogic
+                    (To_Signal_Arr_Ptr (Addr)(0).Driving_Value.E8);
+               when Vcd_Integer32 =>
+                  Vcd_Putc ('b');
+                  Vcd_Put_Integer32
+                    (To_Signal_Arr_Ptr (Addr)(0).Driving_Value.E32);
+               when Vcd_Bitvector =>
+                  Vcd_Putc ('b');
+                  for J in 0 .. Len - 1 loop
+                     Vcd_Put_Bit
+                       (To_Signal_Arr_Ptr (Addr)(J).Driving_Value.B2);
+                  end loop;
+                  Vcd_Putc (' ');
+               when Vcd_Stdlogic_Vector =>
+                  Vcd_Putc ('b');
+                  for J in 0 .. Len - 1 loop
+                     Vcd_Put_Stdlogic
+                       (To_Signal_Arr_Ptr (Addr)(J).Driving_Value.E8);
+                  end loop;
+                  Vcd_Putc (' ');
+               when Vcd_Bad =>
+                  null;
+            end case;
+      end case;
+      Vcd_Put_Idcode (I);
+      Vcd_Newline;
+   end Vcd_Put_Var;
+
+   function Verilog_Wire_Changed (Info : Verilog_Wire_Info;
+                                  Last : Std_Time)
+                                 return Boolean
+   is
+      Len : Ghdl_Index_Type;
+   begin
+      if Info.Irange = null then
+         Len := 1;
+      else
+         Len := Info.Irange.I32.Len;
+      end if;
+
+      case Info.Val is
+         when Vcd_Effective =>
+            case Info.Kind is
+               when Vcd_Bit
+                 | Vcd_Bool
+                 | Vcd_Stdlogic
+                 | Vcd_Bitvector
+                 | Vcd_Stdlogic_Vector
+                 | Vcd_Integer32 =>
+                  for J in 0 .. Len - 1 loop
+                     if To_Signal_Arr_Ptr (Info.Addr)(J).Last_Event = Last then
+                        return True;
+                     end if;
+                  end loop;
+               when Vcd_Bad =>
+                  null;
+            end case;
+         when Vcd_Driving =>
+            case Info.Kind is
+               when Vcd_Bit
+                 | Vcd_Bool
+                 | Vcd_Stdlogic
+                 | Vcd_Bitvector
+                 | Vcd_Stdlogic_Vector
+                 | Vcd_Integer32 =>
+                  for J in 0 .. Len - 1 loop
+                     if To_Signal_Arr_Ptr (Info.Addr)(J).Last_Active = Last
+                     then
+                        return True;
+                     end if;
+                  end loop;
+               when Vcd_Bad =>
+                  null;
+            end case;
+      end case;
+      return False;
+   end Verilog_Wire_Changed;
+
+   procedure Vcd_Put_Time
+   is
+   begin
+      Vcd_Putc ('#');
+      Put_I64 (Vcd_Stream, Ghdl_I64 (Cycle_Time));
+      Vcd_Newline;
+   end Vcd_Put_Time;
+
+   procedure Vcd_Cycle;
+
+   --  Called after elaboration.
+   procedure Vcd_Start
+   is
+      Root : VhpiHandleT;
+   begin
+      --  Do nothing if there is no VCD file to generate.
+      if Vcd_Stream = NULL_Stream then
+         return;
+      end if;
+
+      --  Be sure the RTI of std_ulogic is set.
+      Search_Types_RTI;
+
+      --  Put hierarchy.
+      Get_Root_Inst (Root);
+      Vcd_Put_Hierarchy (Root);
+
+      --  End of header.
+      Vcd_Put ("$enddefinitions ");
+      Vcd_Put_End;
+
+      Register_Cycle_Hook (Vcd_Cycle'Access);
+   end Vcd_Start;
+
+   --  Called before each non delta cycle.
+   procedure Vcd_Cycle is
+   begin
+      --  Do nothing if there is no VCD file to generate.
+      if Vcd_Stream = NULL_Stream then
+         return;
+      end if;
+
+      --  Disp values.
+      Vcd_Put_Time;
+      if Cycle_Time = 0 then
+         --  Disp all values.
+         for I in Vcd_Table.First .. Vcd_Table.Last loop
+            Vcd_Put_Var (I);
+         end loop;
+      else
+         --  Disp only values changed.
+         for I in Vcd_Table.First .. Vcd_Table.Last loop
+            if Verilog_Wire_Changed (Vcd_Table.Table (I), Cycle_Time) then
+               Vcd_Put_Var (I);
+            end if;
+         end loop;
+      end if;
+   end Vcd_Cycle;
+
+   --  Called at the end of the simulation.
+   procedure Vcd_End is
+   begin
+      null;
+   end Vcd_End;
+
+   Vcd_Hooks : aliased constant Hooks_Type :=
+     (Option => Vcd_Option'Access,
+      Help => Vcd_Help'Access,
+      Init => Vcd_Init'Access,
+      Start => Vcd_Start'Access,
+      Finish => Vcd_End'Access);
+
+   procedure Register is
+   begin
+      Register_Hooks (Vcd_Hooks'Access);
+   end Register;
+end Grt.Vcd;
diff --git a/translate/grt/grt-vcd.ads b/translate/grt/grt-vcd.ads
new file mode 100644
index 000000000..40b9d8c5e
--- /dev/null
+++ b/translate/grt/grt-vcd.ads
@@ -0,0 +1,48 @@
+--  GHDL Run Time (GRT) - VCD generator.
+--  Copyright (C) 2002, 2003, 2004, 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; use System;
+with Grt.Types; use Grt.Types;
+with Grt.Avhpi; use Grt.Avhpi;
+
+package Grt.Vcd is
+   type Vcd_Var_Kind is (Vcd_Bad,
+                         Vcd_Bool,
+                         Vcd_Integer32,
+                         Vcd_Bit, Vcd_Stdlogic,
+                         Vcd_Bitvector, Vcd_Stdlogic_Vector);
+
+   --  Which value to be displayed: effective or driving (for out signals).
+   type Vcd_Value_Kind is (Vcd_Effective, Vcd_Driving);
+
+   type Verilog_Wire_Info is record
+      Addr : Address;
+      Irange : Ghdl_Range_Ptr;
+      Kind : Vcd_Var_Kind;
+      Val : Vcd_Value_Kind;
+   end record;
+
+   procedure Get_Verilog_Wire (Sig : VhpiHandleT;
+                               Info : out Verilog_Wire_Info);
+
+   --  Return TRUE if last change time of the wire described by INFO is LAST.
+   function Verilog_Wire_Changed (Info : Verilog_Wire_Info;
+                                  Last : Std_Time)
+                                 return Boolean;
+
+   procedure Register;
+end Grt.Vcd;
diff --git a/translate/grt/grt-vital_annotate.adb b/translate/grt/grt-vital_annotate.adb
new file mode 100644
index 000000000..9a31bf454
--- /dev/null
+++ b/translate/grt/grt-vital_annotate.adb
@@ -0,0 +1,467 @@
+--  GHDL Run Time (GRT) - VITAL annotator.
+--  Copyright (C) 2002, 2003, 2004, 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.Sdf;
+with Grt.Types; use Grt.Types;
+with Grt.Hooks; use Grt.Hooks;
+with Grt.Astdio; use Grt.Astdio;
+with Grt.Stdio; use Grt.Stdio;
+with Grt.Options;
+with Grt.Avhpi; use Grt.Avhpi;
+with Grt.Errors; use Grt.Errors;
+
+package body Grt.Vital_Annotate is
+   --  Point of the annotation.
+   Sdf_Top : VhpiHandleT;
+
+   --  Instance being annotated.
+   Sdf_Inst : VhpiHandleT;
+
+   Flag_Dump : Boolean := False;
+   Flag_Verbose : Boolean := False;
+
+   function Name_Compare (Handle : VhpiHandleT;
+                          Name : String;
+                          Property : VhpiStrPropertyT := VhpiNameP)
+                         return Boolean
+   is
+      Obj_Name : String (1 .. Name'Length);
+      Len : Natural;
+   begin
+      Vhpi_Get_Str (Property, Handle, Obj_Name, Len);
+      if Len = Name'Length and then Obj_Name = Name then
+         return True;
+      else
+         return False;
+      end if;
+   end Name_Compare;
+
+   --  Note: RES may alias CUR.
+   procedure Find_Instance (Cur : VhpiHandleT;
+                            Res : out VhpiHandleT;
+                            Name : String;
+                            Ok : out Boolean)
+   is
+      Error : AvhpiErrorT;
+      It : VhpiHandleT;
+   begin
+      Ok := False;
+      Vhpi_Iterator (VhpiInternalRegions, Cur, It, Error);
+      if Error /= AvhpiErrorOk then
+         return;
+      end if;
+      loop
+         Vhpi_Scan (It, Res, Error);
+         exit when Error /= AvhpiErrorOk;
+         if Name_Compare (Res, Name) then
+            Ok := True;
+            return;
+         end if;
+      end loop;
+      return;
+--       Put ("find instance: ");
+--       Put (Name);
+--       New_Line;
+   end Find_Instance;
+
+   procedure Find_Generic
+     (Name : String; Res : out VhpiHandleT; Ok : out Boolean)
+   is
+      Error : AvhpiErrorT;
+      It : VhpiHandleT;
+   begin
+      Ok := False;
+      Vhpi_Iterator (VhpiDecls, Sdf_Inst, It, Error);
+      if Error /= AvhpiErrorOk then
+         return;
+      end if;
+      loop
+         Vhpi_Scan (It, Res, Error);
+         exit when Error /= AvhpiErrorOk;
+         exit when Vhpi_Get_Kind (Res) /= VhpiGenericDeclK;
+         if Name_Compare (Res, Name) then
+            Ok := True;
+            return;
+         end if;
+      end loop;
+      return;
+   end Find_Generic;
+
+   procedure Sdf_Header (Context : in out Sdf_Context_Type)
+   is
+   begin
+      if Flag_Dump then
+         case Context.Version is
+            when Sdf_2_1 =>
+               Put ("found SDF file version 2.1");
+            when Sdf_Version_Unknown =>
+               Put ("found SDF file without version");
+            when Sdf_Version_Bad =>
+               Put ("found SDF file with unknown version");
+         end case;
+         New_Line;
+      end if;
+   end Sdf_Header;
+
+   procedure Sdf_Celltype (Context : in out Sdf_Context_Type)
+   is
+   begin
+      if Flag_Dump then
+         Put ("celltype: ");
+         Put (Context.Celltype (1 .. Context.Celltype_Len));
+         New_Line;
+         Put ("instance:");
+         return;
+      end if;
+      Sdf_Inst := Sdf_Top;
+   end Sdf_Celltype;
+
+   procedure Sdf_Instance (Context : in out Sdf_Context_Type;
+                           Instance : String;
+                           Status : out Boolean)
+   is
+      pragma Unreferenced (Context);
+   begin
+      if Flag_Dump then
+         Put (' ');
+         Put (Instance);
+         Status := True;
+         return;
+      end if;
+
+      Find_Instance (Sdf_Inst, Sdf_Inst, Instance, Status);
+   end Sdf_Instance;
+
+   procedure Sdf_Instance_End (Context : in out Sdf_Context_Type;
+                               Status : out Boolean)
+   is
+   begin
+      if Flag_Dump then
+         Status := True;
+         New_Line;
+         return;
+      end if;
+      case Vhpi_Get_Kind (Sdf_Inst) is
+         when VhpiRootInstK =>
+            declare
+               Hdl : VhpiHandleT;
+               Error : AvhpiErrorT;
+            begin
+               Status := False;
+               Vhpi_Handle (VhpiDesignUnit, Sdf_Inst, Hdl, Error);
+               if Error /= AvhpiErrorOk then
+                  Internal_Error ("VhpiDesignUnit");
+                  return;
+               end if;
+               case Vhpi_Get_Kind (Hdl) is
+                  when VhpiArchBodyK =>
+                     Vhpi_Handle (VhpiPrimaryUnit, Hdl, Hdl, Error);
+                     if Error /= AvhpiErrorOk then
+                        Internal_Error ("VhpiPrimaryUnit");
+                        return;
+                     end if;
+                  when others =>
+                     Internal_Error ("sdf_instance_end");
+               end case;
+               Status := Name_Compare
+                 (Hdl, Context.Celltype (1 .. Context.Celltype_Len));
+            end;
+         when VhpiCompInstStmtK =>
+            Status := Name_Compare
+              (Sdf_Inst,
+               Context.Celltype (1 .. Context.Celltype_Len),
+               VhpiCompNameP);
+         when others =>
+            Status := False;
+      end case;
+   end Sdf_Instance_End;
+
+   VitalDelayType01 : VhpiHandleT;
+
+   type Map_Type is array (1 .. 12) of Natural;
+   Map_1 : constant Map_Type := (1, 1, 1, 1, 1, 1, 0, 0, 0, 0, 0, 0);
+   Map_2 : constant Map_Type := (1, 2, 1, 1, 2, 2, 0, 0, 0, 0, 0, 0);
+   --Map_3 : constant Map_Type := (1, 2, 3, 1, 3, 2, 0, 0, 0, 0, 0, 0);
+   --Map_6 : constant Map_Type := (1, 2, 3, 4, 5, 6, 0, 0, 0, 0, 0, 0);
+   --Map_12 : constant Map_Type := (1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12);
+
+   function Write_Td_Delay_Generic (Context : Sdf_Context_Type;
+                                    Gen : VhpiHandleT;
+                                    Nbr : Natural;
+                                    Map : Map_Type)
+                                   return Boolean
+   is
+      It : VhpiHandleT;
+      El : VhpiHandleT;
+      Error : AvhpiErrorT;
+      N : Natural;
+   begin
+      Vhpi_Iterator (VhpiIndexedNames, Gen, It, Error);
+      if Error /= AvhpiErrorOk then
+         Internal_Error ("vhpiIndexedNames");
+         return False;
+      end if;
+      for I in 1 .. Nbr loop
+         Vhpi_Scan (It, El, Error);
+         if Error /= AvhpiErrorOk then
+            Internal_Error ("scan on vhpiIndexedNames");
+            return False;
+         end if;
+         N := Map (I);
+         if Context.Timing_Set (N) then
+            if Vhpi_Put_Value (El, Context.Timing (N) * 1000) /= AvhpiErrorOk
+            then
+               Internal_Error ("vhpi_put_value");
+               return False;
+            end if;
+         end if;
+      end loop;
+      return True;
+   end Write_Td_Delay_Generic;
+
+   procedure Sdf_Generic (Context : in out Sdf_Context_Type;
+                          Name : String;
+                          Ok : out Boolean)
+   is
+      Gen : VhpiHandleT;
+      Gen_Type : VhpiHandleT;
+      Error : AvhpiErrorT;
+   begin
+      if Flag_Dump then
+         Put ("generic: ");
+         Put (Name);
+         if Context.Timing_Nbr = 0 then
+            Put (' ');
+            Put_I64 (stdout, Context.Timing (1));
+         else
+            for I in 1 .. 12 loop
+               Put (' ');
+               if Context.Timing_Set (I) then
+                  Put_I64 (stdout, Context.Timing (I));
+               else
+                  Put ('?');
+               end if;
+            end loop;
+         end if;
+
+         New_Line;
+         Ok := True;
+         return;
+      end if;
+
+      Find_Generic (Name, Gen, Ok);
+      if not Ok then
+         return;
+      end if;
+
+      Ok := False;
+
+      --  Extract subtype.
+      Vhpi_Handle (VhpiSubtype, Gen, Gen_Type, Error);
+      if Error /= AvhpiErrorOk then
+         Internal_Error ("vhpiSubtype");
+         return;
+      end if;
+      Vhpi_Handle (VhpiTypeMark, Gen_Type, Gen_Type, Error);
+      if Error /= AvhpiErrorOk then
+         Internal_Error ("vhpiTypeMark");
+         return;
+      end if;
+      if Vhpi_Compare_Handles (Gen_Type, VitalDelayType01) then
+         case Context.Timing_Nbr is
+            when 1 =>
+               Ok := Write_Td_Delay_Generic (Context, Gen, 2, Map_1);
+            when 2 =>
+               Ok := Write_Td_Delay_Generic (Context, Gen, 2, Map_2);
+            when others =>
+               Errors.Error
+                 ("timing generic type mismatch SDF timing specification");
+         end case;
+      else
+         Errors.Error ("bad generic type");
+      end if;
+   end Sdf_Generic;
+
+
+   procedure Annotate (Arg : String)
+   is
+      S, E : Natural;
+      Ok : Boolean;
+   begin
+      if Flag_Verbose then
+         Put ("sdf annotate: ");
+         Put (Arg);
+         New_Line;
+      end if;
+
+      --  Find scope by name.
+      Get_Root_Inst (Sdf_Top);
+      E := Arg'First;
+      S := E;
+      L1: loop
+         --  Skip path separator.
+         while Arg (E) = '/' or Arg (E) = '.' loop
+            E := E + 1;
+            exit L1 when E > Arg'Last;
+         end loop;
+
+         exit L1 when E > Arg'Last or else Arg (E) = '=';
+
+         --  Instance element.
+         S := E;
+         while Arg (E) /= '=' and Arg (E) /= '.' and Arg (E) /= '/' loop
+            exit L1 when E > Arg'Last;
+            E := E + 1;
+         end loop;
+
+         --  Path element.
+         if E - 1 >= S then
+            Find_Instance (Sdf_Top, Sdf_Top, Arg (S .. E - 1), Ok);
+            if not Ok then
+               Error_C ("cannot find instance '");
+               Error_C (Arg (S .. E - 1));
+               Error_E ("' for sdf annotation");
+               return;
+            end if;
+         end if;
+      end loop L1;
+
+      --  start annotation.
+      if E >= Arg'Last or else Arg (E) /= '=' then
+         Error_C ("no filename in sdf option '");
+         Error_C (Arg);
+         Error_E ("'");
+         return;
+      end if;
+      if not Sdf.Parse_Sdf_File (Arg (E + 1 .. Arg'Last)) then
+         null;
+      end if;
+   end Annotate;
+
+   procedure Extract_Vital_Delay_Type
+   is
+      It : VhpiHandleT;
+      Pkg : VhpiHandleT;
+      Decl : VhpiHandleT;
+      Status : AvhpiErrorT;
+   begin
+      Get_Package_Inst (It);
+      loop
+         Vhpi_Scan (It, Pkg, Status);
+         exit when Status /= AvhpiErrorOk;
+         exit when Name_Compare (Pkg, "vital_timing")
+           and then Name_Compare (Pkg, "ieee", VhpiLibLogicalNameP);
+      end loop;
+      if Status /= AvhpiErrorOk then
+         Error ("package ieee.vital_timing not found, SDF annotation aborted");
+         return;
+      end if;
+      Vhpi_Iterator (VhpiDecls, Pkg, It, Status);
+      if Status /= AvhpiErrorOk then
+         Error ("cannot iterate on vital_timing");
+         return;
+      end if;
+      loop
+         Vhpi_Scan (It, Decl, Status);
+         exit when Status /= AvhpiErrorOk;
+         if Name_Compare (Decl, "vitaldelaytype01") then
+            VitalDelayType01 := Decl;
+         end if;
+      end loop;
+      if Vhpi_Get_Kind (VitalDelayType01) = VhpiUndefined then
+         Error ("cannot found VitalDelayType01 in ieee.vital_timing");
+         return;
+      end if;
+   end Extract_Vital_Delay_Type;
+
+   Has_Sdf_Option : Boolean := False;
+
+   procedure Sdf_Start
+   is
+      use Grt.Options;
+      Len : Integer;
+      Beg : Integer;
+      Arg : Ghdl_C_String;
+   begin
+      if not Has_Sdf_Option then
+         --  Nothing to do.
+         return;
+      end if;
+      Flag_Dump := False;
+
+      --  Extract VitalDelayType(s) from VITAL_Timing package.
+      Extract_Vital_Delay_Type;
+
+      --  Annotate.
+      for I in 1 .. Last_Opt loop
+         Arg := Argv (I);
+         Len := strlen (Arg);
+         if Len > 5 and then Arg (1 .. 6) = "--sdf=" then
+            Sdf_Mtm := Typical;
+            Beg := 7;
+            if Len > 10 then
+               if Arg (7 .. 10) = "typ=" then
+                  Beg := 11;
+               elsif Arg (7 .. 10) = "min=" then
+                  Sdf_Mtm := Minimum;
+                  Beg := 11;
+               elsif Arg (7 .. 10) = "max=" then
+                  Sdf_Mtm := Maximum;
+                  Beg := 11;
+               end if;
+            end if;
+            Annotate (Arg (Beg .. Len));
+         end if;
+      end loop;
+   end Sdf_Start;
+
+   function Sdf_Option (Opt : String) return Boolean
+   is
+   begin
+      if Opt'Length > 11 and then Opt (1 .. 11) = "--sdf-dump=" then
+         Flag_Dump := True;
+         if Sdf.Parse_Sdf_File (Opt (12 .. Opt'Last)) then
+            null;
+         end if;
+         return True;
+      end if;
+      if Opt'Length > 5 and then Opt (1 .. 6) = "--sdf=" then
+         Has_Sdf_Option := True;
+         return True;
+      else
+         return False;
+      end if;
+   end Sdf_Option;
+
+   procedure Sdf_Help is
+   begin
+      Put_Line (" --sdf=[min=|typ=|max=]TOP=FILENAME");
+      Put_Line ("    annotate TOP with SDF delay file FILENAME");
+   end Sdf_Help;
+
+   Sdf_Hooks : aliased constant Hooks_Type :=
+     (Option => Sdf_Option'Access,
+      Help => Sdf_Help'Access,
+      Init => Proc_Hook_Nil'Access,
+      Start => Sdf_Start'Access,
+      Finish => Proc_Hook_Nil'Access);
+
+   procedure Register is
+   begin
+      Register_Hooks (Sdf_Hooks'Access);
+   end Register;
+end Grt.Vital_Annotate;
diff --git a/translate/grt/grt-vital_annotate.ads b/translate/grt/grt-vital_annotate.ads
new file mode 100644
index 000000000..f1a8b0255
--- /dev/null
+++ b/translate/grt/grt-vital_annotate.ads
@@ -0,0 +1,35 @@
+--  GHDL Run Time (GRT) - VITAL annotator.
+--  Copyright (C) 2002, 2003, 2004, 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.Sdf; use Grt.Sdf;
+
+package Grt.Vital_Annotate is
+   pragma Elaborate_Body (Grt.Vital_Annotate);
+
+   procedure Sdf_Header (Context : in out Sdf_Context_Type);
+   procedure Sdf_Celltype (Context : in out Sdf_Context_Type);
+   procedure Sdf_Instance (Context : in out Sdf_Context_Type;
+                           Instance : String;
+                           Status : out Boolean);
+   procedure Sdf_Instance_End (Context : in out Sdf_Context_Type;
+                               Status : out Boolean);
+   procedure Sdf_Generic (Context : in out Sdf_Context_Type;
+                          Name : String;
+                          Ok : out Boolean);
+
+   procedure Register;
+end Grt.Vital_Annotate;
diff --git a/translate/grt/grt-vpi.adb b/translate/grt/grt-vpi.adb
new file mode 100644
index 000000000..0609d466c
--- /dev/null
+++ b/translate/grt/grt-vpi.adb
@@ -0,0 +1,800 @@
+--  GHDL Run Time (GRT) - VPI interface.
+--  Copyright (C) 2002, 2003, 2004, 2005 Tristan Gingold & Felix Bertram
+--
+--  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.
+
+-- Description: VPI interface for GRT runtime
+--              the main purpose of this code is to interface with the
+--              Icarus Verilog Interactive (IVI) simulator GUI
+
+-------------------------------------------------------------------------------
+-- TODO:
+-------------------------------------------------------------------------------
+-- DONE:
+-- * The GHDL VPI implementation doesn't support time
+--   callbacks (cbReadOnlySynch). This is needed to support
+--   IVI run. Currently, the GHDL simulation runs until
+--   complete once a single 'run' is performed...
+-- * You are loading '_'-prefixed symbols when you
+--   load the vpi plugin. On Linux, there is no leading
+--   '_'. I just added code to try both '_'-prefixed and
+--   non-'_'-prefixed symbols. I have placed the changed
+--   file in the same download dir as the snapshot
+-- * I did find out why restart doesn't work for GHDL.
+--   You are passing back the leaf name of signals when the
+--   FullName is requested.
+-------------------------------------------------------------------------------
+
+with Ada.Unchecked_Deallocation;
+with Grt.Stdio; use Grt.Stdio;
+with Grt.Signals; use Grt.Signals;
+with GNAT.Table;
+with Grt.Astdio; use Grt.Astdio;
+with Grt.Hooks; use Grt.Hooks;
+with Grt.Vcd; use Grt.Vcd;
+with Grt.Errors; use Grt.Errors;
+
+package body Grt.Vpi is
+   --  The VPI interface requires libdl (dlopen, dlsym) to be linked in.
+   --  This is now set in Makefile, since this is target dependent.
+   --  pragma Linker_Options ("-ldl");
+
+   --errAnyString:     constant String := "grt-vcd.adb: any string" & NUL;
+   --errNoString:      constant String := "grt-vcd.adb: no string" & NUL;
+
+   type Vpi_Index_Type is new Natural;
+
+-------------------------------------------------------------------------------
+-- * * *   h e l p e r s   * * * * * * * * * * * * * * * * * * * * * * * * * *
+-------------------------------------------------------------------------------
+
+   ------------------------------------------------------------------------
+   -- debugging helpers
+   procedure dbgPut (Str : String)
+   is
+      S : size_t;
+   begin
+      S := fwrite (Str'Address, Str'Length, 1, stderr);
+   end dbgPut;
+
+   procedure dbgPut (C : Character)
+   is
+      R : int;
+   begin
+      R := fputc (Character'Pos (C), stderr);
+   end dbgPut;
+
+   procedure dbgNew_Line is
+   begin
+      dbgPut (Nl);
+   end dbgNew_Line;
+
+   procedure dbgPut_Line (Str : String)
+   is
+   begin
+      dbgPut (Str);
+      dbgNew_Line;
+   end dbgPut_Line;
+
+--    procedure dbgPut_Line (Str : Ghdl_Str_Len_Type)
+--    is
+--    begin
+--       Put_Str_Len(stderr, Str);
+--       dbgNew_Line;
+--    end dbgPut_Line;
+
+   procedure Free is new Ada.Unchecked_Deallocation
+     (Name => vpiHandle, Object => struct_vpiHandle);
+
+   ------------------------------------------------------------------------
+   -- NUL-terminate strings.
+   -- note: there are several buffers
+   -- see IEEE 1364-2001
+--   tmpstring1: string(1..1024);
+--    function NulTerminate1 (Str : Ghdl_Str_Len_Type) return Ghdl_C_String
+--    is
+--    begin
+--       for i in 1..Str.Len loop
+--          tmpstring1(i):= Str.Str(i);
+--       end loop;
+--       tmpstring1(Str.Len+1):= NUL;
+--       return To_Ghdl_C_String (tmpstring1'Address);
+--    end NulTerminate1;
+
+-------------------------------------------------------------------------------
+-- * * *   V P I   f u n c t i o n s   * * * * * * * * * * * * * * * * * * * *
+-------------------------------------------------------------------------------
+
+   ------------------------------------------------------------------------
+   -- vpiHandle  vpi_iterate(int type, vpiHandle ref)
+   -- Obtain an iterator handle to objects with a one-to-many relationship.
+   -- see IEEE 1364-2001, page 685
+   function vpi_iterate (aType: integer; Ref: vpiHandle) return vpiHandle
+   is
+      Res : vpiHandle;
+      Rel : VhpiOneToManyT;
+      Error : AvhpiErrorT;
+   begin
+      --dbgPut_Line ("vpi_iterate");
+
+      case aType is
+         when vpiNet =>
+            Rel := VhpiDecls;
+         when vpiModule =>
+            if Ref = null then
+               Res := new struct_vpiHandle (vpiModule);
+               Get_Root_Inst (Res.Ref);
+               return Res;
+            else
+               Rel := VhpiInternalRegions;
+            end if;
+         when vpiInternalScope =>
+            Rel := VhpiInternalRegions;
+         when others =>
+            return null;
+      end case;
+
+      -- find the proper start object for our scan
+      if Ref = null then
+         return null;
+      end if;
+
+      Res := new struct_vpiHandle (aType);
+      Vhpi_Iterator (Rel, Ref.Ref, Res.Ref, Error);
+
+      if Error /= AvhpiErrorOk then
+         Free (Res);
+      end if;
+      return Res;
+   end vpi_iterate;
+
+   ------------------------------------------------------------------------
+   -- int vpi_get(int property, vpiHandle ref)
+   -- Get the value of an integer or boolean property of an object.
+   -- see IEEE 1364-2001, chapter 27.6, page 667
+--    function ii_vpi_get_type (aRef: Ghdl_Instance_Name_Acc) return Integer
+--    is
+--    begin
+--       case aRef.Kind is
+--          when Ghdl_Name_Entity
+--            | Ghdl_Name_Architecture
+--            | Ghdl_Name_Block
+--            | Ghdl_Name_Generate_Iterative
+--            | Ghdl_Name_Generate_Conditional
+--            | Ghdl_Name_Instance =>
+--             return vpiModule;
+--          when Ghdl_Name_Signal =>
+--             return vpiNet;
+--          when others =>
+--             return vpiUndefined;
+--       end case;
+--    end ii_vpi_get_type;
+
+   function vpi_get (Property: integer; Ref: vpiHandle) return Integer
+   is
+   begin
+      case Property is
+         when vpiType=>
+            return Ref.mType;
+         when vpiTimePrecision=>
+            return -9; -- is this nano-seconds?
+         when others=>
+            dbgPut_Line ("vpi_get: unknown property");
+            return 0;
+      end case;
+   end vpi_get;
+
+   ------------------------------------------------------------------------
+   -- vpiHandle  vpi_scan(vpiHandle iter)
+   -- Scan the Verilog HDL hierarchy for objects with a one-to-many
+   -- relationship.
+   -- see IEEE 1364-2001, chapter 27.36, page 709
+   function vpi_scan (Iter: vpiHandle) return vpiHandle
+   is
+      Res : VhpiHandleT;
+      Error : AvhpiErrorT;
+      R : vpiHandle;
+   begin
+      --dbgPut_Line ("vpi_scan");
+      if Iter = null then
+         return null;
+      end if;
+
+      --  There is only one top-level module.
+      if Iter.mType = vpiModule then
+         case Vhpi_Get_Kind (Iter.Ref) is
+            when VhpiRootInstK =>
+               R := new struct_vpiHandle (Iter.mType);
+               R.Ref := Iter.Ref;
+               Iter.Ref := Null_Handle;
+               return R;
+            when VhpiUndefined =>
+               return null;
+            when others =>
+               --  Fall through.
+               null;
+         end case;
+      end if;
+
+      loop
+         Vhpi_Scan (Iter.Ref, Res, Error);
+         exit when Error /= AvhpiErrorOk;
+
+         case Vhpi_Get_Kind (Res) is
+            when VhpiEntityDeclK
+              | VhpiArchBodyK
+              | VhpiBlockStmtK
+              | VhpiIfGenerateK
+              | VhpiForGenerateK
+              | VhpiCompInstStmtK =>
+               case Iter.mType is
+                  when vpiInternalScope
+                    | vpiModule =>
+                     return new struct_vpiHandle'(mType => vpiModule,
+                                                  Ref => Res);
+                  when others =>
+                     null;
+               end case;
+            when VhpiPortDeclK
+              | VhpiSigDeclK =>
+               if Iter.mType = vpiNet then
+                  declare
+                     Info : Verilog_Wire_Info;
+                  begin
+                     Get_Verilog_Wire (Res, Info);
+                     if Info.Kind /= Vcd_Bad then
+                        return new struct_vpiHandle'(mType => vpiNet,
+                                                     Ref => Res);
+                     end if;
+                  end;
+               end if;
+            when others =>
+               null;
+         end case;
+      end loop;
+      return null;
+   end vpi_scan;
+
+   ------------------------------------------------------------------------
+   -- char *vpi_get_str(int property, vpiHandle ref)
+   -- see IEEE 1364-2001, page xxx
+   Tmpstring2 : String (1 .. 1024);
+   function vpi_get_str (Property : Integer; Ref : vpiHandle)
+                        return Ghdl_C_String
+   is
+      Prop : VhpiStrPropertyT;
+      Len : Natural;
+   begin
+      --dbgPut_Line ("vpiGetStr");
+
+      if Ref = null then
+         return null;
+      end if;
+
+      case Property is
+         when vpiFullName=>
+            Prop := VhpiFullNameP;
+         when vpiName=>
+            Prop := VhpiNameP;
+         when others=>
+            dbgPut_Line ("vpi_get_str: undefined property");
+            return null;
+      end case;
+      Vhpi_Get_Str (Prop, Ref.Ref, Tmpstring2, Len);
+      Tmpstring2 (Len + 1) := NUL;
+      if Property = vpiFullName then
+         for I in Tmpstring2'First .. Len loop
+            if Tmpstring2 (I) = ':' then
+               Tmpstring2 (I) := '.';
+            end if;
+         end loop;
+         --  Remove the initial '.'.
+         return To_Ghdl_C_String (Tmpstring2 (2)'Address);
+      else
+         return To_Ghdl_C_String (Tmpstring2'Address);
+      end if;
+   end vpi_get_str;
+
+   ------------------------------------------------------------------------
+   -- vpiHandle  vpi_handle(int type, vpiHandle ref)
+   -- Obtain a handle to an object with a one-to-one relationship.
+   -- see IEEE 1364-2001, chapter 27.16, page 682
+   function vpi_handle (aType : Integer; Ref : vpiHandle) return vpiHandle
+   is
+      Res : vpiHandle;
+   begin
+      --dbgPut_Line ("vpi_handle");
+
+      if Ref = null then
+         return null;
+      end if;
+
+      case aType is
+         when vpiScope =>
+            case Ref.mType is
+               when vpiModule =>
+                  Res := new struct_vpiHandle (vpiScope);
+                  Res.Ref := Ref.Ref;
+                  return Res;
+               when others =>
+                  return null;
+            end case;
+         when vpiRightRange
+           | vpiLeftRange =>
+            case Ref.mType is
+               when vpiNet =>
+                  Res := new struct_vpiHandle (aType);
+                  Res.Ref := Ref.Ref;
+                  return Res;
+               when others =>
+                  return null;
+            end case;
+         when others =>
+            return null;
+      end case;
+   end vpi_handle;
+
+   ------------------------------------------------------------------------
+   -- void  vpi_get_value(vpiHandle expr, p_vpi_value value);
+   -- Retrieve the simulation value of an object.
+   -- see IEEE 1364-2001, chapter 27.14, page 675
+   Tmpstring3idx : integer;
+   Tmpstring3 : String (1 .. 1024);
+   procedure ii_vpi_get_value_bin_str_B2 (Val : Ghdl_B2)
+   is
+   begin
+      case Val is
+         when True =>
+            Tmpstring3 (Tmpstring3idx) := '1';
+         when False =>
+            Tmpstring3 (Tmpstring3idx) := '0';
+      end case;
+      Tmpstring3idx := Tmpstring3idx + 1;
+   end ii_vpi_get_value_bin_str_B2;
+
+   procedure ii_vpi_get_value_bin_str_E8 (Val : Ghdl_E8)
+   is
+      type Map_Type_E8 is array (Ghdl_E8 range 0..8) of character;
+      Map_Std_E8: constant Map_Type_E8 := "UX01ZWLH-";
+   begin
+      if Val not in Map_Type_E8'range then
+         Tmpstring3 (Tmpstring3idx) := '?';
+      else
+         Tmpstring3 (Tmpstring3idx) := Map_Std_E8(Val);
+      end if;
+      Tmpstring3idx := Tmpstring3idx + 1;
+   end ii_vpi_get_value_bin_str_E8;
+
+   function ii_vpi_get_value_bin_str (Obj : VhpiHandleT)
+                                     return Ghdl_C_String
+   is
+      Info : Verilog_Wire_Info;
+      Len : Ghdl_Index_Type;
+   begin
+      case Vhpi_Get_Kind (Obj) is
+         when VhpiPortDeclK
+           | VhpiSigDeclK =>
+            null;
+         when others =>
+            return null;
+      end case;
+
+      --  Get verilog compat info.
+      Get_Verilog_Wire (Obj, Info);
+      if Info.Kind = Vcd_Bad then
+         return null;
+      end if;
+
+      if Info.Irange = null then
+         Len := 1;
+      else
+         Len := Info.Irange.I32.Len;
+      end if;
+
+      Tmpstring3idx := 1; -- reset string buffer
+
+      case Info.Val is
+         when Vcd_Effective =>
+            case Info.Kind is
+               when Vcd_Bad
+                 | Vcd_Integer32 =>
+                  return null;
+               when Vcd_Bit
+                 | Vcd_Bool
+                 | Vcd_Bitvector =>
+                  for J in 0 .. Len - 1 loop
+                     ii_vpi_get_value_bin_str_B2
+                       (To_Signal_Arr_Ptr (Info.Addr)(J).Value.B2);
+                  end loop;
+               when Vcd_Stdlogic
+                 | Vcd_Stdlogic_Vector =>
+                  for J in 0 .. Len - 1 loop
+                     ii_vpi_get_value_bin_str_E8
+                       (To_Signal_Arr_Ptr (Info.Addr)(J).Value.E8);
+                  end loop;
+            end case;
+         when Vcd_Driving =>
+            case Info.Kind is
+               when Vcd_Bad
+                 | Vcd_Integer32 =>
+                  return null;
+               when Vcd_Bit
+                 | Vcd_Bool
+                 | Vcd_Bitvector =>
+                  for J in 0 .. Len - 1 loop
+                     ii_vpi_get_value_bin_str_B2
+                       (To_Signal_Arr_Ptr (Info.Addr)(J).Driving_Value.B2);
+                  end loop;
+               when Vcd_Stdlogic
+                 | Vcd_Stdlogic_Vector =>
+                  for J in 0 .. Len - 1 loop
+                     ii_vpi_get_value_bin_str_E8
+                       (To_Signal_Arr_Ptr (Info.Addr)(J).Driving_Value.E8);
+                  end loop;
+            end case;
+      end case;
+      Tmpstring3 (Tmpstring3idx) := NUL;
+      return To_Ghdl_C_String (Tmpstring3'Address);
+   end ii_vpi_get_value_bin_str;
+
+   procedure vpi_get_value (Expr : vpiHandle; Value : p_vpi_value)
+   is
+   begin
+      case Value.Format is
+         when vpiObjTypeVal=>
+            -- fill in the object type and value:
+            -- For an integer, vpiIntVal
+            -- For a real, vpiRealVal
+            -- For a scalar, either vpiScalar or vpiStrength
+            -- For a time variable, vpiTimeVal with vpiSimTime
+            -- For a vector, vpiVectorVal
+            dbgPut_Line ("vpi_get_value: vpiObjTypeVal");
+         when vpiBinStrVal=>
+            Value.Str := ii_vpi_get_value_bin_str (Expr.Ref);
+            --aValue.mStr := NulTerminate2(aExpr.mRef.Name.all);
+         when vpiOctStrVal=>
+            dbgPut_Line("vpi_get_value: vpiNet, vpiOctStrVal");
+         when vpiDecStrVal=>
+            dbgPut_Line("vpi_get_value: vpiNet, vpiDecStrVal");
+         when vpiHexStrVal=>
+            dbgPut_Line("vpi_get_value: vpiNet, vpiHexStrVal");
+         when vpiScalarVal=>
+            dbgPut_Line("vpi_get_value: vpiNet, vpiScalarVal");
+         when vpiIntVal=>
+            case Expr.mType is
+               when vpiLeftRange
+                 | vpiRightRange=>
+                  declare
+                     Info : Verilog_Wire_Info;
+                  begin
+                     Get_Verilog_Wire (Expr.Ref, Info);
+                     if Info.Irange /= null then
+                        if Expr.mType = vpiLeftRange then
+                           Value.Integer_m := Integer (Info.Irange.I32.Left);
+                        else
+                           Value.Integer_m := Integer (Info.Irange.I32.Right);
+                        end if;
+                     else
+                        Value.Integer_m  := 0;
+                     end if;
+                  end;
+               when others=>
+                  dbgPut_Line ("vpi_get_value: vpiIntVal, unknown mType");
+            end case;
+         when vpiRealVal=>     dbgPut_Line("vpi_get_value: vpiRealVal");
+         when vpiStringVal=>   dbgPut_Line("vpi_get_value: vpiStringVal");
+         when vpiTimeVal=>     dbgPut_Line("vpi_get_value: vpiTimeVal");
+         when vpiVectorVal=>   dbgPut_Line("vpi_get_value: vpiVectorVal");
+         when vpiStrengthVal=> dbgPut_Line("vpi_get_value: vpiStrengthVal");
+         when others=>         dbgPut_Line("vpi_get_value: unknown mFormat");
+      end case;
+   end vpi_get_value;
+
+   ------------------------------------------------------------------------
+   -- void  vpi_get_time(vpiHandle obj, s_vpi_time*t);
+   -- see IEEE 1364-2001, page xxx
+   Sim_Time : Std_Time;
+   procedure vpi_get_time (Obj: vpiHandle; Time: p_vpi_time)
+   is
+      pragma Unreferenced (Obj);
+   begin
+      --dbgPut_Line ("vpi_get_time");
+      Time.mType := vpiSimTime;
+      Time.mHigh := 0;
+      Time.mLow  := Integer (Sim_Time / 1000000);
+      Time.mReal := 0.0;
+   end vpi_get_time;
+
+   ------------------------------------------------------------------------
+   -- vpiHandle vpi_register_cb(p_cb_data data)
+   g_cbEndOfCompile : p_cb_data;
+   g_cbEndOfSimulation: p_cb_data;
+   --g_cbValueChange:     s_cb_data;
+   g_cbReadOnlySync:    p_cb_data;
+
+   type Vpi_Var_Type is record
+      Info : Verilog_Wire_Info;
+      Cb   : s_cb_data;
+   end record;
+
+   package Vpi_Table is new GNAT.Table
+     (Table_Component_Type => Vpi_Var_Type,
+      Table_Index_Type     => Vpi_Index_Type,
+      Table_Low_Bound      => 0,
+      Table_Initial        => 32,
+      Table_Increment      => 100);
+
+   function vpi_register_cb (Data : p_cb_data) return vpiHandle
+   is
+      Res : p_cb_data := null;
+   begin
+      --dbgPut_Line ("vpi_register_cb");
+      case Data.Reason is
+         when cbEndOfCompile =>
+            Res := new s_cb_data'(Data.all);
+            g_cbEndOfCompile := Res;
+            Sim_Time:= 0;
+         when cbEndOfSimulation =>
+            Res := new s_cb_data'(Data.all);
+            g_cbEndOfSimulation := Res;
+         when cbValueChange =>
+            declare
+               N : Vpi_Index_Type;
+            begin
+               --g_cbValueChange:=     aData.all;
+               Vpi_Table.Increment_Last;
+               N := Vpi_Table.Last;
+               Vpi_Table.Table (N).Cb := Data.all;
+               Get_Verilog_Wire (Data.Obj.Ref, Vpi_Table.Table (N).Info);
+            end;
+         when cbReadOnlySynch=>
+            Res := new s_cb_data'(Data.all);
+            g_cbReadOnlySync := Res;
+         when others=>
+            dbgPut_Line ("vpi_register_cb: unknwon reason");
+      end case;
+      if Res /= null then
+         return new struct_vpiHandle'(mType => vpiCallback,
+                                      Cb => Res);
+      else
+         return null;
+      end if;
+   end vpi_register_cb;
+
+-------------------------------------------------------------------------------
+-- * * *   V P I   d u m m i e s   * * * * * * * * * * * * * * * * * * * * * *
+-------------------------------------------------------------------------------
+
+   -- int vpi_free_object(vpiHandle ref)
+   function vpi_free_object (aRef: vpiHandle) return integer
+   is
+      pragma Unreferenced (aRef);
+   begin
+      return 0;
+   end vpi_free_object;
+
+   -- int vpi_get_vlog_info(p_vpi_vlog_info vlog_info_p)
+   function vpi_get_vlog_info (aVlog_info_p: System.Address) return integer
+   is
+      pragma Unreferenced (aVlog_info_p);
+   begin
+      return 0;
+   end vpi_get_vlog_info;
+
+   -- vpiHandle vpi_handle_by_index(vpiHandle ref, int index)
+   function vpi_handle_by_index(aRef: vpiHandle; aIndex: integer)
+                               return vpiHandle
+   is
+      pragma Unreferenced (aRef);
+      pragma Unreferenced (aIndex);
+   begin
+      return null;
+   end vpi_handle_by_index;
+
+   -- unsigned int vpi_mcd_close(unsigned int mcd)
+   function vpi_mcd_close (Mcd: integer) return integer
+   is
+      pragma Unreferenced (Mcd);
+   begin
+      return 0;
+   end vpi_mcd_close;
+
+   -- char *vpi_mcd_name(unsigned int mcd)
+   function vpi_mcd_name (Mcd: integer) return integer
+   is
+      pragma Unreferenced (Mcd);
+   begin
+      return 0;
+   end vpi_mcd_name;
+
+   -- unsigned int vpi_mcd_open(char *name)
+   function vpi_mcd_open (Name : Ghdl_C_String) return Integer
+   is
+      pragma Unreferenced (Name);
+   begin
+      return 0;
+   end vpi_mcd_open;
+
+   -- vpiHandle vpi_put_value(vpiHandle obj, p_vpi_value value,
+   --                         p_vpi_time when, int flags)
+   function vpi_put_value (aObj: vpiHandle;
+                           aValue: p_vpi_value;
+                           aWhen: p_vpi_time;
+                           aFlags: integer)
+                         return vpiHandle
+   is
+      pragma Unreferenced (aObj);
+      pragma Unreferenced (aValue);
+      pragma Unreferenced (aWhen);
+      pragma Unreferenced (aFlags);
+   begin
+      return null;
+   end vpi_put_value;
+
+   -- void vpi_register_systf(const struct t_vpi_systf_data*ss)
+   procedure vpi_register_systf(aSs: System.Address)
+   is
+      pragma Unreferenced (aSs);
+   begin
+      null;
+   end vpi_register_systf;
+
+   -- int vpi_remove_cb(vpiHandle ref)
+   function vpi_remove_cb (Ref : vpiHandle) return Integer
+   is
+      pragma Unreferenced (Ref);
+   begin
+      return 0;
+   end vpi_remove_cb;
+
+   -- void vpi_vprintf(const char*fmt, va_list ap)
+   procedure vpi_vprintf (Fmt : Address; Ap : Address)
+   is
+      pragma Unreferenced (Fmt);
+      pragma Unreferenced (Ap);
+   begin
+      null;
+   end vpi_vprintf;
+
+   -- missing here, see grt-cvpi.c:
+   --    vpi_mcd_open_x
+   --    vpi_mcd_vprintf
+   --    vpi_mcd_fputc
+   --    vpi_mcd_fgetc
+   --    vpi_sim_vcontrol
+   --    vpi_chk_error
+   --    pi_handle_by_name
+
+------------------------------------------------------------------------------
+-- * * *   G H D L   h o o k s   * * * * * * * * * * * * * * * * * * * * * * *
+------------------------------------------------------------------------------
+
+   --  VCD filename.
+   Vpi_Filename : String_Access := null;
+
+   ------------------------------------------------------------------------
+   --  Return TRUE if OPT is an option for VPI.
+   function Vpi_Option (Opt : String) return Boolean
+   is
+      F : Natural := Opt'First;
+   begin
+      if Opt'Length < 5 or else Opt (F .. F + 4) /= "--vpi" then
+         return False;
+      end if;
+      if Opt'Length > 6 and then Opt (F + 5) = '=' then
+         --  Add an extra NUL character.
+         Vpi_Filename := new String (1 .. Opt'Length - 6 + 1);
+         Vpi_Filename (1 .. Opt'Length - 6) := Opt (F + 6 .. Opt'Last);
+         Vpi_Filename (Vpi_Filename'Last) := NUL;
+         return True;
+      else
+         return False;
+      end if;
+   end Vpi_Option;
+
+   ------------------------------------------------------------------------
+   procedure Vpi_Help is
+   begin
+      Put_Line (" --vpi=FILENAME     load VPI module");
+   end Vpi_Help;
+
+   ------------------------------------------------------------------------
+   --  Called before elaboration.
+
+   -- void loadVpiModule(const char* modulename)
+   function LoadVpiModule (Filename: Address) return Integer;
+   pragma Import (C, LoadVpiModule, "loadVpiModule");
+
+
+   procedure Vpi_Init
+   is
+   begin
+      Sim_Time:= 0;
+
+      --g_cbEndOfCompile.mCb_rtn:= null;
+      --g_cbEndOfSimulation.mCb_rtn:= null;
+      --g_cbValueChange.mCb_rtn:= null;
+
+      if Vpi_Filename /= null then
+         if LoadVpiModule (Vpi_Filename.all'Address) /= 0 then
+            Error ("cannot load VPI module");
+         end if;
+      end if;
+   end Vpi_Init;
+
+   procedure Vpi_Cycle;
+
+   ------------------------------------------------------------------------
+   --  Called after elaboration.
+   procedure Vpi_Start
+   is
+      Res : Integer;
+   begin
+      if g_cbEndOfCompile /= null then
+         Res := g_cbEndOfCompile.Cb_Rtn.all (g_cbEndOfCompile);
+      end if;
+      if Vpi_Filename /= null then
+         Register_Cycle_Hook (Vpi_Cycle'Access);
+      end if;
+   end Vpi_Start;
+
+   ------------------------------------------------------------------------
+   --  Called before each non delta cycle.
+   procedure Vpi_Cycle
+   is
+      Res : Integer;
+   begin
+      if g_cbReadOnlySync /= null
+        and then g_cbReadOnlySync.Time.mLow < Integer (Sim_Time / 1_000_000)
+      then
+         Res := g_cbReadOnlySync.Cb_Rtn.all (g_cbReadOnlySync);
+      end if;
+
+      for I in Vpi_Table.First .. Vpi_Table.Last loop
+         if Verilog_Wire_Changed (Vpi_Table.Table (I).Info, Sim_Time) then
+            Res := Vpi_Table.Table (I).Cb.Cb_Rtn.all
+              (To_p_cb_data (Vpi_Table.Table (I).Cb'Address));
+         end if;
+      end loop;
+
+      if Current_Time /= Std_Time'last then
+         Sim_Time:= Current_Time;
+      end if;
+   end Vpi_Cycle;
+
+   ------------------------------------------------------------------------
+   --  Called at the end of the simulation.
+   procedure Vpi_End
+   is
+      Res : Integer;
+   begin
+      if g_cbEndOfSimulation /= null then
+         Res := g_cbEndOfSimulation.Cb_Rtn.all (g_cbEndOfSimulation);
+      end if;
+   end Vpi_End;
+
+   Vpi_Hooks : aliased constant Hooks_Type :=
+     (Option => Vpi_Option'Access,
+      Help => Vpi_Help'Access,
+      Init => Vpi_Init'Access,
+      Start => Vpi_Start'Access,
+      Finish => Vpi_End'Access);
+
+   procedure Register is
+   begin
+      Register_Hooks (Vpi_Hooks'Access);
+   end Register;
+end Grt.Vpi;
diff --git a/translate/grt/grt-vpi.ads b/translate/grt/grt-vpi.ads
new file mode 100644
index 000000000..9f4ffa93c
--- /dev/null
+++ b/translate/grt/grt-vpi.ads
@@ -0,0 +1,251 @@
+--  GHDL Run Time (GRT) - VPI interface.
+--  Copyright (C) 2002, 2003, 2004, 2005 Tristan Gingold & Felix Bertram
+--
+--  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.
+
+-- Description: VPI interface for GRT runtime
+--              the main purpose of this code is to interface with the
+--              Icarus Verilog Interactive (IVI) simulator GUI
+
+with System; use System;
+with Ada.Unchecked_Conversion;
+with Grt.Types; use Grt.Types;
+with Grt.Avhpi; use Grt.Avhpi;
+
+package Grt.Vpi is
+
+   -- properties, see vpi_user.h
+   vpiUndefined:     constant integer := -1;
+   vpiType:          constant integer :=  1;
+   vpiName:          constant integer :=  2;
+   vpiFullName:      constant integer :=  3;
+   vpiTimePrecision: constant integer := 12;
+
+   -- object codes, see vpi_user.h
+   vpiModule:        constant integer := 32;
+   vpiNet:           constant integer := 36;
+   vpiScope:         constant integer := 84;
+   vpiInternalScope: constant integer := 92;
+   vpiLeftRange:     constant integer := 79;
+   vpiRightRange:    constant integer := 83;
+
+   --  Additionnal constants.
+   vpiCallback :     constant Integer := 200;
+
+   -- codes for the format tag of the vpi_value structure
+   vpiBinStrVal:     constant integer :=  1;
+   vpiOctStrVal:     constant integer :=  2;
+   vpiDecStrVal:     constant integer :=  3;
+   vpiHexStrVal:     constant integer :=  4;
+   vpiScalarVal:     constant integer :=  5;
+   vpiIntVal:        constant integer :=  6;
+   vpiRealVal:       constant integer :=  7;
+   vpiStringVal:     constant integer :=  8;
+   vpiVectorVal:     constant integer :=  9;
+   vpiStrengthVal:   constant integer := 10;
+   vpiTimeVal:       constant integer := 11;
+   vpiObjTypeVal:    constant integer := 12;
+   vpiSuppressVal:   constant integer := 13;
+
+   -- codes for type tag of vpi_time structure
+   vpiSimTime:       constant integer :=  2;
+
+   -- codes for the reason tag of cb_data structure
+   cbValueChange:    constant integer:= 1;
+   cbReadOnlySynch:  constant integer:= 7;
+   cbEndOfCompile:   constant integer:= 10;
+   cbEndOfSimulation:constant integer:= 12;
+
+   type struct_vpiHandle (mType : Integer := vpiUndefined);
+   type vpiHandle is access struct_vpiHandle;
+
+   -- typedef struct t_vpi_time {
+   --   int type;
+   --   unsigned int high;
+   --   unsigned int low;
+   --   double real;
+   -- } s_vpi_time, *p_vpi_time;
+   type s_vpi_time is record
+      mType : integer;
+      mHigh : integer; -- this should be unsigned
+      mLow :  integer; -- this should be unsigned
+      mReal : float;   -- this should be double
+   end record;
+   type p_vpi_time is access s_vpi_time;
+
+   -- typedef struct t_vpi_value
+   -- { int format;
+   --   union
+   --   {       char*str;
+   --           int scalar;
+   --           int integer;
+   --           double real;
+   --           struct t_vpi_time *time;
+   --           struct t_vpi_vecval *vector;
+   --           struct t_vpi_strengthval *strength;
+   --           char*misc;
+   --   } value;
+   -- } s_vpi_value, *p_vpi_value;
+   type s_vpi_value (Format : integer) is record
+      case Format is
+         when vpiBinStrVal
+           | vpiOctStrVal
+           | vpiDecStrVal
+           | vpiHexStrVal
+           | vpiStringVal =>
+            Str : Ghdl_C_String;
+         when vpiScalarVal =>
+            Scalar : Integer;
+         when vpiIntVal =>
+            Integer_m : Integer;
+            --when vpiRealVal=>     null; -- what is the equivalent to double?
+            --when vpiTimeVal=>     mTime:     p_vpi_time;
+            --when vpiVectorVal=>   mVector:   p_vpi_vecval;
+            --when vpiStrengthVal=> mStrength: p_vpi_strengthval;
+         when others =>
+            null;
+         end case;
+      end record;
+   type p_vpi_value is access s_vpi_value;
+
+   --typedef struct t_cb_data {
+   --      int reason;
+   --      int (*cb_rtn)(struct t_cb_data*cb);
+   --      vpiHandle obj;
+   --      p_vpi_time time;
+   --      p_vpi_value value;
+   --      int index;
+   --      char*user_data;
+   --} s_cb_data, *p_cb_data;
+   type s_cb_data;
+
+   type p_cb_data is access all s_cb_data;
+   function To_p_cb_data is new Ada.Unchecked_Conversion
+     (Source => Address, Target => p_cb_data);
+
+   type cb_rtn_type is access function (Cb : p_cb_data) return Integer;
+
+   type s_cb_data is record
+      Reason : Integer;
+      Cb_Rtn : cb_rtn_type;
+      Obj : vpiHandle;
+      Time : p_vpi_time;
+      Value : p_vpi_value;
+      Index : Integer;
+      User_Data : Address;
+   end record;
+
+   type struct_vpiHandle (mType : Integer := vpiUndefined) is record
+      case mType is
+         when vpiCallback =>
+            Cb : p_cb_data;
+         when others =>
+            Ref   : VhpiHandleT;
+      end case;
+   end record;
+
+   -- vpiHandle  vpi_iterate(int type, vpiHandle ref)
+   function vpi_iterate (aType : Integer; Ref : vpiHandle) return vpiHandle;
+   pragma Export (C, vpi_iterate, "vpi_iterate");
+
+   -- int vpi_get(int property, vpiHandle ref)
+   function vpi_get (Property : Integer; Ref : vpiHandle) return Integer;
+   pragma Export (C, vpi_get, "vpi_get");
+
+   -- vpiHandle  vpi_scan(vpiHandle iter)
+   function vpi_scan (Iter : vpiHandle) return vpiHandle;
+   pragma Export (C, vpi_scan, "vpi_scan");
+
+   -- char *vpi_get_str(int property, vpiHandle ref)
+   function vpi_get_str (Property : Integer; Ref : vpiHandle)
+                       return Ghdl_C_String;
+   pragma Export (C, vpi_get_str, "vpi_get_str");
+
+   -- vpiHandle  vpi_handle(int type, vpiHandle ref)
+   function vpi_handle (aType: integer; Ref: vpiHandle)
+                       return vpiHandle;
+   pragma Export (C, vpi_handle, "vpi_handle");
+
+   -- void  vpi_get_value(vpiHandle expr, p_vpi_value value);
+   procedure vpi_get_value (Expr : vpiHandle; Value : p_vpi_value);
+   pragma Export (C, vpi_get_value, "vpi_get_value");
+
+   -- void  vpi_get_time(vpiHandle obj, s_vpi_time*t);
+   procedure vpi_get_time (Obj: vpiHandle; Time: p_vpi_time);
+   pragma Export (C, vpi_get_time, "vpi_get_time");
+
+   -- vpiHandle vpi_register_cb(p_cb_data data)
+   function vpi_register_cb (Data : p_cb_data) return vpiHandle;
+   pragma Export (C, vpi_register_cb, "vpi_register_cb");
+
+-------------------------------------------------------------------------------
+-- * * *   V P I   d u m m i e s   * * * * * * * * * * * * * * * * * * * * * *
+-------------------------------------------------------------------------------
+
+   -- int vpi_free_object(vpiHandle ref)
+   function vpi_free_object(aRef: vpiHandle) return integer;
+   pragma Export (C, vpi_free_object, "vpi_free_object");
+
+   -- int vpi_get_vlog_info(p_vpi_vlog_info vlog_info_p)
+   function vpi_get_vlog_info(aVlog_info_p: System.Address) return integer;
+   pragma Export (C, vpi_get_vlog_info, "vpi_get_vlog_info");
+
+   -- vpiHandle vpi_handle_by_index(vpiHandle ref, int index)
+   function vpi_handle_by_index(aRef: vpiHandle; aIndex: integer)
+                               return vpiHandle;
+   pragma Export (C, vpi_handle_by_index, "vpi_handle_by_index");
+
+   -- unsigned int vpi_mcd_close(unsigned int mcd)
+   function vpi_mcd_close (Mcd : Integer) return Integer;
+   pragma Export (C, vpi_mcd_close, "vpi_mcd_close");
+
+   -- char *vpi_mcd_name(unsigned int mcd)
+   function vpi_mcd_name (Mcd : Integer) return Integer;
+   pragma Export (C, vpi_mcd_name, "vpi_mcd_name");
+
+   -- unsigned int vpi_mcd_open(char *name)
+   function vpi_mcd_open (Name : Ghdl_C_String) return Integer;
+   pragma Export (C, vpi_mcd_open, "vpi_mcd_open");
+
+   -- vpiHandle vpi_put_value(vpiHandle obj, p_vpi_value value,
+   --                         p_vpi_time when, int flags)
+   function vpi_put_value (aObj : vpiHandle;
+                           aValue : p_vpi_value;
+                           aWhen : p_vpi_time;
+                           aFlags : integer)
+                          return vpiHandle;
+   pragma Export (C, vpi_put_value, "vpi_put_value");
+
+   -- void vpi_register_systf(const struct t_vpi_systf_data*ss)
+   procedure vpi_register_systf (aSs : Address);
+   pragma Export (C, vpi_register_systf, "vpi_register_systf");
+
+   -- int vpi_remove_cb(vpiHandle ref)
+   function vpi_remove_cb (Ref : vpiHandle) return integer;
+   pragma Export (C, vpi_remove_cb, "vpi_remove_cb");
+
+   -- void vpi_vprintf(const char*fmt, va_list ap)
+   procedure vpi_vprintf (Fmt: Address; Ap: Address);
+   pragma Export (C, vpi_vprintf, "vpi_vprintf");
+
+-------------------------------------------------------------------------------
+-- * * *   G H D L   h o o k s   * * * * * * * * * * * * * * * * * * * * * * *
+-------------------------------------------------------------------------------
+
+   procedure Register;
+
+end Grt.Vpi;
+
diff --git a/translate/grt/grt-vstrings.adb b/translate/grt/grt-vstrings.adb
new file mode 100644
index 000000000..17c64e3da
--- /dev/null
+++ b/translate/grt/grt-vstrings.adb
@@ -0,0 +1,243 @@
+--  GHDL Run Time (GRT) - variable strings.
+--  Copyright (C) 2002, 2003, 2004, 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.Errors; use Grt.Errors;
+
+package body Grt.Vstrings is
+   procedure Free (Fs : Fat_String_Acc);
+   pragma Import (C, Free);
+
+   function Malloc (Len : Natural) return Fat_String_Acc;
+   pragma Import (C, Malloc);
+
+   function Realloc (Ptr : Fat_String_Acc; Len : Natural)
+                    return Fat_String_Acc;
+   pragma Import (C, Realloc);
+
+
+   procedure Free (Vstr : in out Vstring) is
+   begin
+      Free (Vstr.Str);
+      Vstr := (Str => null,
+               Max => 0,
+               Len => 0);
+   end Free;
+
+   procedure Grow (Vstr : in out Vstring; Sum : Natural)
+   is
+      Nlen : Natural := Vstr.Len + Sum;
+      Nmax : Natural;
+   begin
+      Vstr.Len := Nlen;
+      if Nlen <= Vstr.Max then
+         return;
+      end if;
+      if Vstr.Max = 0 then
+         Nmax := 32;
+      else
+         Nmax := Vstr.Max;
+      end if;
+      while Nmax < Nlen loop
+         Nmax := Nmax * 2;
+      end loop;
+      Vstr.Str := Realloc (Vstr.Str, Nmax);
+      if Vstr.Str = null then
+         Internal_Error ("grt.vstrings.grow: memory exhausted");
+      end if;
+      Vstr.Max := Nmax;
+   end Grow;
+
+   procedure Append (Vstr : in out Vstring; C : Character)
+   is
+   begin
+      Grow (Vstr, 1);
+      Vstr.Str (Vstr.Len) := C;
+   end Append;
+
+   procedure Append (Vstr : in out Vstring; Str : String)
+   is
+      S : Natural := Vstr.Len;
+   begin
+      Grow (Vstr, Str'Length);
+      Vstr.Str (S + 1 .. S + Str'Length) := Str;
+   end Append;
+
+   procedure Append (Vstr : in out Vstring; Str : Ghdl_C_String)
+   is
+      S : Natural := Vstr.Len;
+      L : Natural := strlen (Str);
+   begin
+      Grow (Vstr, L);
+      Vstr.Str (S + 1 .. S + L) := Str (1 .. L);
+   end Append;
+
+   function Length (Vstr : Vstring) return Natural is
+   begin
+      return Vstr.Len;
+   end Length;
+
+   procedure Truncate (Vstr : in out Vstring; Len : Natural) is
+   begin
+      if Len > Vstr.Len then
+         Internal_Error ("grt.vstrings.truncate: bad len");
+      end if;
+      Vstr.Len := Len;
+   end Truncate;
+
+   procedure Put (Stream : FILEs; Vstr : Vstring)
+   is
+      S : size_t;
+   begin
+      S := size_t (Vstr.Len);
+      if S > 0 then
+         S := fwrite (Vstr.Str (1)'Address, S, 1, Stream);
+      end if;
+   end Put;
+
+   procedure Free (Rstr : in out Rstring) is
+   begin
+      Free (Rstr.Str);
+      Rstr := (Str => null,
+               Max => 0,
+               First => 0);
+   end Free;
+
+   function Length (Rstr : Rstring) return Natural is
+   begin
+      return Rstr.Max + 1 - Rstr.First;
+   end Length;
+
+   procedure Grow (Rstr : in out Rstring; Min : Natural)
+   is
+      Len : Natural := Length (Rstr);
+      Nlen : Natural := Len + Min;
+      Nstr : Fat_String_Acc;
+      Nfirst : Natural;
+      Nmax : Natural;
+   begin
+      if Nlen <= Rstr.Max then
+         return;
+      end if;
+      if Rstr.Max = 0 then
+         Nmax := 32;
+      else
+         Nmax := Rstr.Max;
+      end if;
+      while Nmax < Nlen loop
+         Nmax := Nmax * 2;
+      end loop;
+      Nstr := Malloc (Nmax);
+      Nfirst := Nmax + 1 - Len;
+      if Rstr.Str /= null then
+         Nstr (Nfirst .. Nmax) := Rstr.Str (Rstr.First .. Rstr.Max);
+         Free (Rstr.Str);
+      end if;
+      Rstr := (Str => Nstr,
+               Max => Nmax,
+               First => Nfirst);
+   end Grow;
+
+   procedure Prepend (Rstr : in out Rstring; C : Character)
+   is
+   begin
+      Grow (Rstr, 1);
+      Rstr.First := Rstr.First - 1;
+      Rstr.Str (Rstr.First) := C;
+   end Prepend;
+
+   procedure Prepend (Rstr : in out Rstring; Str : String)
+   is
+   begin
+      Grow (Rstr, Str'Length);
+      Rstr.First := Rstr.First - Str'Length;
+      Rstr.Str (Rstr.First .. Rstr.First + Str'Length - 1) := Str;
+   end Prepend;
+
+   procedure Prepend (Rstr : in out Rstring; Str : Ghdl_C_String)
+   is
+      L : Natural := strlen (Str);
+   begin
+      Grow (Rstr, L);
+      Rstr.First := Rstr.First - L;
+      Rstr.Str (Rstr.First .. Rstr.First + L - 1) := Str (1 .. L);
+   end Prepend;
+
+   function Get_Address (Rstr : Rstring) return Address
+   is
+   begin
+      return Rstr.Str (Rstr.First)'Address;
+   end Get_Address;
+
+   procedure Copy (Rstr : Rstring; Str : in out String; Len : out Natural)
+   is
+   begin
+      Len := Length (Rstr);
+      if Len > Str'Length then
+         Str := Rstr.Str (Rstr.First .. Rstr.First + Str'Length - 1);
+      else
+         Str (Str'First .. Str'First + Len - 1) :=
+           Rstr.Str (Rstr.First .. Rstr.First + Len - 1);
+      end if;
+   end Copy;
+
+   procedure Put (Stream : FILEs; Rstr : Rstring)
+   is
+      S : size_t;
+   begin
+      S := fwrite (Get_Address (Rstr), size_t (Length (Rstr)), 1, Stream);
+   end Put;
+
+   generic
+      type Ntype is range <>;
+      --Max_Len : Natural;
+   procedure Gen_To_String (Str : out String; First : out Natural; N : Ntype);
+
+   procedure Gen_To_String (Str : out String; First : out Natural; N : Ntype)
+   is
+      subtype R_Type is String (1 .. Str'Length);
+      S : R_Type renames Str;
+      P : Natural := S'Last;
+      V : Ntype;
+   begin
+      if N > 0 then
+         V := -N;
+      else
+         V := N;
+      end if;
+      loop
+         S (P) := Character'Val (48 - (V rem 10));
+         V := V / 10;
+         exit when V = 0;
+         P := P - 1;
+      end loop;
+      if N < 0 then
+         P := P - 1;
+         S (P) := '-';
+      end if;
+      First := P;
+   end Gen_To_String;
+
+   procedure To_String_I32 is new Gen_To_String (Ntype => Ghdl_I32);
+
+   procedure To_String (Str : out String; First : out Natural; N : Ghdl_I32)
+     renames To_String_I32;
+
+   procedure To_String_I64 is new Gen_To_String (Ntype => Ghdl_I64);
+
+   procedure To_String (Str : out String; First : out Natural; N : Ghdl_I64)
+     renames To_String_I64;
+end Grt.Vstrings;
diff --git a/translate/grt/grt-vstrings.ads b/translate/grt/grt-vstrings.ads
new file mode 100644
index 000000000..f4287588d
--- /dev/null
+++ b/translate/grt/grt-vstrings.ads
@@ -0,0 +1,100 @@
+--  GHDL Run Time (GRT) - variable strings.
+--  Copyright (C) 2002, 2003, 2004, 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.Stdio; use Grt.Stdio;
+with Grt.Types; use Grt.Types;
+with System; use System;
+
+package Grt.Vstrings is
+   --  A Vstring (Variable string) is an object which contains an unbounded
+   --  string.
+   type Vstring is limited private;
+
+   --  Deallocate all storage internally allocated.
+   procedure Free (Vstr : in out Vstring);
+
+   --  Append a character.
+   procedure Append (Vstr : in out Vstring; C : Character);
+
+   --  Append a string.
+   procedure Append (Vstr : in out Vstring; Str : String);
+
+   --  Append a C string.
+   procedure Append (Vstr : in out Vstring; Str : Ghdl_C_String);
+
+   --  Get length of VSTR.
+   function Length (Vstr : Vstring) return Natural;
+
+   --  Truncate VSTR to LEN.
+   --  It is an error if LEN is greater than the current length.
+   procedure Truncate (Vstr : in out Vstring; Len : Natural);
+
+   --  Display VSTR.
+   procedure Put (Stream : FILEs; Vstr : Vstring);
+
+
+   --  A Rstring is link a Vstring but characters can only be prepended.
+   type Rstring is limited private;
+
+   --  Deallocate storage associated with Rstr.
+   procedure Free (Rstr : in out Rstring);
+
+   --  Prepend characters or strings.
+   procedure Prepend (Rstr : in out Rstring; C : Character);
+   procedure Prepend (Rstr : in out Rstring; Str : String);
+   procedure Prepend (Rstr : in out Rstring; Str : Ghdl_C_String);
+
+   --  Get the length of RSTR.
+   function Length (Rstr : Rstring) return Natural;
+
+   --  Return the address of the first character of RSTR.
+   function Get_Address (Rstr : Rstring) return Address;
+
+   --  Display RSTR.
+   procedure Put (Stream : FILEs; Rstr : Rstring);
+
+   --  Copy RSTR to STR, and return length of the string to LEN.
+   procedure Copy (Rstr : Rstring; Str : in out String; Len : out Natural);
+
+   --  FIRST is the index of the first character.
+   --  Requires at least 11 characters.
+   procedure To_String (Str : out String; First : out Natural; N : Ghdl_I32);
+
+   --  Requires at least 21 characters.
+   procedure To_String (Str : out String; First : out Natural; N : Ghdl_I64);
+
+private
+   subtype Fat_String is String (Positive);
+   type Fat_String_Acc is access Fat_String;
+
+   type Vstring is record
+      Str : Fat_String_Acc := null;
+      Max : Natural := 0;
+      Len : Natural := 0;
+   end record;
+
+   type Rstring is record
+      --  String whose bounds is (1 .. Max).
+      Str : Fat_String_Acc := null;
+
+      --  Last index in STR.
+      Max : Natural := 0;
+
+      --  Index of the first character.
+      First : Natural := 1;
+   end record;
+end Grt.Vstrings;
diff --git a/translate/grt/grt-waves.adb b/translate/grt/grt-waves.adb
new file mode 100644
index 000000000..93f217e82
--- /dev/null
+++ b/translate/grt/grt-waves.adb
@@ -0,0 +1,1486 @@
+--  GHDL Run Time (GRT) - wave dumper (GHW) module.
+--  Copyright (C) 2002, 2003, 2004, 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 Ada.Unchecked_Conversion;
+with Ada.Unchecked_Deallocation;
+with Interfaces; use Interfaces;
+with Grt.Types; use Grt.Types;
+with Grt.Avhpi; use Grt.Avhpi;
+with Grt.Stdio; use Grt.Stdio;
+with Grt.Errors; use Grt.Errors;
+with Grt.Types; use Grt.Types;
+with Grt.Astdio; use Grt.Astdio;
+with Grt.Hooks; use Grt.Hooks;
+with Grt.Avhpi; use Grt.Avhpi;
+with GNAT.Table;
+with Grt.Avls; use Grt.Avls;
+with Grt.Rtis; use Grt.Rtis;
+with Grt.Rtis_Addr; use Grt.Rtis_Addr;
+with Grt.Rtis_Utils;
+with Grt.Rtis_Types;
+with Grt.Signals; use Grt.Signals;
+with System; use System;
+with Grt.Vstrings; use Grt.Vstrings;
+
+pragma Elaborate_All (Grt.Rtis_Utils);
+
+package body Grt.Waves is
+   --  Waves filename.
+   Wave_Filename : String_Access := null;
+   --  Stream corresponding to the VCD filename.
+   Wave_Stream : FILEs;
+
+   Ghw_Hie_Design       : constant Unsigned_8 := 1;
+   Ghw_Hie_Block        : constant Unsigned_8 := 3;
+   Ghw_Hie_Generate_If  : constant Unsigned_8 := 4;
+   Ghw_Hie_Generate_For : constant Unsigned_8 := 5;
+   Ghw_Hie_Instance     : constant Unsigned_8 := 6;
+   Ghw_Hie_Process      : constant Unsigned_8 := 13;
+   Ghw_Hie_Generic      : constant Unsigned_8 := 14;
+   Ghw_Hie_Eos          : constant Unsigned_8 := 15; --  End of scope.
+   Ghw_Hie_Signal       : constant Unsigned_8 := 16; --  Signal.
+   Ghw_Hie_Port_In      : constant Unsigned_8 := 17; --  Port
+   Ghw_Hie_Port_Out     : constant Unsigned_8 := 18; --  Port
+   Ghw_Hie_Port_Inout   : constant Unsigned_8 := 19; --  Port
+   Ghw_Hie_Port_Buffer  : constant Unsigned_8 := 20; --  Port
+   Ghw_Hie_Port_Linkage : constant Unsigned_8 := 21; --  Port
+
+   --  Return TRUE if OPT is an option for VCD.
+   function Wave_Option (Opt : String) return Boolean
+   is
+      F : Natural := Opt'First;
+   begin
+      if Opt'Length < 6 or else Opt (F .. F + 5) /= "--wave" then
+         return False;
+      end if;
+      if Opt'Length > 6 and then Opt (F + 6) = '=' then
+         --  Add an extra NUL character.
+         Wave_Filename := new String (1 .. Opt'Length - 7 + 1);
+         Wave_Filename (1 .. Opt'Length - 7) := Opt (F + 7 .. Opt'Last);
+         Wave_Filename (Wave_Filename'Last) := NUL;
+         return True;
+      else
+         return False;
+      end if;
+   end Wave_Option;
+
+   procedure Wave_Help is
+   begin
+      Put_Line (" --wave=FILENAME    dump signal values into a wave file");
+   end Wave_Help;
+
+   procedure Wave_Put (Str : String)
+   is
+      R : size_t;
+   begin
+      R := fwrite (Str'Address, Str'Length, 1, Wave_Stream);
+   end Wave_Put;
+
+   procedure Wave_Putc (C : Character)
+   is
+      R : int;
+   begin
+      R := fputc (Character'Pos (C), Wave_Stream);
+   end Wave_Putc;
+
+   procedure Wave_Newline is
+   begin
+      Wave_Putc (Nl);
+   end Wave_Newline;
+
+   procedure Wave_Put_Byte (B : Unsigned_8)
+   is
+      V : Unsigned_8 := B;
+      R : size_t;
+   begin
+      R := fwrite (V'Address, 1, 1, Wave_Stream);
+   end Wave_Put_Byte;
+
+   procedure Wave_Put_ULEB128 (Val : Ghdl_E32)
+   is
+      V : Ghdl_E32;
+      R : Ghdl_E32;
+   begin
+      V := Val;
+      loop
+         R := V mod 128;
+         V := V / 128;
+         if V = 0 then
+            Wave_Put_Byte (Unsigned_8 (R));
+            exit;
+         else
+            Wave_Put_Byte (Unsigned_8 (128 + R));
+         end if;
+      end loop;
+   end Wave_Put_ULEB128;
+
+   procedure Wave_Put_SLEB128 (Val : Ghdl_I32)
+   is
+      function To_Ghdl_U32 is new Ada.Unchecked_Conversion
+        (Ghdl_I32, Ghdl_U32);
+      V : Ghdl_U32 := To_Ghdl_U32 (Val);
+
+--        function Shift_Right_Arithmetic (Value : Ghdl_U32; Amount : Natural)
+--                                        return Ghdl_U32;
+--        pragma Import (Intrinsic, Shift_Right_Arithmetic);
+      R : Unsigned_8;
+   begin
+      loop
+         R := Unsigned_8 (V mod 128);
+         V := Shift_Right_Arithmetic (V, 7);
+         if (V = 0 and (R and 16#40#) = 0) or (V = -1 and (R and 16#40#) /= 0)
+         then
+            Wave_Put_Byte (R);
+            exit;
+         else
+            Wave_Put_Byte (R or 16#80#);
+         end if;
+      end loop;
+   end Wave_Put_SLEB128;
+
+   procedure Wave_Put_LSLEB128 (Val : Ghdl_I64)
+   is
+      function To_Ghdl_U64 is new Ada.Unchecked_Conversion
+        (Ghdl_I64, Ghdl_U64);
+      V : Ghdl_U64 := To_Ghdl_U64 (Val);
+
+      R : Unsigned_8;
+   begin
+      loop
+         R := Unsigned_8 (V mod 128);
+         V := Shift_Right_Arithmetic (V, 7);
+         if (V = 0 and (R and 16#40#) = 0) or (V = -1 and (R and 16#40#) /= 0)
+         then
+            Wave_Put_Byte (R);
+            exit;
+         else
+            Wave_Put_Byte (R or 16#80#);
+         end if;
+      end loop;
+   end Wave_Put_LSLEB128;
+
+   procedure Wave_Put_I32 (Val : Ghdl_I32)
+   is
+      V : Ghdl_I32 := Val;
+      R : size_t;
+   begin
+      R := fwrite (V'Address, 4, 1, Wave_Stream);
+   end Wave_Put_I32;
+
+   procedure Wave_Put_I64 (Val : Ghdl_I64)
+   is
+      V : Ghdl_I64 := Val;
+      R : size_t;
+   begin
+      R := fwrite (V'Address, 8, 1, Wave_Stream);
+   end Wave_Put_I64;
+
+   procedure Wave_Put_F64 (F64 : Ghdl_F64)
+   is
+      V : Ghdl_F64 := F64;
+      R : size_t;
+   begin
+      R := fwrite (V'Address, Ghdl_F64'Size / Storage_Unit, 1, Wave_Stream);
+   end Wave_Put_F64;
+
+   procedure Wave_Puts (Str : Ghdl_C_String) is
+   begin
+      Put (Wave_Stream, Str);
+   end Wave_Puts;
+
+   procedure Write_Value (Value : Value_Union; Mode : Mode_Type) is
+   begin
+      case Mode is
+         when Mode_B2 =>
+            Wave_Put_Byte (Ghdl_B2'Pos (Value.B2));
+         when Mode_E8 =>
+            Wave_Put_Byte (Ghdl_E8'Pos (Value.E8));
+         when Mode_E32 =>
+            Wave_Put_ULEB128 (Value.E32);
+         when Mode_I32 =>
+            Wave_Put_SLEB128 (Value.I32);
+         when Mode_I64 =>
+            Wave_Put_LSLEB128 (Value.I64);
+         when Mode_F64 =>
+            Wave_Put_F64 (Value.F64);
+      end case;
+   end Write_Value;
+
+   subtype Section_Name is String (1 .. 4);
+   type Header_Type is record
+      Name : Section_Name;
+      Pos : long;
+   end record;
+
+   package Section_Table is new GNAT.Table
+     (Table_Component_Type => Header_Type,
+      Table_Index_Type => Natural,
+      Table_Low_Bound => 1,
+      Table_Initial => 16,
+      Table_Increment => 100);
+
+   --  Create a new section.
+   --  Write the header in the file.
+   --  Save the location for the directory.
+   procedure Wave_Section (Name : Section_Name) is
+   begin
+      Section_Table.Append (Header_Type'(Name => Name,
+                                         Pos => ftell (Wave_Stream)));
+      Wave_Put (Name);
+   end Wave_Section;
+
+   procedure Wave_Write_Size_Order is
+   begin
+      --  Byte order, 1 byte.
+      --  0: bad, 1 : little-endian, 2 : big endian.
+      declare
+         type Byte_Arr is array (0 .. 3) of Unsigned_8;
+         function To_Byte_Arr is new Ada.Unchecked_Conversion
+           (Source => Unsigned_32, Target => Byte_Arr);
+         B4 : constant Byte_Arr := To_Byte_Arr (16#11_22_33_44#);
+         V : Unsigned_8;
+      begin
+         if B4 (0) = 16#11# then
+            --  Big endian.
+            V := 2;
+         elsif B4 (0) = 16#44# then
+            --  Little endian.
+            V := 1;
+         else
+            --  Unknown endian.
+            V := 0;
+         end if;
+         Wave_Put_Byte (V);
+      end;
+      --  Word size, 1 byte.
+      if Integer'Size = 32 then
+         Wave_Put_Byte (4);
+      elsif Integer'Size = 64 then
+         Wave_Put_Byte (8);
+      else
+         Wave_Put_Byte (0);
+      end if;
+      --  File offset size, 1 byte
+      Wave_Put_Byte (1);
+      --  Unused, must be zero (MBZ).
+      Wave_Put_Byte (0);
+   end Wave_Write_Size_Order;
+
+   procedure Wave_Write_Directory
+   is
+      Pos : long;
+   begin
+      Pos := ftell (Wave_Stream);
+      Wave_Section ("DIR" & NUL);
+      Wave_Write_Size_Order;
+      Wave_Put_I32 (Ghdl_I32 (Section_Table.Last));
+      for I in Section_Table.First .. Section_Table.Last loop
+         Wave_Put (Section_Table.Table (I).Name);
+         Wave_Put_I32 (Ghdl_I32 (Section_Table.Table (I).Pos));
+      end loop;
+      Wave_Put ("EOD" & NUL);
+
+      Wave_Section ("TAI" & NUL);
+      Wave_Write_Size_Order;
+      Wave_Put_I32 (Ghdl_I32 (Pos));
+   end Wave_Write_Directory;
+
+   --  Called before elaboration.
+   procedure Wave_Init
+   is
+      Mode : constant String := "wt" & NUL;
+   begin
+      if Wave_Filename = null then
+         Wave_Stream := NULL_Stream;
+         return;
+      end if;
+      if Wave_Filename.all = "-" & NUL then
+         Wave_Stream := stdout;
+      else
+         Wave_Stream := fopen (Wave_Filename.all'Address, Mode'Address);
+         if Wave_Stream = NULL_Stream then
+            Error_C ("cannot open ");
+            Error_E (Wave_Filename (Wave_Filename'First
+                                   .. Wave_Filename'Last - 1));
+            return;
+         end if;
+      end if;
+   end Wave_Init;
+
+   procedure Write_File_Header
+   is
+   begin
+      --  Magic, 9 bytes.
+      Wave_Put ("GHDLwave" & Nl);
+      --  Header length.
+      Wave_Put_Byte (16);
+      --  Version-major, 1 byte.
+      Wave_Put_Byte (0);
+      --  Version-minor, 1 byte.
+      Wave_Put_Byte (1);
+
+      Wave_Write_Size_Order;
+   end Write_File_Header;
+
+   procedure Avhpi_Error (Err : AvhpiErrorT)
+   is
+      pragma Unreferenced (Err);
+   begin
+      Put_Line ("Wave.Avhpi_Error!");
+      null;
+   end Avhpi_Error;
+
+   package Str_Table is new GNAT.Table
+     (Table_Component_Type => Ghdl_C_String,
+      Table_Index_Type => AVL_Value,
+      Table_Low_Bound => 1,
+      Table_Initial => 16,
+      Table_Increment => 100);
+
+   package Str_AVL is new GNAT.Table
+     (Table_Component_Type => AVL_Node,
+      Table_Index_Type => AVL_Nid,
+      Table_Low_Bound => AVL_Root,
+      Table_Initial => 16,
+      Table_Increment => 100);
+
+   Strings_Len : Natural := 0;
+
+   function Str_Compare (L, R : AVL_Value) return Integer
+   is
+      Ls, Rs : Ghdl_C_String;
+   begin
+      Ls := Str_Table.Table (L);
+      Rs := Str_Table.Table (R);
+      if L = R then
+         return 0;
+      end if;
+      return Strcmp (Ls, Rs);
+   end Str_Compare;
+
+   procedure Disp_Str_Avl (N : AVL_Nid) is
+   begin
+      Put (stdout, "node: ");
+      Put_I32 (stdout, Ghdl_I32 (N));
+      New_Line (stdout);
+      Put (stdout, " left: ");
+      Put_I32 (stdout, Ghdl_I32 (Str_AVL.Table (N).Left));
+      New_Line (stdout);
+      Put (stdout, " right: ");
+      Put_I32 (stdout, Ghdl_I32 (Str_AVL.Table (N).Right));
+      New_Line (stdout);
+      Put (stdout, " height: ");
+      Put_I32 (stdout, Ghdl_I32 (Str_AVL.Table (N).Height));
+      New_Line (stdout);
+      Put (stdout, " str: ");
+      --Put (stdout, Str_AVL.Table (N).Val);
+      New_Line (stdout);
+   end Disp_Str_Avl;
+
+   function Create_Str_Index (Str : Ghdl_C_String) return AVL_Value
+   is
+      Res : AVL_Nid;
+   begin
+      Str_Table.Append (Str);
+      Str_AVL.Append (AVL_Node'(Val => Str_Table.Last,
+                                Left | Right => AVL_Nil,
+                                Height => 1));
+      Get_Node (AVL_Tree (Str_AVL.Table (Str_AVL.First .. Str_AVL.Last)),
+                Str_Compare'Access,
+                Str_AVL.Last, Res);
+      if Res /= Str_AVL.Last then
+         Str_AVL.Decrement_Last;
+         Str_Table.Decrement_Last;
+      else
+         Strings_Len := Strings_Len + strlen (Str);
+      end if;
+      return Str_AVL.Table (Res).Val;
+   end Create_Str_Index;
+
+   procedure Create_String_Id (Str : Ghdl_C_String)
+   is
+      Res : AVL_Nid;
+   begin
+      if Str = null then
+         return;
+      end if;
+      Str_Table.Append (Str);
+      Str_AVL.Append (AVL_Node'(Val => Str_Table.Last,
+                                Left | Right => AVL_Nil,
+                                Height => 1));
+      Get_Node (AVL_Tree (Str_AVL.Table (Str_AVL.First .. Str_AVL.Last)),
+                Str_Compare'Access,
+                Str_AVL.Last, Res);
+      if Res /= Str_AVL.Last then
+         Str_AVL.Decrement_Last;
+         Str_Table.Decrement_Last;
+      else
+         Strings_Len := Strings_Len + strlen (Str);
+      end if;
+   end Create_String_Id;
+
+   function Get_String (Str : Ghdl_C_String) return AVL_Value
+   is
+      H, L, M : AVL_Value;
+      Diff : Integer;
+   begin
+      L := Str_Table.First;
+      H := Str_Table.Last;
+      loop
+         M := (L + H) / 2;
+         Diff := Strcmp (Str, Str_Table.Table (M));
+         if Diff = 0 then
+            return M;
+         elsif Diff < 0 then
+            H := M - 1;
+         else
+            L := M + 1;
+         end if;
+         exit when L > H;
+      end loop;
+      return 0;
+   end Get_String;
+
+   procedure Write_String_Id (Str : Ghdl_C_String) is
+   begin
+      if Str = null then
+         Wave_Put_Byte (0);
+      else
+         Wave_Put_ULEB128 (Ghdl_E32 (Get_String (Str)));
+      end if;
+   end Write_String_Id;
+
+   type Type_Node is record
+      Type_Rti : Ghdl_Rti_Access;
+      Context : Rti_Context;
+   end record;
+
+   package Types_Table is new GNAT.Table
+     (Table_Component_Type => Type_Node,
+      Table_Index_Type => AVL_Value,
+      Table_Low_Bound => 1,
+      Table_Initial => 16,
+      Table_Increment => 100);
+
+   package Types_AVL is new GNAT.Table
+     (Table_Component_Type => AVL_Node,
+      Table_Index_Type => AVL_Nid,
+      Table_Low_Bound => AVL_Root,
+      Table_Initial => 16,
+      Table_Increment => 100);
+
+   function Type_Compare (L, R : AVL_Value) return Integer
+   is
+      use System;
+      function To_Ia is new
+        Ada.Unchecked_Conversion (Ghdl_Rti_Access, Integer_Address);
+
+      function "<" (L, R : Ghdl_Rti_Access) return Boolean is
+      begin
+         return To_Ia (L) < To_Ia (R);
+      end "<";
+
+      Ls : Type_Node renames Types_Table.Table (L);
+      Rs : Type_Node renames Types_Table.Table (R);
+   begin
+      if Ls.Type_Rti /= Rs.Type_Rti then
+         if Ls.Type_Rti < Rs.Type_Rti then
+            return -1;
+         else
+            return 1;
+         end if;
+      end if;
+      if Ls.Context.Block /= Rs.Context.Block then
+         if Ls.Context.Block < Rs.Context.Block then
+            return -1;
+         else
+            return +1;
+         end if;
+      end if;
+      if Ls.Context.Base /= Rs.Context.Base then
+         if Ls.Context.Base < Rs.Context.Base then
+            return -1;
+         else
+            return +1;
+         end if;
+      end if;
+      return 0;
+   end Type_Compare;
+
+   --  Try to find typr (RTI, CTXT) in the types_AVL table.
+   --  The first step is to canonicalize CTXT, so that it is the CTXT of
+   --   the type (and not a sub-scope of it).
+   procedure Find_Type (Rti : Ghdl_Rti_Access;
+                        Ctxt : Rti_Context;
+                        N_Ctxt : out Rti_Context;
+                        Id : out AVL_Nid)
+   is
+      Depth : Ghdl_Rti_Depth;
+   begin
+      case Rti.Kind is
+         when Ghdl_Rtik_Type_B2
+           | Ghdl_Rtik_Type_E8 =>
+            N_Ctxt := Null_Context;
+         when others =>
+            --  Compute the canonical context.
+            if Rti.Max_Depth < Rti.Depth then
+               Internal_Error ("grt.waves.find_type");
+            end if;
+            Depth := Rti.Max_Depth;
+            if Depth = 0 or else Ctxt.Block = null then
+               N_Ctxt := Null_Context;
+            else
+               N_Ctxt := Ctxt;
+               while N_Ctxt.Block.Depth > Depth loop
+                  N_Ctxt := Get_Parent_Context (N_Ctxt);
+               end loop;
+            end if;
+      end case;
+
+      --  If the type is already known, return now.
+      --  Otherwise, ID is set to AVL_Nil.
+      Types_Table.Append (Type_Node'(Type_Rti => Rti, Context => N_Ctxt));
+      Id := Find_Node
+        (AVL_Tree (Types_AVL.Table (Types_AVL.First .. Types_AVL.Last)),
+         Type_Compare'Access,
+         Types_Table.Last);
+      Types_Table.Decrement_Last;
+   end Find_Type;
+
+   procedure Write_Type_Id (Tid : AVL_Nid) is
+   begin
+      Wave_Put_ULEB128 (Ghdl_E32 (Types_AVL.Table (Tid).Val));
+   end Write_Type_Id;
+
+   procedure Write_Type_Id (Rti : Ghdl_Rti_Access; Ctxt : Rti_Context)
+   is
+      N_Ctxt : Rti_Context;
+      Res : AVL_Nid;
+   begin
+      Find_Type (Rti, Ctxt, N_Ctxt, Res);
+      if Res = AVL_Nil then
+         -- raise Program_Error;
+         Internal_Error ("write_type_id");
+      end if;
+      Write_Type_Id (Res);
+   end Write_Type_Id;
+
+   procedure Create_Type (Rti : Ghdl_Rti_Access; Ctxt : Rti_Context)
+   is
+      N_Ctxt : Rti_Context;
+      Res : AVL_Nid;
+   begin
+      Find_Type (Rti, Ctxt, N_Ctxt, Res);
+      if Res /= AVL_Nil then
+         return;
+      end if;
+
+      --  First, create all the types it depends on.
+      case Rti.Kind is
+         when Ghdl_Rtik_Type_B2
+           | Ghdl_Rtik_Type_E8 =>
+            declare
+               Enum : Ghdl_Rtin_Type_Enum_Acc;
+            begin
+               Enum := To_Ghdl_Rtin_Type_Enum_Acc (Rti);
+               Create_String_Id (Enum.Name);
+               for I in 1 .. Enum.Nbr loop
+                  Create_String_Id (Enum.Names (I - 1));
+               end loop;
+            end;
+         when Ghdl_Rtik_Subtype_Array
+           | Ghdl_Rtik_Subtype_Array_Ptr =>
+            declare
+               Arr : Ghdl_Rtin_Subtype_Array_Acc;
+            begin
+               Arr := To_Ghdl_Rtin_Subtype_Array_Acc (Rti);
+               Create_String_Id (Arr.Name);
+               if Rti.Mode = 1 then
+                  N_Ctxt := Ctxt;
+               end if;
+               Create_Type (To_Ghdl_Rti_Access (Arr.Basetype), N_Ctxt);
+            end;
+         when Ghdl_Rtik_Type_Array =>
+            declare
+               Arr : Ghdl_Rtin_Type_Array_Acc;
+            begin
+               Arr := To_Ghdl_Rtin_Type_Array_Acc (Rti);
+               Create_String_Id (Arr.Name);
+               Create_Type (Arr.Element, N_Ctxt);
+               for I in 1 .. Arr.Nbr_Dim loop
+                  Create_Type (Arr.Indexes (I - 1), N_Ctxt);
+               end loop;
+            end;
+         when Ghdl_Rtik_Subtype_Scalar =>
+            declare
+               Sub : Ghdl_Rtin_Subtype_Scalar_Acc;
+            begin
+               Sub := To_Ghdl_Rtin_Subtype_Scalar_Acc (Rti);
+               Create_String_Id (Sub.Name);
+               Create_Type (Sub.Basetype, N_Ctxt);
+            end;
+         when Ghdl_Rtik_Type_I32
+           | Ghdl_Rtik_Type_I64
+           | Ghdl_Rtik_Type_F64 =>
+            declare
+               Base : Ghdl_Rtin_Type_Scalar_Acc;
+            begin
+               Base := To_Ghdl_Rtin_Type_Scalar_Acc (Rti);
+               Create_String_Id (Base.Name);
+            end;
+         when Ghdl_Rtik_Type_P32
+           | Ghdl_Rtik_Type_P64 =>
+            declare
+               Base : Ghdl_Rtin_Type_Physical_Acc;
+               Unit : Ghdl_Rtin_Unit_Acc;
+            begin
+               Base := To_Ghdl_Rtin_Type_Physical_Acc (Rti);
+               Create_String_Id (Base.Name);
+               for I in 1 .. Base.Nbr loop
+                  Unit := To_Ghdl_Rtin_Unit_Acc (Base.Units (I - 1));
+                  Create_String_Id (Unit.Name);
+               end loop;
+            end;
+         when Ghdl_Rtik_Type_Record =>
+            declare
+               Rec : Ghdl_Rtin_Type_Record_Acc;
+               El : Ghdl_Rtin_Element_Acc;
+            begin
+               Rec := To_Ghdl_Rtin_Type_Record_Acc (Rti);
+               Create_String_Id (Rec.Name);
+               for I in 1 .. Rec.Nbrel loop
+                  El := To_Ghdl_Rtin_Element_Acc (Rec.Elements (I - 1));
+                  Create_String_Id (El.Name);
+                  Create_Type (El.Eltype, N_Ctxt);
+               end loop;
+            end;
+         when others =>
+            Internal_Error ("wave.create_type");
+--              Internal_Error ("wave.create_type: does not handle " &
+--                             Ghdl_Rtik'Image (Rti.Kind));
+      end case;
+
+      --  Then, create the type.
+      Types_Table.Append (Type_Node'(Type_Rti => Rti, Context => N_Ctxt));
+      Types_AVL.Append (AVL_Node'(Val => Types_Table.Last,
+                                  Left | Right => AVL_Nil,
+                                  Height => 1));
+
+      Get_Node
+        (AVL_Tree (Types_AVL.Table (Types_AVL.First .. Types_AVL.Last)),
+         Type_Compare'Access,
+         Types_AVL.Last, Res);
+      if Res /= Types_AVL.Last then
+         --raise Program_Error;
+         Internal_Error ("wave.create_type(2)");
+      end if;
+   end Create_Type;
+
+   procedure Create_Object_Type (Obj : VhpiHandleT)
+   is
+      Obj_Type : VhpiHandleT;
+      Error : AvhpiErrorT;
+   begin
+      --  Extract type of the signal.
+      Vhpi_Handle (VhpiSubtype, Obj, Obj_Type, Error);
+      if Error /= AvhpiErrorOk then
+         Avhpi_Error (Error);
+         return;
+      end if;
+      Create_Type (Avhpi_Get_Rti (Obj_Type), Avhpi_Get_Context (Obj_Type));
+   end Create_Object_Type;
+
+   procedure Write_Object_Type (Obj : VhpiHandleT)
+   is
+      Obj_Type : VhpiHandleT;
+      Error : AvhpiErrorT;
+   begin
+      --  Extract type of the signal.
+      Vhpi_Handle (VhpiSubtype, Obj, Obj_Type, Error);
+      if Error /= AvhpiErrorOk then
+         Avhpi_Error (Error);
+         return;
+      end if;
+      Write_Type_Id (Avhpi_Get_Rti (Obj_Type), Avhpi_Get_Context (Obj_Type));
+   end Write_Object_Type;
+
+   procedure Create_Generate_Type (Gen : VhpiHandleT)
+   is
+      Iterator : VhpiHandleT;
+      Error : AvhpiErrorT;
+   begin
+      --  Extract the iterator.
+      Vhpi_Handle (VhpiIterScheme, Gen, Iterator, Error);
+      if Error /= AvhpiErrorOk then
+         Avhpi_Error (Error);
+         return;
+      end if;
+      Create_Object_Type (Iterator);
+   end Create_Generate_Type;
+
+   procedure Write_Generate_Type_And_Value (Gen : VhpiHandleT)
+   is
+      Iter : VhpiHandleT;
+      Iter_Type : VhpiHandleT;
+      Error : AvhpiErrorT;
+      Addr : Address;
+      Mode : Mode_Type;
+      Rti : Ghdl_Rti_Access;
+   begin
+      --  Extract the iterator.
+      Vhpi_Handle (VhpiIterScheme, Gen, Iter, Error);
+      if Error /= AvhpiErrorOk then
+         Avhpi_Error (Error);
+         return;
+      end if;
+      Write_Object_Type (Iter);
+
+      Vhpi_Handle (VhpiSubtype, Iter, Iter_Type, Error);
+      if Error /= AvhpiErrorOk then
+         Avhpi_Error (Error);
+         return;
+      end if;
+      Rti := Avhpi_Get_Rti (Iter_Type);
+      Addr := Avhpi_Get_Address (Iter);
+
+      case Get_Base_Type (Rti).Kind is
+         when Ghdl_Rtik_Type_B2 =>
+            Mode := Mode_B2;
+         when Ghdl_Rtik_Type_E8 =>
+            Mode := Mode_E8;
+         when Ghdl_Rtik_Type_E32 =>
+            Mode := Mode_E32;
+         when Ghdl_Rtik_Type_I32 =>
+            Mode := Mode_I32;
+         when Ghdl_Rtik_Type_I64 =>
+            Mode := Mode_I64;
+         when Ghdl_Rtik_Type_F64 =>
+            Mode := Mode_F64;
+         when others =>
+            Internal_Error ("bad iterator type");
+      end case;
+      Write_Value (To_Ghdl_Value_Ptr (Addr).all, Mode);
+   end Write_Generate_Type_And_Value;
+
+   type Step_Type is (Step_Name, Step_Hierarchy);
+
+   Nbr_Scopes : Natural := 0;
+   Nbr_Scope_Signals : Natural := 0;
+   Nbr_Dumped_Signals : Natural := 0;
+
+   procedure Write_Signal_Number (Val_Addr : Address;
+                                  Val_Name : Vstring;
+                                  Val_Type : Ghdl_Rti_Access)
+   is
+      pragma Unreferenced (Val_Name);
+      pragma Unreferenced (Val_Type);
+
+      function To_Integer_Address is new Ada.Unchecked_Conversion
+        (Ghdl_Signal_Ptr, Integer_Address);
+      Sig : Ghdl_Signal_Ptr;
+   begin
+      Sig := To_Ghdl_Signal_Ptr (To_Addr_Acc (Val_Addr).all);
+      if not Sig.Flags.Is_Dumped then
+         Sig.Flags.Is_Dumped := True;
+         Nbr_Dumped_Signals := Nbr_Dumped_Signals + 1;
+      end if;
+      Wave_Put_ULEB128 (Ghdl_E32 (To_Integer_Address (Sig.Flink)));
+   end Write_Signal_Number;
+
+   procedure Foreach_Scalar_Signal_Number is new
+     Grt.Rtis_Utils.Foreach_Scalar (Process => Write_Signal_Number);
+
+   procedure Write_Signal_Numbers (Decl : VhpiHandleT)
+   is
+      Ctxt : Rti_Context;
+      Sig : Ghdl_Rtin_Object_Acc;
+   begin
+      Ctxt := Avhpi_Get_Context (Decl);
+      Sig := To_Ghdl_Rtin_Object_Acc (Avhpi_Get_Rti (Decl));
+      Foreach_Scalar_Signal_Number
+        (Ctxt, Sig.Obj_Type,
+         Loc_To_Addr (Sig.Common.Depth, Sig.Loc, Ctxt), True);
+   end Write_Signal_Numbers;
+
+   procedure Write_Hierarchy_El (Decl : VhpiHandleT)
+   is
+      Mode2hie : constant array (VhpiModeP) of Unsigned_8 :=
+        (VhpiErrorMode => Ghw_Hie_Signal,
+         VhpiInMode => Ghw_Hie_Port_In,
+         VhpiOutMode => Ghw_Hie_Port_Out,
+         VhpiInoutMode => Ghw_Hie_Port_Inout,
+         VhpiBufferMode => Ghw_Hie_Port_Buffer,
+         VhpiLinkageMode => Ghw_Hie_Port_Linkage);
+      V : Unsigned_8;
+   begin
+      case Vhpi_Get_Kind (Decl) is
+         when VhpiPortDeclK =>
+            V := Mode2hie (Vhpi_Get_Mode (Decl));
+         when VhpiSigDeclK =>
+            V := Ghw_Hie_Signal;
+         when VhpiForGenerateK =>
+            V := Ghw_Hie_Generate_For;
+         when VhpiIfGenerateK =>
+            V := Ghw_Hie_Generate_If;
+         when VhpiBlockStmtK =>
+            V := Ghw_Hie_Block;
+         when VhpiCompInstStmtK =>
+            V := Ghw_Hie_Instance;
+         when VhpiProcessStmtK =>
+            V := Ghw_Hie_Process;
+         when others =>
+            --raise Program_Error;
+            Internal_Error ("write_hierarchy_el");
+      end case;
+      Wave_Put_Byte (V);
+      Write_String_Id (Avhpi_Get_Base_Name (Decl));
+      case Vhpi_Get_Kind (Decl) is
+         when VhpiPortDeclK
+           | VhpiSigDeclK =>
+            Write_Object_Type (Decl);
+            Write_Signal_Numbers (Decl);
+         when VhpiForGenerateK =>
+            Write_Generate_Type_And_Value (Decl);
+         when others =>
+            null;
+      end case;
+   end Write_Hierarchy_El;
+
+   procedure Wave_Put_Hierarchy (Inst : VhpiHandleT; Step : Step_Type)
+   is
+      Decl_It : VhpiHandleT;
+      Decl : VhpiHandleT;
+      Error : AvhpiErrorT;
+   begin
+      Vhpi_Iterator (VhpiDecls, Inst, Decl_It, Error);
+      if Error /= AvhpiErrorOk then
+         Avhpi_Error (Error);
+         return;
+      end if;
+
+      --  Extract signals.
+      loop
+         Vhpi_Scan (Decl_It, Decl, Error);
+         exit when Error = AvhpiErrorIteratorEnd;
+         if Error /= AvhpiErrorOk then
+            Avhpi_Error (Error);
+            return;
+         end if;
+
+         case Vhpi_Get_Kind (Decl) is
+            when VhpiPortDeclK
+              | VhpiSigDeclK =>
+               case Step is
+                  when Step_Name =>
+                     Create_String_Id (Avhpi_Get_Base_Name (Decl));
+                     Nbr_Scope_Signals := Nbr_Scope_Signals + 1;
+                     Create_Object_Type (Decl);
+                  when Step_Hierarchy =>
+                     Write_Hierarchy_El (Decl);
+               end case;
+               --Wave_Put_Name (Decl);
+               --Wave_Newline;
+            when others =>
+               null;
+         end case;
+      end loop;
+
+      --  Extract sub-scopes.
+      Vhpi_Iterator (VhpiInternalRegions, Inst, Decl_It, Error);
+      if Error /= AvhpiErrorOk then
+         Avhpi_Error (Error);
+         return;
+      end if;
+
+      loop
+         Vhpi_Scan (Decl_It, Decl, Error);
+         exit when Error = AvhpiErrorIteratorEnd;
+         if Error /= AvhpiErrorOk then
+            Avhpi_Error (Error);
+            return;
+         end if;
+
+         Nbr_Scopes := Nbr_Scopes + 1;
+
+         case Vhpi_Get_Kind (Decl) is
+            when VhpiIfGenerateK
+              | VhpiForGenerateK
+              | VhpiBlockStmtK
+              | VhpiCompInstStmtK =>
+               case Step is
+                  when Step_Name =>
+                     Create_String_Id (Avhpi_Get_Base_Name (Decl));
+                     if Vhpi_Get_Kind (Decl) = VhpiForGenerateK then
+                        Create_Generate_Type (Decl);
+                     end if;
+                  when Step_Hierarchy =>
+                     Write_Hierarchy_El (Decl);
+               end case;
+               Wave_Put_Hierarchy (Decl, Step);
+               if Step = Step_Hierarchy then
+                  Wave_Put_Byte (Ghw_Hie_Eos);
+               end if;
+            when VhpiProcessStmtK =>
+               case Step is
+                  when Step_Name =>
+                     Create_String_Id (Avhpi_Get_Base_Name (Decl));
+                  when Step_Hierarchy =>
+                     Write_Hierarchy_El (Decl);
+               end case;
+            when others =>
+               Internal_Error ("wave_put_hierarchy");
+--                 Wave_Put ("unknown ");
+--                 Wave_Put (VhpiClassKindT'Image (Vhpi_Get_Kind (Decl)));
+--                 Wave_Newline;
+         end case;
+      end loop;
+   end Wave_Put_Hierarchy;
+
+   procedure Disp_Str_AVL (Str : AVL_Nid; Indent : Natural)
+   is
+   begin
+      if Str = AVL_Nil then
+         return;
+      end if;
+      Disp_Str_AVL (Str_AVL.Table (Str).Left, Indent + 1);
+      for I in 1 .. Indent loop
+         Wave_Putc (' ');
+      end loop;
+      Wave_Puts (Str_Table.Table (Str_AVL.Table (Str).Val));
+--        Wave_Putc ('(');
+--        Put_I32 (Wave_Stream, Ghdl_I32 (Str));
+--        Wave_Putc (')');
+--        Put_I32 (Wave_Stream, Get_Height (Str));
+      Wave_Newline;
+      Disp_Str_AVL (Str_AVL.Table (Str).Right, Indent + 1);
+   end Disp_Str_AVL;
+
+   procedure Write_Strings
+   is
+   begin
+--        Wave_Put ("AVL height: ");
+--        Put_I32 (Wave_Stream, Ghdl_I32 (Check_AVL (Str_Root)));
+--        Wave_Newline;
+      Wave_Put ("strings length: ");
+      Put_I32 (Wave_Stream, Ghdl_I32 (Strings_Len));
+      Wave_Newline;
+      Disp_Str_AVL (AVL_Root, 0);
+      fflush (Wave_Stream);
+   end Write_Strings;
+
+   procedure Freeze_Strings
+   is
+      type Str_Table1_Type is array (1 .. Str_Table.Last) of Ghdl_C_String;
+      type Str_Table1_Acc is access Str_Table1_Type;
+      Idx : AVL_Value;
+      Table1 : Str_Table1_Acc;
+
+      procedure Free is new Ada.Unchecked_Deallocation
+        (Str_Table1_Type, Str_Table1_Acc);
+
+      procedure Store_Strings (N : AVL_Nid) is
+      begin
+         if N = AVL_Nil then
+            return;
+         end if;
+         Store_Strings (Str_AVL.Table (N).Left);
+         Table1 (Idx) := Str_Table.Table (Str_AVL.Table (N).Val);
+         Idx := Idx + 1;
+         Store_Strings (Str_AVL.Table (N).Right);
+      end Store_Strings;
+   begin
+      Table1 := new Str_Table1_Type;
+      Idx := 1;
+      Store_Strings (AVL_Root);
+      Str_Table.Release;
+      Str_AVL.Free;
+      for I in Table1.all'Range loop
+         Str_Table.Table (I) := Table1 (I);
+      end loop;
+      Free (Table1);
+   end Freeze_Strings;
+
+   procedure Write_Strings_Compress
+   is
+      Last : Ghdl_C_String;
+      V : Ghdl_C_String;
+      L : Natural;
+      L1 : Natural;
+   begin
+      Wave_Section ("STR" & NUL);
+      Wave_Put_Byte (0);
+      Wave_Put_Byte (0);
+      Wave_Put_Byte (0);
+      Wave_Put_Byte (0);
+      Wave_Put_I32 (Ghdl_I32 (Str_Table.Last));
+      Wave_Put_I32 (Ghdl_I32 (Strings_Len));
+      for I in Str_Table.First .. Str_Table.Last loop
+         V := Str_Table.Table (I);
+         if I = Str_Table.First then
+            L := 1;
+         else
+            Last := Str_Table.Table (I - 1);
+
+            for I in Positive loop
+               if V (I) /= Last (I) then
+                  L := I;
+                  exit;
+               end if;
+            end loop;
+            L1 := L - 1;
+            loop
+               if L1 >= 32 then
+                  Wave_Put_Byte (Unsigned_8 (L1 mod 32) + 16#80#);
+               else
+                  Wave_Put_Byte (Unsigned_8 (L1 mod 32));
+               end if;
+               L1 := L1 / 32;
+               exit when L1 = 0;
+            end loop;
+         end if;
+
+         if Boolean'(False) then
+            Put ("string ");
+            Put_I32 (stdout, Ghdl_I32 (I));
+            Put (": ");
+            Put (V);
+            New_Line;
+         end if;
+
+         loop
+            exit when V (L) = NUL;
+            Wave_Putc (V (L));
+            L := L + 1;
+         end loop;
+      end loop;
+      --  Last string length.
+      Wave_Put_Byte (0);
+      --  End marker.
+      Wave_Put ("EOS" & NUL);
+   end Write_Strings_Compress;
+
+   procedure Write_Range (Rti : Ghdl_Rti_Access; Rng : Ghdl_Range_Ptr)
+   is
+      Kind : Ghdl_Rtik;
+   begin
+      Kind := Rti.Kind;
+      if Kind = Ghdl_Rtik_Subtype_Scalar then
+         Kind := To_Ghdl_Rtin_Subtype_Scalar_Acc (Rti).Basetype.Kind;
+      end if;
+      case Kind is
+         when Ghdl_Rtik_Type_E8 =>
+            Wave_Put_Byte (Ghdl_Rtik'Pos (Kind)
+                           + Ghdl_Dir_Type'Pos (Rng.E8.Dir) * 16#80#);
+            Wave_Put_Byte (Unsigned_8 (Rng.E8.Left));
+            Wave_Put_Byte (Unsigned_8 (Rng.E8.Right));
+         when Ghdl_Rtik_Type_I32
+           | Ghdl_Rtik_Type_P32 =>
+            Wave_Put_Byte (Ghdl_Rtik'Pos (Kind)
+                           + Ghdl_Dir_Type'Pos (Rng.I32.Dir) * 16#80#);
+            Wave_Put_SLEB128 (Rng.I32.Left);
+            Wave_Put_SLEB128 (Rng.I32.Right);
+         when Ghdl_Rtik_Type_P64
+           | Ghdl_Rtik_Type_I64 =>
+            Wave_Put_Byte (Ghdl_Rtik'Pos (Kind)
+                           + Ghdl_Dir_Type'Pos (Rng.P64.Dir) * 16#80#);
+            Wave_Put_LSLEB128 (Rng.P64.Left);
+            Wave_Put_LSLEB128 (Rng.P64.Right);
+         when Ghdl_Rtik_Type_F64 =>
+            Wave_Put_Byte (Ghdl_Rtik'Pos (Kind)
+                           + Ghdl_Dir_Type'Pos (Rng.F64.Dir) * 16#80#);
+            Wave_Put_F64 (Rng.F64.Left);
+            Wave_Put_F64 (Rng.F64.Right);
+         when others =>
+            Internal_Error ("waves.write_range: unhandled kind");
+            --Internal_Error ("waves.write_range: unhandled kind "
+            --                & Ghdl_Rtik'Image (Kind));
+      end case;
+   end Write_Range;
+
+   procedure Write_Types
+   is
+      Rti : Ghdl_Rti_Access;
+      Ctxt : Rti_Context;
+   begin
+      Wave_Section ("TYP" & NUL);
+      Wave_Put_Byte (0);
+      Wave_Put_Byte (0);
+      Wave_Put_Byte (0);
+      Wave_Put_Byte (0);
+      Wave_Put_I32 (Ghdl_I32 (Types_Table.Last));
+      for I in Types_Table.First .. Types_Table.Last loop
+         Rti := Types_Table.Table (I).Type_Rti;
+         Ctxt := Types_Table.Table (I).Context;
+         --  Kind.
+         Wave_Put_Byte (Ghdl_Rtik'Pos (Rti.Kind));
+         case Rti.Kind is
+            when Ghdl_Rtik_Type_B2
+              | Ghdl_Rtik_Type_E8 =>
+               declare
+                  Enum : Ghdl_Rtin_Type_Enum_Acc;
+               begin
+                  Enum := To_Ghdl_Rtin_Type_Enum_Acc (Rti);
+                  Write_String_Id (Enum.Name);
+                  Wave_Put_ULEB128 (Ghdl_E32 (Enum.Nbr));
+                  for I in 1 .. Enum.Nbr loop
+                     Write_String_Id (Enum.Names (I - 1));
+                  end loop;
+               end;
+            when Ghdl_Rtik_Subtype_Array
+              | Ghdl_Rtik_Subtype_Array_Ptr =>
+               declare
+                  Arr : Ghdl_Rtin_Subtype_Array_Acc;
+               begin
+                  Arr := To_Ghdl_Rtin_Subtype_Array_Acc (Rti);
+                  Write_String_Id (Arr.Name);
+                  Write_Type_Id (To_Ghdl_Rti_Access (Arr.Basetype), Ctxt);
+                  declare
+                     Rngs : Ghdl_Range_Array (0 .. Arr.Basetype.Nbr_Dim - 1);
+                  begin
+                     Bound_To_Range (Loc_To_Addr (Rti.Depth, Arr.Bounds, Ctxt),
+                                     Arr.Basetype, Rngs);
+                     for I in Rngs'Range loop
+                        Write_Range (Arr.Basetype.Indexes (I), Rngs (I));
+                     end loop;
+                  end;
+               end;
+            when Ghdl_Rtik_Type_Array =>
+               declare
+                  Arr : Ghdl_Rtin_Type_Array_Acc;
+               begin
+                  Arr := To_Ghdl_Rtin_Type_Array_Acc (Rti);
+                  Write_String_Id (Arr.Name);
+                  Write_Type_Id (Arr.Element, Ctxt);
+                  Wave_Put_ULEB128 (Ghdl_E32 (Arr.Nbr_Dim));
+                  for I in 1 .. Arr.Nbr_Dim loop
+                     Write_Type_Id (Arr.Indexes (I - 1), Ctxt);
+                  end loop;
+               end;
+         when Ghdl_Rtik_Type_Record =>
+            declare
+               Rec : Ghdl_Rtin_Type_Record_Acc;
+               El : Ghdl_Rtin_Element_Acc;
+            begin
+               Rec := To_Ghdl_Rtin_Type_Record_Acc (Rti);
+               Write_String_Id (Rec.Name);
+               Wave_Put_ULEB128 (Ghdl_E32 (Rec.Nbrel));
+               for I in 1 .. Rec.Nbrel loop
+                  El := To_Ghdl_Rtin_Element_Acc (Rec.Elements (I - 1));
+                  Write_String_Id (El.Name);
+                  Write_Type_Id (El.Eltype, Ctxt);
+               end loop;
+            end;
+            when Ghdl_Rtik_Subtype_Scalar =>
+               declare
+                  Sub : Ghdl_Rtin_Subtype_Scalar_Acc;
+               begin
+                  Sub := To_Ghdl_Rtin_Subtype_Scalar_Acc (Rti);
+                  Write_String_Id (Sub.Name);
+                  Write_Type_Id (Sub.Basetype, Ctxt);
+                  Write_Range (Sub.Basetype,
+                               To_Ghdl_Range_Ptr (Loc_To_Addr (Rti.Depth,
+                                                               Sub.Range_Loc,
+                                                               Ctxt)));
+               end;
+            when Ghdl_Rtik_Type_I32
+              | Ghdl_Rtik_Type_I64
+              | Ghdl_Rtik_Type_F64 =>
+               declare
+                  Base : Ghdl_Rtin_Type_Scalar_Acc;
+               begin
+                  Base := To_Ghdl_Rtin_Type_Scalar_Acc (Rti);
+                  Write_String_Id (Base.Name);
+               end;
+            when Ghdl_Rtik_Type_P32
+              | Ghdl_Rtik_Type_P64 =>
+               declare
+                  Base : Ghdl_Rtin_Type_Physical_Acc;
+                  Unit : Ghdl_Rtin_Unit_Acc;
+               begin
+                  Base := To_Ghdl_Rtin_Type_Physical_Acc (Rti);
+                  Write_String_Id (Base.Name);
+                  Wave_Put_ULEB128 (Ghdl_U32 (Base.Nbr));
+                  for I in 1 .. Base.Nbr loop
+                     Unit := To_Ghdl_Rtin_Unit_Acc (Base.Units (I - 1));
+                     Write_String_Id (Unit.Name);
+                     case Base.Common.Mode is
+                        when 0 =>
+                           --  Value is locally static.
+                           case Base.Common.Kind is
+                              when Ghdl_Rtik_Type_P32 =>
+                                 Wave_Put_SLEB128 (Unit.Value.Unit_32);
+                              when Ghdl_Rtik_Type_P64 =>
+                                 Wave_Put_LSLEB128 (Unit.Value.Unit_64);
+                              when others =>
+                                 Internal_Error
+                                   ("wave.write_types(P32/P64-0)");
+                           end case;
+                        when 1 =>
+                           case Rti.Kind is
+                              when Ghdl_Rtik_Type_P32 =>
+                                 Wave_Put_SLEB128 (Unit.Value.Unit_Addr.I32);
+                              when Ghdl_Rtik_Type_P64 =>
+                                 Wave_Put_LSLEB128 (Unit.Value.Unit_Addr.I64);
+                              when others =>
+                                 Internal_Error
+                                   ("wave.write_types(P32/P64-1)");
+                           end case;
+                        when others =>
+                           Internal_Error ("wave.write_types(P32/P64)");
+                     end case;
+                  end loop;
+               end;
+            when others =>
+               Internal_Error ("wave.write_types");
+--             Internal_Error ("wave.write_types: does not handle " &
+--                             Ghdl_Rtik'Image (Rti.Kind));
+         end case;
+      end loop;
+      Wave_Put_Byte (0);
+   end Write_Types;
+
+   procedure Write_Known_Types
+   is
+      use Grt.Rtis_Types;
+
+      Boolean_Type_Id : AVL_Nid;
+      Bit_Type_Id : AVL_Nid;
+      Std_Ulogic_Type_Id : AVL_Nid;
+
+      function Search_Type_Id (Rti : Ghdl_Rti_Access) return AVL_Nid
+      is
+         Ctxt : Rti_Context;
+         Tid : AVL_Nid;
+      begin
+         Find_Type (Rti, Null_Context, Ctxt, Tid);
+         return Tid;
+      end Search_Type_Id;
+   begin
+      Search_Types_RTI;
+
+      Boolean_Type_Id := Search_Type_Id (Std_Standard_Boolean_RTI_Ptr);
+
+      Bit_Type_Id := Search_Type_Id (Std_Standard_Bit_RTI_Ptr);
+
+      if Ieee_Std_Logic_1164_Std_Ulogic_RTI_Ptr /= null then
+         Std_Ulogic_Type_Id := Search_Type_Id
+           (Ieee_Std_Logic_1164_Std_Ulogic_RTI_Ptr);
+      else
+         Std_Ulogic_Type_Id := AVL_Nil;
+      end if;
+
+      Wave_Section ("WKT" & NUL);
+      Wave_Put_Byte (0);
+      Wave_Put_Byte (0);
+      Wave_Put_Byte (0);
+      Wave_Put_Byte (0);
+
+      if Boolean_Type_Id /= AVL_Nil then
+         Wave_Put_Byte (1);
+         Write_Type_Id (Boolean_Type_Id);
+      end if;
+
+      if Bit_Type_Id /= AVL_Nil then
+         Wave_Put_Byte (2);
+         Write_Type_Id (Bit_Type_Id);
+      end if;
+
+      if Std_Ulogic_Type_Id /= AVL_Nil then
+         Wave_Put_Byte (3);
+         Write_Type_Id (Std_Ulogic_Type_Id);
+      end if;
+
+      Wave_Put_Byte (0);
+   end Write_Known_Types;
+
+   --  Table of signals to be dumped.
+   package Dump_Table is new GNAT.Table
+     (Table_Component_Type => Ghdl_Signal_Ptr,
+      Table_Index_Type => Natural,
+      Table_Low_Bound => 1,
+      Table_Initial => 32,
+      Table_Increment => 100);
+
+   procedure Write_Hierarchy (Root : VhpiHandleT)
+   is
+      function To_Ghdl_Signal_Ptr is new Ada.Unchecked_Conversion
+        (Source => Integer_Address, Target => Ghdl_Signal_Ptr);
+      N : Natural;
+   begin
+      --  Number signals.
+      for I in Sig_Table.First .. Sig_Table.Last loop
+         if Sig_Table.Table (I).Flink /= null then
+            Internal_Error ("wave.write_hierarchy");
+         end if;
+         Sig_Table.Table (I).Flink :=
+           To_Ghdl_Signal_Ptr (Integer_Address (I - Sig_Table.First + 1));
+      end loop;
+
+      Wave_Section ("HIE" & NUL);
+      Wave_Put_Byte (0);
+      Wave_Put_Byte (0);
+      Wave_Put_Byte (0);
+      Wave_Put_Byte (0);
+      Wave_Put_I32 (Ghdl_I32 (Nbr_Scopes));
+      Wave_Put_I32 (Ghdl_I32 (Nbr_Scope_Signals));
+      Wave_Put_I32 (Ghdl_I32 (Sig_Table.Last - Sig_Table.First + 1));
+      Wave_Put_Hierarchy (Root, Step_Hierarchy);
+      Wave_Put_Byte (0);
+
+      Dump_Table.Set_Last (Nbr_Dumped_Signals);
+
+      --  Save and clear.
+      N := 0;
+      for I in Sig_Table.First .. Sig_Table.Last loop
+         if Sig_Table.Table (I).Flags.Is_Dumped then
+            N := N + 1;
+            Dump_Table.Table (N) := Sig_Table.Table (I);
+         end if;
+         Sig_Table.Table (I).Flink := null;
+      end loop;
+   end Write_Hierarchy;
+
+   procedure Write_Signal_Value (Sig : Ghdl_Signal_Ptr) is
+   begin
+      --  FIXME: for some signals, the significant value is the driving value!
+      Write_Value (Sig.Value, Sig.Mode);
+   end Write_Signal_Value;
+
+   procedure Write_Snapshot is
+   begin
+      Wave_Section ("SNP" & NUL);
+      Wave_Put_Byte (0);
+      Wave_Put_Byte (0);
+      Wave_Put_Byte (0);
+      Wave_Put_Byte (0);
+      Wave_Put_I64 (Ghdl_I64 (Cycle_Time));
+
+      for I in Dump_Table.First .. Dump_Table.Last loop
+         Write_Signal_Value (Dump_Table.Table (I));
+      end loop;
+      Wave_Put ("ESN" & NUL);
+   end Write_Snapshot;
+
+   procedure Wave_Cycle;
+
+   --  Called after elaboration.
+   procedure Wave_Start
+   is
+      Root : VhpiHandleT;
+   begin
+      --  Do nothing if there is no VCD file to generate.
+      if Wave_Stream = NULL_Stream then
+         return;
+      end if;
+
+      Write_File_Header;
+
+      --  FIXME: write infos
+      --  * date
+      --  * timescale
+      --  * design name ?
+      --  ...
+
+      --  Put hierarchy.
+      Get_Root_Inst (Root);
+      -- Vcd_Search_Packages;
+      Wave_Put_Hierarchy (Root, Step_Name);
+
+      Freeze_Strings;
+
+      -- Register_Cycle_Hook (Vcd_Cycle'Access);
+      Write_Strings_Compress;
+      Write_Types;
+      Write_Known_Types;
+      Write_Hierarchy (Root);
+
+      --  End of header mark.
+      Wave_Section ("EOH" & NUL);
+
+      Write_Snapshot;
+
+      Register_Cycle_Hook (Wave_Cycle'Access);
+
+      fflush (Wave_Stream);
+   end Wave_Start;
+
+   Wave_Time : Std_Time := 0;
+   In_Cyc : Boolean := False;
+
+   procedure Wave_Close_Cyc
+   is
+   begin
+      Wave_Put_LSLEB128 (-1);
+      Wave_Put ("ECY" & NUL);
+      In_Cyc := False;
+   end Wave_Close_Cyc;
+
+   procedure Wave_Cycle
+   is
+      Diff : Std_Time;
+      Sig : Ghdl_Signal_Ptr;
+      Last : Natural;
+   begin
+      if not In_Cyc then
+         Wave_Section ("CYC" & NUL);
+         Wave_Put_I64 (Ghdl_I64 (Cycle_Time));
+         In_Cyc := True;
+      else
+         Diff := Cycle_Time - Wave_Time;
+         Wave_Put_LSLEB128 (Ghdl_I64 (Diff));
+      end if;
+      Wave_Time := Cycle_Time;
+
+      --  Dump signals.
+      Last := 0;
+      for I in Dump_Table.First .. Dump_Table.Last loop
+         Sig := Dump_Table.Table (I);
+         if Sig.Flags.Cyc_Event then
+            Wave_Put_ULEB128 (Ghdl_U32 (I - Last));
+            Last := I;
+            Write_Signal_Value (Sig);
+            Sig.Flags.Cyc_Event := False;
+         end if;
+      end loop;
+      Wave_Put_Byte (0);
+   end Wave_Cycle;
+
+   --  Called at the end of the simulation.
+   procedure Wave_End is
+   begin
+      if Wave_Stream = NULL_Stream then
+         return;
+      end if;
+      if In_Cyc then
+         Wave_Close_Cyc;
+      end if;
+      Wave_Write_Directory;
+      fflush (Wave_Stream);
+   end Wave_End;
+
+   Wave_Hooks : aliased constant Hooks_Type :=
+     (Option => Wave_Option'Access,
+      Help => Wave_Help'Access,
+      Init => Wave_Init'Access,
+      Start => Wave_Start'Access,
+      Finish => Wave_End'Access);
+
+   procedure Register is
+   begin
+      Register_Hooks (Wave_Hooks'Access);
+   end Register;
+end Grt.Waves;
diff --git a/translate/grt/grt-waves.ads b/translate/grt/grt-waves.ads
new file mode 100644
index 000000000..cb5fdf962
--- /dev/null
+++ b/translate/grt/grt-waves.ads
@@ -0,0 +1,20 @@
+--  GHDL Run Time (GRT) - wave dumper (GHW) module.
+--  Copyright (C) 2002, 2003, 2004, 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.
+package Grt.Waves is
+   procedure Register;
+end Grt.Waves;
diff --git a/translate/grt/grt.adc b/translate/grt/grt.adc
new file mode 100644
index 000000000..889fcbd9b
--- /dev/null
+++ b/translate/grt/grt.adc
@@ -0,0 +1,36 @@
+--  GHDL Run Time (GRT) - Configuration pragmas.
+--  Copyright (C) 2002, 2003, 2004, 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.
+
+--  The GRT library is built with a lot of restrictions.
+--  The purpose of these restrictions (mainly No_Run_Time) is not to link with
+--  the GNAT run time library.  The user does not need to download or compile
+--  it.
+--
+--  However, GRT works without these restrictions.  If you want to use GRT
+--  in Ada, you may compile GRT without these restrictions (remove the -gnatec
+--  flag).
+--
+--  This files is *not* names gnat.adc, in order to ease the possibility of
+--  not using it.
+pragma Restrictions (No_Exception_Handlers);
+pragma restrictions (No_Exceptions);
+pragma Restrictions (No_Secondary_Stack);
+--pragma Restrictions (No_Elaboration_Code);
+pragma Restrictions (No_Io);
+pragma Restrictions (No_Tasking);
+pragma No_Run_Time;
diff --git a/translate/grt/grt.ads b/translate/grt/grt.ads
new file mode 100644
index 000000000..fbad5174c
--- /dev/null
+++ b/translate/grt/grt.ads
@@ -0,0 +1,20 @@
+--  GHDL Run Time (GRT) - Top of hierarchy.
+--  Copyright (C) 2002, 2003, 2004, 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.
+package Grt is
+   pragma Pure (Grt);
+end Grt;
diff --git a/translate/grt/main.adb b/translate/grt/main.adb
new file mode 100644
index 000000000..1b6499af4
--- /dev/null
+++ b/translate/grt/main.adb
@@ -0,0 +1,25 @@
+--  GHDL Run Time (GRT) - C-like entry point.
+--  Copyright (C) 2002, 2003, 2004, 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 Ghdl_Main;
+
+function Main (Argc : Integer; Argv : System.Address)
+   return Integer
+is
+begin
+   return Ghdl_Main (Argc, Argv);
+end Main;
diff --git a/translate/grt/main.ads b/translate/grt/main.ads
new file mode 100644
index 000000000..d53dbee5a
--- /dev/null
+++ b/translate/grt/main.ads
@@ -0,0 +1,27 @@
+--  GHDL Run Time (GRT) - C-like entry point.
+--  Copyright (C) 2002, 2003, 2004, 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.
+
+--  In the usual case of a standalone executable, this file defines the
+--  standard entry point, ie the main() function.
+--
+--  However, as explained in the manual, the user can use its own main()
+--  function, and calls the ghdl entry point ghdl_main.
+with System;
+
+function Main (Argc : Integer; Argv : System.Address) return Integer;
+pragma Export (C, Main, "main");