22 files changed, 7771 insertions, 0 deletions
diff --git a/src/ghdldrv/Makefile b/src/ghdldrv/Makefile
new file mode 100644
index 000000000..ebf23c2d1
--- /dev/null
+++ b/src/ghdldrv/Makefile
@@ -0,0 +1,193 @@
+#  -*- Makefile -*- for the GHDL drivers.
+#  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.
+GNATFLAGS=-gnaty3befhkmr -gnata -gnatwael -aI../.. -aI.. -aI../../psl -aI../grt -aO.. -g -gnatf -gnat05
+GRT_FLAGS=-g
+LIB_CFLAGS=-g -O2
+GNATMAKE=gnatmake
+CC=gcc
+
+# Optimize, do not forget to use MODE=--genfast for iirs.adb.
+#GNATFLAGS+=-O -gnatn
+#GRT_FLAGS+=-O
+
+# Profiling.
+#GNATFLAGS+=-pg -gnatn -O
+#GRT_FLAGS+=-pg -O
+
+# Coverage
+#GNATFLAGS+=-fprofile-arcs -ftest-coverage
+
+GNAT_BARGS=-bargs -E
+
+LLVM_CONFIG=llvm-config
+
+#GNAT_LARGS= -static
+all: ghdl_mcode
+
+target=i686-pc-linux-gnu
+#target=x86_64-pc-linux-gnu
+#target=i686-apple-darwin
+#target=x86_64-apple-darwin
+#target=i386-pc-mingw32
+GRTSRCDIR=../grt
+include $(GRTSRCDIR)/Makefile.inc
+
+ifeq ($(filter-out i%86 linux,$(arch) $(osys)),)
+  ORTHO_X86_FLAGS=Flags_Linux
+endif
+ifeq ($(filter-out i%86 darwin%,$(arch) $(osys)),)
+  ORTHO_X86_FLAGS=Flags_Macosx
+endif
+ifeq ($(filter-out i%86 mingw32%,$(arch) $(osys)),)
+  ORTHO_X86_FLAGS=Flags_Windows
+endif
+ifdef ORTHO_X86_FLAGS
+  ORTHO_DEPS=ortho_code-x86-flags.ads
+endif
+
+ortho_code-x86-flags.ads:
+	echo "with Ortho_Code.X86.$(ORTHO_X86_FLAGS);" > $@
+	echo "package Ortho_Code.X86.Flags renames Ortho_Code.X86.$(ORTHO_X86_FLAGS);" >> $@
+
+ghdl_mcode: GRT_FLAGS+=-DWITH_GNAT_RUN_TIME
+ghdl_mcode: default_pathes.ads $(GRT_ADD_OBJS) $(ORTHO_DEPS) memsegs_c.o chkstk.o force
+	$(GNATMAKE) -o $@ -aI../../ortho/mcode -aI../../ortho $(GNATFLAGS) ghdl_jit.adb $(GNAT_BARGS) -largs memsegs_c.o chkstk.o $(GNAT_LARGS) $(GRT_ADD_OBJS) $(subst @,$(GRTSRCDIR),$(GRT_EXTRA_LIB))
+
+memsegs_c.o: ../../ortho/mcode/memsegs_c.c
+	$(CC) -c -g -o $@ $<
+
+ghdl_llvm_jit: GRT_FLAGS+=-DWITH_GNAT_RUN_TIME
+ghdl_llvm_jit: default_pathes.ads $(GRT_ADD_OBJS) $(ORTHO_DEPS) llvm-cbindings.o force
+	$(GNATMAKE) -o $@ -aI../../ortho/llvm -aI../../ortho $(GNATFLAGS) ghdl_jit.adb $(GNAT_BARGS) -largs llvm-cbindings.o $(GNAT_LARGS) $(GRT_ADD_OBJS) $(subst @,$(GRTSRCDIR),$(GRT_EXTRA_LIB)) `$(LLVM_CONFIG) --ldflags --libs --system-libs` -lc++
+
+llvm-cbindings.o: ../../ortho/llvm/llvm-cbindings.cpp
+	$(CXX) -c -m64 `$(LLVM_CONFIG) --includedir --cxxflags` -g -o $@ $<
+
+ghdl_simul: default_pathes.ads $(GRT_ADD_OBJS) force
+	$(GNATMAKE) -aI../../simulate $(GNATFLAGS) ghdl_simul $(GNAT_BARGS) -largs $(GNAT_LARGS) $(GRT_ADD_OBJS) $(subst @,$(GRTSRCDIR),$(GRT_EXTRA_LIB))
+
+ghdl_gcc: default_pathes.ads force
+	$(GNATMAKE) $(GNATFLAGS) ghdl_gcc $(GNAT_BARGS) -largs $(GNAT_LARGS)
+
+ghdl_llvm: default_pathes.ads force
+	$(GNATMAKE) $(GNATFLAGS) ghdl_llvm $(GNAT_BARGS) -largs $(GNAT_LARGS)
+
+default_pathes.ads: default_pathes.ads.in Makefile
+	curdir=`cd ..; pwd`; \
+	sed -e "s%@COMPILER_GCC@%$$curdir/ghdl1-gcc%" \
+	 -e "s%@COMPILER_DEBUG@%$$curdir/ghdl1-debug%" \
+	 -e "s%@COMPILER_MCODE@%$$curdir/ghdl1-mcode%" \
+	 -e "s%@COMPILER_LLVM@%$$curdir/ghdl1-llvm%" \
+	 -e "s%@POST_PROCESSOR@%$$curdir/../ortho/oread/oread-gcc%" \
+	 -e "s%@INSTALL_PREFIX@%%" \
+	 -e "s%@LIB_PREFIX@%$$curdir/lib/%" < $< > $@
+
+bootstrap.old: force
+	$(RM) ../../libraries/std-obj87.cf
+	$(MAKE) -C ../../libraries EXT=obj \
+	  ANALYSE="$(PWD)/ghdl -a -g" std-obj87.cf
+	$(RM) ../../libraries/std-obj93.cf
+	$(MAKE) -C ../../libraries EXT=obj \
+	  ANALYSE="$(PWD)/ghdl -a -g" std-obj93.cf
+
+LIB87_DIR:=../lib/v87
+LIB93_DIR:=../lib/v93
+LIB08_DIR:=../lib/v08
+
+LIBSRC_DIR:=../../libraries
+REL_DIR:=../..
+GHDL=ghdl
+ANALYZE:=../../../ghdldrv/$(GHDL) -a $(LIB_CFLAGS)
+LN=ln -s
+CP=cp
+
+$(LIB87_DIR) $(LIB93_DIR) $(LIB08_DIR):
+	[ -d ../lib ] || mkdir ../lib
+	[ -d $@ ] || mkdir $@
+
+include ../../libraries/Makefile.inc
+
+GHDL1=../ghdl1-gcc
+$(LIB93_DIR)/std/std_standard.o: $(GHDL1)
+ifeq ($(GHDL),ghdl_llvm)
+	$(GHDL1) --std=93 -quiet $(LIB_CFLAGS)  -c -o $@ --compile-standard
+else
+	$(GHDL1) --std=93 -quiet $(LIB_CFLAGS)  -o std_standard.s \
+	 --compile-standard
+	$(CC) -c -o $@ std_standard.s
+	$(RM) std_standard.s
+endif
+
+$(LIB87_DIR)/std/std_standard.o: $(GHDL1)
+ifeq ($(GHDL),ghdl_llvm)
+	$(GHDL1) --std=87 -quiet $(LIB_CFLAGS)  -c -o $@ --compile-standard
+else
+	$(GHDL1) --std=87 -quiet $(LIB_CFLAGS) -o std_standard.s \
+	 --compile-standard
+	$(CC) -c -o $@ std_standard.s
+	$(RM) std_standard.s
+endif
+
+$(LIB08_DIR)/std/std_standard.o: $(GHDL1)
+ifeq ($(GHDL),ghdl_llvm)
+	$(GHDL1) --std=08 -quiet $(LIB_CFLAGS)  -c -o $@ --compile-standard
+else
+	$(GHDL1) --std=08 -quiet $(LIB_CFLAGS) -o std_standard.s \
+	 --compile-standard
+	$(CC) -c -o $@ std_standard.s
+	$(RM) std_standard.s
+endif
+
+install.v93: std.v93 ieee.v93 synopsys.v93 mentor.v93
+install.v87: std.v87 ieee.v87 synopsys.v87
+install.v08: std.v08 ieee.v08
+
+install.standard: $(LIB93_DIR)/std/std_standard.o \
+ $(LIB87_DIR)/std/std_standard.o \
+ $(LIB08_DIR)/std/std_standard.o
+
+grt.links:
+	cd ../lib; ln -sf $(GRTSRCDIR)/grt.lst .; ln -sf $(GRTSRCDIR)/libgrt.a .; ln -sf $(GRTSRCDIR)/grt.ver .
+
+install.all: install.v87 install.v93 install.v08
+
+install.gcc:
+	$(MAKE) GHDL=ghdl_gcc install.all
+	$(MAKE) GHDL1=../ghdl1-gcc install.standard
+
+install.mcode:
+	$(MAKE) GHDL=ghdl_mcode install.all
+
+install.simul:
+	$(MAKE) GHDL=ghdl_simul install.all
+
+install.llvm:
+	$(MAKE) GHDL=ghdl_llvm install.all
+	$(MAKE) GHDL1=../ghdl1-llvm install.standard
+
+clean: force
+	$(RM) -f *.o *.ali ghdl_gcc ghdl_mcode ghdl_llvm ghdl_llvm_jit
+	$(RM) -f b~*.ad? *~ default_pathes.ads ghdl_simul
+	$(RM) -rf ../lib
+
+clean-c: force
+	$(RM) -f memsegs_c.o chkstk.o linux.o times.o grt-cbinding.o grt-cvpi.o
+
+force:
+
+.PHONY: force clean
diff --git a/src/ghdldrv/default_pathes.ads.in b/src/ghdldrv/default_pathes.ads.in
new file mode 100644
index 000000000..7f471a5ed
--- /dev/null
+++ b/src/ghdldrv/default_pathes.ads.in
@@ -0,0 +1,39 @@
+--  GHDL driver pathes  -*- 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.
+
+package Default_Pathes is
+
+   --  Accept long lines.
+   pragma Style_Checks ("M999");
+
+   Install_Prefix : constant String :=
+     "@INSTALL_PREFIX@";
+   Lib_Prefix : constant String :=
+     "@LIB_PREFIX@";
+
+   Compiler_Gcc : constant String :=
+     "@COMPILER_GCC@";
+   Compiler_Mcode : constant String :=
+     "@COMPILER_MCODE@";
+   Compiler_Llvm : constant String :=
+     "@COMPILER_LLVM@";
+   Compiler_Debug : constant String :=
+     "@COMPILER_DEBUG@";
+   Post_Processor : constant String :=
+     "@POST_PROCESSOR@";
+end Default_Pathes;
diff --git a/src/ghdldrv/foreigns.adb b/src/ghdldrv/foreigns.adb
new file mode 100644
index 000000000..15e3dd009
--- /dev/null
+++ b/src/ghdldrv/foreigns.adb
@@ -0,0 +1,64 @@
+with Interfaces.C; use Interfaces.C;
+
+package body Foreigns is
+   function Sin (Arg : double) return double;
+   pragma Import (C, Sin);
+
+   function Log (Arg : double) return double;
+   pragma Import (C, Log);
+
+   function Exp (Arg : double) return double;
+   pragma Import (C, Exp);
+
+   function Sqrt (Arg : double) return double;
+   pragma Import (C, Sqrt);
+
+   function Asin (Arg : double) return double;
+   pragma Import (C, Asin);
+
+   function Acos (Arg : double) return double;
+   pragma Import (C, Acos);
+
+   function Asinh (Arg : double) return double;
+   pragma Import (C, Asinh);
+
+   function Acosh (Arg : double) return double;
+   pragma Import (C, Acosh);
+
+   function Atanh (X : double) return double;
+   pragma Import (C, Atanh);
+
+   function Atan2 (X, Y : double) return double;
+   pragma Import (C, Atan2);
+
+   type String_Cacc is access constant String;
+   type Foreign_Record is record
+      Name : String_Cacc;
+      Addr : Address;
+   end record;
+
+
+   Foreign_Arr : constant array (Natural range <>) of Foreign_Record :=
+     (
+      (new String'("sin"), Sin'Address),
+      (new String'("log"), Log'Address),
+      (new String'("exp"), Exp'Address),
+      (new String'("sqrt"), Sqrt'Address),
+      (new String'("asin"), Asin'Address),
+      (new String'("acos"), Acos'Address),
+      (new String'("asinh"), Asinh'Address),
+      (new String'("acosh"), Acosh'Address),
+      (new String'("atanh"), Atanh'Address),
+      (new String'("atan2"), Atan2'Address)
+     );
+
+   function Find_Foreign (Name : String) return Address is
+   begin
+      for I in Foreign_Arr'Range loop
+         if Foreign_Arr(I).Name.all = Name then
+            return Foreign_Arr(I).Addr;
+         end if;
+      end loop;
+      return Null_Address;
+   end Find_Foreign;
+end Foreigns;
diff --git a/src/ghdldrv/foreigns.ads b/src/ghdldrv/foreigns.ads
new file mode 100644
index 000000000..5759ae4f5
--- /dev/null
+++ b/src/ghdldrv/foreigns.ads
@@ -0,0 +1,5 @@
+with System; use System;
+
+package Foreigns is
+   function Find_Foreign (Name : String) return Address;
+end Foreigns;
diff --git a/src/ghdldrv/ghdl_gcc.adb b/src/ghdldrv/ghdl_gcc.adb
new file mode 100644
index 000000000..615a8c5d6
--- /dev/null
+++ b/src/ghdldrv/ghdl_gcc.adb
@@ -0,0 +1,34 @@
+--  GHDL driver for gcc.
+--  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 Ghdlmain;
+with Ghdllocal;
+with Ghdldrv;
+with Ghdlprint;
+
+procedure Ghdl_Gcc is
+begin
+   --  Manual elaboration so that the order is known (because it is the order
+   --  used to display help).
+   Ghdlmain.Version_String := new String'("GCC back-end code generator");
+   Ghdldrv.Compile_Kind := Ghdldrv.Compile_Gcc;
+   Ghdldrv.Register_Commands;
+   Ghdllocal.Register_Commands;
+   Ghdlprint.Register_Commands;
+   Ghdlmain.Register_Commands;
+   Ghdlmain.Main;
+end Ghdl_Gcc;
diff --git a/src/ghdldrv/ghdl_jit.adb b/src/ghdldrv/ghdl_jit.adb
new file mode 100644
index 000000000..ba7087492
--- /dev/null
+++ b/src/ghdldrv/ghdl_jit.adb
@@ -0,0 +1,35 @@
+--  GHDL driver for jit.
+--  Copyright (C) 2002-2014 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with Ghdlmain;
+with Ghdllocal;
+with Ghdlprint;
+with Ghdlrun;
+with Ortho_Jit;
+
+procedure Ghdl_Jit is
+begin
+   --  Manual elaboration so that the order is known (because it is the order
+   --  used to display help).
+   Ghdlmain.Version_String :=
+     new String'(Ortho_Jit.Get_Jit_Name & " code generator");
+   Ghdlrun.Register_Commands;
+   Ghdllocal.Register_Commands;
+   Ghdlprint.Register_Commands;
+   Ghdlmain.Register_Commands;
+   Ghdlmain.Main;
+end Ghdl_Jit;
diff --git a/src/ghdldrv/ghdl_simul.adb b/src/ghdldrv/ghdl_simul.adb
new file mode 100644
index 000000000..d4d0abd7a
--- /dev/null
+++ b/src/ghdldrv/ghdl_simul.adb
@@ -0,0 +1,33 @@
+--  GHDL driver for simulator.
+--  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 Ghdlmain;
+with Ghdllocal;
+with Ghdlprint;
+with Ghdlsimul;
+
+procedure Ghdl_Simul is
+begin
+   --  Manual elaboration so that the order is known (because it is the order
+   --  used to display help).
+   Ghdlmain.Version_String := new String'("interpretation");
+   Ghdlsimul.Register_Commands;
+   Ghdllocal.Register_Commands;
+   Ghdlprint.Register_Commands;
+   Ghdlmain.Register_Commands;
+   Ghdlmain.Main;
+end Ghdl_Simul;
diff --git a/src/ghdldrv/ghdlcomp.adb b/src/ghdldrv/ghdlcomp.adb
new file mode 100644
index 000000000..ba755af8a
--- /dev/null
+++ b/src/ghdldrv/ghdlcomp.adb
@@ -0,0 +1,757 @@
+--  GHDL driver - compile commands.
+--  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 Ghdlmain; use Ghdlmain;
+with Ghdllocal; use Ghdllocal;
+
+with Ada.Command_Line;
+with Ada.Characters.Latin_1;
+with Ada.Text_IO;
+
+with Types;
+with Iirs; use Iirs;
+with Nodes_GC;
+with Flags;
+with Back_End;
+with Sem;
+with Name_Table;
+with Errorout; use Errorout;
+with Libraries;
+with Std_Package;
+with Files_Map;
+with Version;
+with Default_Pathes;
+
+package body Ghdlcomp is
+
+   Flag_Expect_Failure : Boolean := False;
+
+   Flag_Debug_Nodes_Leak : Boolean := False;
+   --  If True, detect unreferenced nodes at the end of analysis.
+
+   --  Commands which use the mcode compiler.
+   type Command_Comp is abstract new Command_Lib with null record;
+   procedure Decode_Option (Cmd : in out Command_Comp;
+                            Option : String;
+                            Arg : String;
+                            Res : out Option_Res);
+   procedure Disp_Long_Help (Cmd : Command_Comp);
+
+   procedure Decode_Option (Cmd : in out Command_Comp;
+                            Option : String;
+                            Arg : String;
+                            Res : out Option_Res)
+   is
+   begin
+      if Option = "--expect-failure" then
+         Flag_Expect_Failure := True;
+         Res := Option_Ok;
+      elsif Option = "--debug-nodes-leak" then
+         Flag_Debug_Nodes_Leak := True;
+         Res := Option_Ok;
+      elsif Hooks.Decode_Option.all (Option) then
+         Res := Option_Ok;
+      else
+         Decode_Option (Command_Lib (Cmd), Option, Arg, Res);
+      end if;
+   end Decode_Option;
+
+
+   procedure Disp_Long_Help (Cmd : Command_Comp)
+   is
+      use Ada.Text_IO;
+   begin
+      Disp_Long_Help (Command_Lib (Cmd));
+      Hooks.Disp_Long_Help.all;
+      Put_Line (" --expect-failure  Expect analysis/elaboration failure");
+   end Disp_Long_Help;
+
+   --  Command -r
+   type Command_Run is new Command_Comp with null record;
+   function Decode_Command (Cmd : Command_Run; Name : String)
+                           return Boolean;
+   function Get_Short_Help (Cmd : Command_Run) return String;
+
+   procedure Perform_Action (Cmd : in out Command_Run;
+                             Args : Argument_List);
+
+   function Decode_Command (Cmd : Command_Run; Name : String)
+                           return Boolean
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return Name = "-r" or Name = "--elab-run";
+   end Decode_Command;
+
+   function Get_Short_Help (Cmd : Command_Run) return String
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return "-r,--elab-run [OPTS] UNIT [ARCH] [RUNOPTS]  Run UNIT";
+   end Get_Short_Help;
+
+
+   procedure Perform_Action (Cmd : in out Command_Run;
+                             Args : Argument_List)
+   is
+      pragma Unreferenced (Cmd);
+      Opt_Arg : Natural;
+   begin
+      begin
+         Hooks.Compile_Init.all (False);
+
+         Libraries.Load_Work_Library (False);
+         Flags.Flag_Elaborate_With_Outdated := False;
+         Flags.Flag_Only_Elab_Warnings := True;
+
+         Hooks.Compile_Elab.all ("-r", Args, Opt_Arg);
+      exception
+         when Compilation_Error =>
+            if Flag_Expect_Failure then
+               return;
+            else
+               raise;
+            end if;
+      end;
+      Hooks.Set_Run_Options (Args (Opt_Arg .. Args'Last));
+      Hooks.Run.all;
+   end Perform_Action;
+
+
+   --  Command -c xx -r
+   type Command_Compile is new Command_Comp with null record;
+   function Decode_Command (Cmd : Command_Compile; Name : String)
+                           return Boolean;
+   function Get_Short_Help (Cmd : Command_Compile) return String;
+   procedure Decode_Option (Cmd : in out Command_Compile;
+                            Option : String;
+                            Arg : String;
+                            Res : out Option_Res);
+   procedure Perform_Action (Cmd : in out Command_Compile;
+                             Args : Argument_List);
+
+   function Decode_Command (Cmd : Command_Compile; Name : String)
+                           return Boolean
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return Name = "-c";
+   end Decode_Command;
+
+   function Get_Short_Help (Cmd : Command_Compile) return String
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return "-c [OPTS] FILEs -r UNIT [ARCH] [RUNOPTS]  "
+        & "Compile, elaborate and run UNIT";
+   end Get_Short_Help;
+
+   procedure Decode_Option (Cmd : in out Command_Compile;
+                            Option : String;
+                            Arg : String;
+                            Res : out Option_Res)
+   is
+   begin
+      if Option = "-r" or else Option = "-e" then
+         Res := Option_End;
+      else
+         Decode_Option (Command_Comp (Cmd), Option, Arg, Res);
+      end if;
+   end Decode_Option;
+
+   procedure Perform_Action (Cmd : in out Command_Compile;
+                             Args : Argument_List)
+   is
+      pragma Unreferenced (Cmd);
+      Elab_Arg : Natural;
+      Run_Arg : Natural;
+   begin
+      begin
+         Hooks.Compile_Init.all (False);
+
+         Flags.Flag_Elaborate_With_Outdated := True;
+         Flags.Flag_Only_Elab_Warnings := False;
+
+         if Args'Length > 1 and then
+           (Args (Args'First).all = "-r" or else Args (Args'First).all = "-e")
+         then
+            --  If there is no files, then load the work library.
+            Libraries.Load_Work_Library (False);
+            --  Also, load all libraries and files, so that every design unit
+            --  is known.
+            Load_All_Libraries_And_Files;
+            Elab_Arg := Args'First + 1;
+         else
+            --  If there is at least one file, do not load the work library.
+            Libraries.Load_Work_Library (True);
+            Elab_Arg := Natural'Last;
+            for I in Args'Range loop
+               declare
+                  Arg : constant String := Args (I).all;
+                  Res : Iir_Design_File;
+                  Design : Iir;
+                  Next_Design : Iir;
+               begin
+                  if Arg = "-r" or else Arg = "-e" then
+                     Elab_Arg := I + 1;
+                     exit;
+                  else
+                     Res := Libraries.Load_File
+                       (Name_Table.Get_Identifier (Arg));
+                     if Errorout.Nbr_Errors > 0 then
+                        raise Compilation_Error;
+                     end if;
+
+                     --  Put units into library.
+                     Design := Get_First_Design_Unit (Res);
+                     while not Is_Null (Design) loop
+                        Next_Design := Get_Chain (Design);
+                        Set_Chain (Design, Null_Iir);
+                        Libraries.Add_Design_Unit_Into_Library (Design);
+                        Design := Next_Design;
+                     end loop;
+                  end if;
+               end;
+            end loop;
+            if Elab_Arg = Natural'Last then
+               Libraries.Save_Work_Library;
+               return;
+            end if;
+         end if;
+
+         Hooks.Compile_Elab.all ("-c", Args (Elab_Arg .. Args'Last), Run_Arg);
+      exception
+         when Compilation_Error =>
+            if Flag_Expect_Failure then
+               return;
+            else
+               raise;
+            end if;
+      end;
+      if Args (Elab_Arg - 1).all = "-r" then
+         Hooks.Set_Run_Options (Args (Run_Arg .. Args'Last));
+         Hooks.Run.all;
+      else
+         if Run_Arg <= Args'Last then
+            Error_Msg_Option ("options after unit are ignored");
+         end if;
+      end if;
+   end Perform_Action;
+
+   --  Command -a
+   type Command_Analyze is new Command_Comp with null record;
+   function Decode_Command (Cmd : Command_Analyze; Name : String)
+                           return Boolean;
+   function Get_Short_Help (Cmd : Command_Analyze) return String;
+
+   procedure Perform_Action (Cmd : in out Command_Analyze;
+                             Args : Argument_List);
+
+   function Decode_Command (Cmd : Command_Analyze; Name : String)
+                           return Boolean
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return Name = "-a";
+   end Decode_Command;
+
+   function Get_Short_Help (Cmd : Command_Analyze) return String
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return "-a [OPTS] FILEs    Analyze FILEs";
+   end Get_Short_Help;
+
+   procedure Perform_Action (Cmd : in out Command_Analyze;
+                             Args : Argument_List)
+   is
+      pragma Unreferenced (Cmd);
+      use Types;
+      Id : Name_Id;
+      Design_File : Iir_Design_File;
+      New_Design_File : Iir_Design_File;
+      Unit : Iir;
+      Next_Unit : Iir;
+   begin
+      Setup_Libraries (True);
+
+      Hooks.Compile_Init.all (True);
+
+      --  Parse all files.
+      for I in Args'Range loop
+         Id := Name_Table.Get_Identifier (Args (I).all);
+         Design_File := Libraries.Load_File (Id);
+         if Errorout.Nbr_Errors > 0 then
+            raise Compilation_Error;
+         end if;
+
+         if False then
+            --  Speed up analysis: remove all previous designs.
+            --  However, this is not in the LRM...
+            Libraries.Purge_Design_File (Design_File);
+         end if;
+
+         if Design_File /= Null_Iir then
+            Unit := Get_First_Design_Unit (Design_File);
+            while Unit /= Null_Iir loop
+               Back_End.Finish_Compilation (Unit, True);
+
+               Next_Unit := Get_Chain (Unit);
+
+               if Errorout.Nbr_Errors = 0 then
+                  Set_Chain (Unit, Null_Iir);
+                  Libraries.Add_Design_Unit_Into_Library (Unit);
+                  New_Design_File := Get_Design_File (Unit);
+               end if;
+
+               Unit := Next_Unit;
+            end loop;
+
+            if Errorout.Nbr_Errors > 0 then
+               raise Compilation_Error;
+            end if;
+
+            Free_Iir (Design_File);
+
+            --  Do late analysis checks.
+            Unit := Get_First_Design_Unit (New_Design_File);
+            while Unit /= Null_Iir loop
+               Sem.Sem_Analysis_Checks_List (Unit, Flags.Warn_Delayed_Checks);
+               Unit := Get_Chain (Unit);
+            end loop;
+
+            if Errorout.Nbr_Errors > 0 then
+               raise Compilation_Error;
+            end if;
+         end if;
+      end loop;
+
+      if Flag_Expect_Failure then
+         raise Compilation_Error;
+      end if;
+
+      if Flag_Debug_Nodes_Leak then
+         Nodes_GC.Report_Unreferenced;
+      end if;
+
+      Libraries.Save_Work_Library;
+
+   exception
+      when Compilation_Error =>
+         if Flag_Expect_Failure and Errorout.Nbr_Errors /= 0 then
+            return;
+         else
+            raise;
+         end if;
+   end Perform_Action;
+
+   --  Command -e
+   type Command_Elab is new Command_Lib with null record;
+   function Decode_Command (Cmd : Command_Elab; Name : String)
+                           return Boolean;
+   function Get_Short_Help (Cmd : Command_Elab) return String;
+   procedure Decode_Option (Cmd : in out Command_Elab;
+                            Option : String;
+                            Arg : String;
+                            Res : out Option_Res);
+
+   procedure Perform_Action (Cmd : in out Command_Elab;
+                             Args : Argument_List);
+
+   function Decode_Command (Cmd : Command_Elab; Name : String)
+                           return Boolean
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return Name = "-e";
+   end Decode_Command;
+
+   function Get_Short_Help (Cmd : Command_Elab) return String
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return "-e [OPTS] UNIT [ARCH]  Elaborate UNIT";
+   end Get_Short_Help;
+
+   procedure Decode_Option (Cmd : in out Command_Elab;
+                            Option : String;
+                            Arg : String;
+                            Res : out Option_Res)
+   is
+   begin
+      if Option = "--expect-failure" then
+         Flag_Expect_Failure := True;
+         Res := Option_Ok;
+      elsif Option = "-o" then
+         if Arg'Length = 0 then
+            Res := Option_Arg_Req;
+         else
+            --  Silently accepted.
+            Res := Option_Arg;
+         end if;
+      --elsif Option'Length >= 4 and then Option (1 .. 4) = "-Wl," then
+      --   Res := Option_Ok;
+      else
+         Decode_Option (Command_Lib (Cmd), Option, Arg, Res);
+      end if;
+   end Decode_Option;
+
+   procedure Perform_Action (Cmd : in out Command_Elab;
+                             Args : Argument_List)
+   is
+      pragma Unreferenced (Cmd);
+      Run_Arg : Natural;
+   begin
+      Hooks.Compile_Init.all (False);
+
+      Libraries.Load_Work_Library (False);
+      Flags.Flag_Elaborate_With_Outdated := False;
+      Flags.Flag_Only_Elab_Warnings := True;
+
+      Hooks.Compile_Elab.all ("-e", Args, Run_Arg);
+      if Run_Arg <= Args'Last then
+         Error_Msg_Option ("options after unit are ignored");
+      end if;
+      if Flag_Expect_Failure then
+         raise Compilation_Error;
+      end if;
+   exception
+      when Compilation_Error =>
+         if Flag_Expect_Failure and then Errorout.Nbr_Errors > 0 then
+            return;
+         else
+            raise;
+         end if;
+   end Perform_Action;
+
+   --  Command dispconfig.
+   type Command_Dispconfig is new Command_Lib with null record;
+   function Decode_Command (Cmd : Command_Dispconfig; Name : String)
+                           return Boolean;
+   function Get_Short_Help (Cmd : Command_Dispconfig) return String;
+   procedure Perform_Action (Cmd : in out Command_Dispconfig;
+                             Args : Argument_List);
+
+   function Decode_Command (Cmd : Command_Dispconfig; Name : String)
+                           return Boolean
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return Name = "--dispconfig";
+   end Decode_Command;
+
+   function Get_Short_Help (Cmd : Command_Dispconfig) return String
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return "--dispconfig       Disp tools path";
+   end Get_Short_Help;
+
+   procedure Perform_Action (Cmd : in out Command_Dispconfig;
+                             Args : Argument_List)
+   is
+      use Ada.Text_IO;
+      use Libraries;
+      pragma Unreferenced (Cmd);
+   begin
+      if Args'Length /= 0 then
+         Error ("--dispconfig does not accept any argument");
+         raise Errorout.Option_Error;
+      end if;
+
+      Put ("command line prefix (--PREFIX): ");
+      if Prefix_Path = null then
+         Put_Line ("(not set)");
+      else
+         Put_Line (Prefix_Path.all);
+      end if;
+      Setup_Libraries (False);
+
+      Put ("environment prefix (GHDL_PREFIX): ");
+      if Prefix_Env = null then
+         Put_Line ("(not set)");
+      else
+         Put_Line (Prefix_Env.all);
+      end if;
+
+      Put_Line ("default prefix: " & Default_Pathes.Prefix);
+      Put_Line ("actual prefix: " & Prefix_Path.all);
+      Put_Line ("command_name: " & Ada.Command_Line.Command_Name);
+      Put_Line ("default library pathes:");
+      for I in 2 .. Get_Nbr_Pathes loop
+         Put (' ');
+         Put_Line (Name_Table.Image (Get_Path (I)));
+      end loop;
+   end Perform_Action;
+
+   --  Command Make.
+   type Command_Make is new Command_Comp with null record;
+   function Decode_Command (Cmd : Command_Make; Name : String)
+                           return Boolean;
+   function Get_Short_Help (Cmd : Command_Make) return String;
+   procedure Perform_Action (Cmd : in out Command_Make;
+                             Args : Argument_List);
+
+   function Decode_Command (Cmd : Command_Make; Name : String)
+                           return Boolean
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return Name = "-m";
+   end Decode_Command;
+
+   function Get_Short_Help (Cmd : Command_Make) return String
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return "-m [OPTS] UNIT [ARCH]  Make UNIT";
+   end Get_Short_Help;
+
+   procedure Perform_Action (Cmd : in out Command_Make; Args : Argument_List)
+   is
+      pragma Unreferenced (Cmd);
+      use Types;
+
+      Files_List : Iir_List;
+      File : Iir_Design_File;
+
+      Next_Arg : Natural;
+      Date : Date_Type;
+      Unit : Iir_Design_Unit;
+   begin
+      Extract_Elab_Unit ("-m", Args, Next_Arg);
+      Setup_Libraries (True);
+
+      --  Create list of files.
+      Files_List := Build_Dependence (Prim_Name, Sec_Name);
+
+      Date := Get_Date (Libraries.Work_Library);
+      for I in Natural loop
+         File := Get_Nth_Element (Files_List, I);
+         exit when File = Null_Iir;
+
+         if Get_Library (File) = Libraries.Work_Library then
+            --  Mark this file as analyzed.
+            Set_Analysis_Time_Stamp (File, Files_Map.Get_Os_Time_Stamp);
+
+            Unit := Get_First_Design_Unit (File);
+            while Unit /= Null_Iir loop
+               if Get_Date (Unit) = Date_Analyzed
+                 or else Get_Date (Unit) in Date_Valid
+               then
+                  Date := Date + 1;
+                  Set_Date (Unit, Date);
+               end if;
+               Unit := Get_Chain (Unit);
+            end loop;
+         end if;
+      end loop;
+      Set_Date (Libraries.Work_Library, Date);
+      Libraries.Save_Work_Library;
+   exception
+      when Compilation_Error =>
+         if Flag_Expect_Failure then
+            return;
+         else
+            raise;
+         end if;
+   end Perform_Action;
+
+      --  Command Gen_Makefile.
+   type Command_Gen_Makefile is new Command_Lib with null record;
+   function Decode_Command (Cmd : Command_Gen_Makefile; Name : String)
+                           return Boolean;
+   function Get_Short_Help (Cmd : Command_Gen_Makefile) return String;
+   procedure Perform_Action (Cmd : in out Command_Gen_Makefile;
+                             Args : Argument_List);
+
+   function Decode_Command (Cmd : Command_Gen_Makefile; Name : String)
+                           return Boolean
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return Name = "--gen-makefile";
+   end Decode_Command;
+
+   function Get_Short_Help (Cmd : Command_Gen_Makefile) return String
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return "--gen-makefile [OPTS] UNIT [ARCH]  Generate a Makefile for UNIT";
+   end Get_Short_Help;
+
+   function Is_Makeable_File (File : Iir_Design_File) return Boolean is
+   begin
+      if File = Std_Package.Std_Standard_File then
+         return False;
+      end if;
+      return True;
+   end Is_Makeable_File;
+
+   procedure Perform_Action (Cmd : in out Command_Gen_Makefile;
+                             Args : Argument_List)
+   is
+      pragma Unreferenced (Cmd);
+      use Types;
+      use Ada.Text_IO;
+      use Ada.Command_Line;
+      use Name_Table;
+
+      HT : constant Character := Ada.Characters.Latin_1.HT;
+      Files_List : Iir_List;
+      File : Iir_Design_File;
+
+      Lib : Iir_Library_Declaration;
+      Dir_Id : Name_Id;
+
+      Next_Arg : Natural;
+   begin
+      Extract_Elab_Unit ("--gen-makefile", Args, Next_Arg);
+      Setup_Libraries (True);
+      Files_List := Build_Dependence (Prim_Name, Sec_Name);
+
+      Put_Line ("# Makefile automatically generated by ghdl");
+      Put ("# Version: ");
+      Put (Version.Ghdl_Release);
+      Put (" - ");
+      if Version_String /= null then
+         Put (Version_String.all);
+      end if;
+      New_Line;
+      Put_Line ("# Command used to generate this makefile:");
+      Put ("# ");
+      Put (Command_Name);
+      for I in 1 .. Argument_Count loop
+         Put (' ');
+         Put (Argument (I));
+      end loop;
+      New_Line;
+
+      New_Line;
+
+      Put ("GHDL=");
+      Put_Line (Command_Name);
+
+      --  Extract options for command line.
+      Put ("GHDLFLAGS=");
+      for I in 2 .. Argument_Count loop
+         declare
+            Arg : constant String := Argument (I);
+         begin
+            if Arg (1) = '-' then
+               if (Arg'Length > 10 and then Arg (1 .. 10) = "--workdir=")
+                 or else (Arg'Length > 7 and then Arg (1 .. 7) = "--ieee=")
+                 or else (Arg'Length > 6 and then Arg (1 .. 6) = "--std=")
+                 or else (Arg'Length > 7 and then Arg (1 .. 7) = "--work=")
+                 or else (Arg'Length > 2 and then Arg (1 .. 2) = "-P")
+               then
+                  Put (" ");
+                  Put (Arg);
+               end if;
+            end if;
+         end;
+      end loop;
+      New_Line;
+
+      Put ("GHDLRUNFLAGS=");
+      for I in Next_Arg .. Args'Last loop
+         Put (' ');
+         Put (Args (I).all);
+      end loop;
+      New_Line;
+      New_Line;
+
+      Put_Line ("# Default target : elaborate");
+      Put_Line ("all : elab");
+      New_Line;
+
+      Put_Line ("# Elaborate target.  Almost useless");
+      Put_Line ("elab : force");
+      Put (HT & "$(GHDL) -c $(GHDLFLAGS) -e ");
+      Put (Prim_Name.all);
+      if Sec_Name /= null then
+         Put (' ');
+         Put (Sec_Name.all);
+      end if;
+      New_Line;
+      New_Line;
+
+      Put_Line ("# Run target");
+      Put_Line ("run : force");
+      Put (HT & "$(GHDL) -c $(GHDLFLAGS) -r ");
+      Put (Prim_Name.all);
+      if Sec_Name /= null then
+         Put (' ');
+         Put (Sec_Name.all);
+      end if;
+      Put (" $(GHDLRUNFLAGS)");
+      New_Line;
+      New_Line;
+
+      Put_Line ("# Targets to analyze libraries");
+      Put_Line ("init: force");
+      for I in Natural loop
+         File := Get_Nth_Element (Files_List, I);
+         exit when File = Null_Iir;
+         Dir_Id := Get_Design_File_Directory (File);
+         if not Is_Makeable_File (File) then
+            --  Builtin file.
+            null;
+         elsif Dir_Id /= Files_Map.Get_Home_Directory then
+            --  Not locally built file.
+            Put (HT & "# ");
+            Put (Image (Dir_Id));
+            Put (Image (Get_Design_File_Filename (File)));
+            New_Line;
+         else
+
+            Put (HT & "$(GHDL) -a $(GHDLFLAGS)");
+            Lib := Get_Library (File);
+            if Lib /= Libraries.Work_Library then
+               --  Overwrite some options.
+               Put (" --work=");
+               Put (Image (Get_Identifier (Lib)));
+               Dir_Id := Get_Library_Directory (Lib);
+               Put (" --workdir=");
+               if Dir_Id = Libraries.Local_Directory then
+                  Put (".");
+               else
+                  Put (Image (Dir_Id));
+               end if;
+            end if;
+            Put (' ');
+            Put (Image (Get_Design_File_Filename (File)));
+            New_Line;
+         end if;
+      end loop;
+      New_Line;
+
+      Put_Line ("force:");
+   end Perform_Action;
+
+   procedure Register_Commands is
+   begin
+      Register_Command (new Command_Analyze);
+      Register_Command (new Command_Elab);
+      Register_Command (new Command_Run);
+      Register_Command (new Command_Compile);
+      Register_Command (new Command_Make);
+      Register_Command (new Command_Gen_Makefile);
+      Register_Command (new Command_Dispconfig);
+   end Register_Commands;
+
+end Ghdlcomp;
diff --git a/src/ghdldrv/ghdlcomp.ads b/src/ghdldrv/ghdlcomp.ads
new file mode 100644
index 000000000..f803ca4fa
--- /dev/null
+++ b/src/ghdldrv/ghdlcomp.ads
@@ -0,0 +1,67 @@
+--  GHDL driver - compile commands.
+--  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.OS_Lib; use GNAT.OS_Lib;
+
+package Ghdlcomp is
+   --  This procedure is called at start of commands which call
+   --  finish_compilation to generate code.
+   type Compile_Init_Acc is access procedure (Analyze_Only : Boolean);
+
+   --  This procedure is called for elaboration.
+   --  CMD_NAME is the name of the command, used to report errors.
+   --  ARGS is the argument list, starting from the unit name to be elaborated.
+   --   The procedure should extract the unit.
+   --  OPT_ARG is the index of the first argument from ARGS to be used as
+   --   a run option.
+   type Compile_Elab_Acc is access procedure
+     (Cmd_Name : String; Args : Argument_List; Opt_Arg : out Natural);
+
+   --  Use ARGS as run options.
+   --  Should do all the work.
+   type Set_Run_Options_Acc is access
+     procedure (Args : Argument_List);
+
+   --  Run the simulation.
+   --  All the parameters were set through calling Compile_Elab and
+   --  Set_Run_Options.
+   type Run_Acc is access procedure;
+
+   --  Called when an analysis/elaboration option is decoded.
+   --  Return True if OPTION is known (and do the side effects).
+   --  No parameters are allowed.
+   type Decode_Option_Acc is access function (Option : String) return Boolean;
+
+   --  Disp help for options decoded by Decode_Option.
+   type Disp_Long_Help_Acc is access procedure;
+
+   --  All the hooks gathered.
+   --  A record is used to be sure all hooks are set.
+   type Hooks_Type is record
+      Compile_Init : Compile_Init_Acc := null;
+      Compile_Elab : Compile_Elab_Acc := null;
+      Set_Run_Options : Set_Run_Options_Acc := null;
+      Run : Run_Acc := null;
+      Decode_Option : Decode_Option_Acc := null;
+      Disp_Long_Help : Disp_Long_Help_Acc := null;
+   end record;
+
+   Hooks : Hooks_Type;
+
+   --  Register commands.
+   procedure Register_Commands;
+end Ghdlcomp;
diff --git a/src/ghdldrv/ghdldrv.adb b/src/ghdldrv/ghdldrv.adb
new file mode 100644
index 000000000..be905f1af
--- /dev/null
+++ b/src/ghdldrv/ghdldrv.adb
@@ -0,0 +1,1818 @@
+--  GHDL driver - commands invoking gcc.
+--  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.Command_Line; use Ada.Command_Line;
+with Ada.Text_IO; use Ada.Text_IO;
+with Ada.Characters.Latin_1;
+with GNAT.OS_Lib; use GNAT.OS_Lib;
+with GNAT.Table;
+with GNAT.Dynamic_Tables;
+with Libraries;
+with Name_Table; use Name_Table;
+with Std_Package;
+with Types; use Types;
+with Iirs; use Iirs;
+with Files_Map;
+with Flags;
+with Configuration;
+--with Disp_Tree;
+with Default_Pathes;
+with Interfaces.C_Streams;
+with System;
+with Ghdlmain; use Ghdlmain;
+with Ghdllocal; use Ghdllocal;
+with Errorout;
+with Version;
+with Options;
+
+package body Ghdldrv is
+   --  Name of the tools used.
+   Compiler_Cmd : String_Access := null;
+   Post_Processor_Cmd : String_Access := null;
+   Assembler_Cmd : constant String := "as";
+   Linker_Cmd : constant String := "gcc";
+
+   --  Path of the tools.
+   Compiler_Path : String_Access;
+   Post_Processor_Path : String_Access;
+   Assembler_Path : String_Access;
+   Linker_Path : String_Access;
+
+   --  Set by the '-o' option: the output filename.  If the option is not
+   --  present, then null.
+   Output_File : String_Access;
+
+   --  "-o" string.
+   Dash_o : constant String_Access := new String'("-o");
+
+   --  "-c" string.
+   Dash_c : constant String_Access := new String'("-c");
+
+   --  "-quiet" option.
+   Dash_Quiet : constant String_Access := new String'("-quiet");
+
+   --  If set, do not assmble
+   Flag_Asm : Boolean;
+
+   --  If true, executed commands are displayed.
+   Flag_Disp_Commands : Boolean;
+
+   --  Flag not quiet
+   Flag_Not_Quiet : Boolean;
+
+   --  True if failure expected.
+   Flag_Expect_Failure : Boolean;
+
+   --  Argument table for the tools.
+   --  Each table low bound is 1 so that the length of a table is equal to
+   --  the last bound.
+   package Argument_Table_Pkg is new GNAT.Dynamic_Tables
+     (Table_Component_Type => String_Access,
+      Table_Index_Type => Integer,
+      Table_Low_Bound => 1,
+      Table_Initial => 4,
+      Table_Increment => 100);
+   use Argument_Table_Pkg;
+
+   --  Arguments for tools.
+   Compiler_Args : Argument_Table_Pkg.Instance;
+   Postproc_Args : Argument_Table_Pkg.Instance;
+   Assembler_Args : Argument_Table_Pkg.Instance;
+   Linker_Args : Argument_Table_Pkg.Instance;
+
+   --  Display the program spawned in Flag_Disp_Commands is TRUE.
+   --  Raise COMPILE_ERROR in case of failure.
+   procedure My_Spawn (Program_Name : String; Args : Argument_List)
+   is
+      Status : Integer;
+   begin
+      if Flag_Disp_Commands then
+         Put (Program_Name);
+         for I in Args'Range loop
+            Put (' ');
+            Put (Args (I).all);
+         end loop;
+         New_Line;
+      end if;
+      Status := Spawn (Program_Name, Args);
+      if Status = 0 then
+         return;
+      elsif Status = 1 then
+         Error ("compilation error");
+         raise Compile_Error;
+      elsif Status > 127 then
+         Error ("executable killed by a signal");
+         raise Exec_Error;
+      else
+         Error ("exec error");
+         raise Exec_Error;
+      end if;
+   end My_Spawn;
+
+   --  Compile FILE with additional argument OPTS.
+   procedure Do_Compile (Options : Argument_List; File : String)
+   is
+      Obj_File : String_Access;
+      Asm_File : String_Access;
+      Post_File : String_Access;
+      Success : Boolean;
+   begin
+      --  Create post file.
+      case Compile_Kind is
+         when Compile_Debug =>
+            Post_File := Append_Suffix (File, Post_Suffix);
+         when others =>
+            null;
+      end case;
+
+      --  Create asm file.
+      case Compile_Kind is
+         when Compile_Gcc
+           | Compile_Debug =>
+            Asm_File := Append_Suffix (File, Asm_Suffix);
+         when Compile_Llvm
+           | Compile_Mcode =>
+            null;
+      end case;
+
+      --  Create obj file (may not be used, but the condition isn't simple).
+      Obj_File := Append_Suffix (File, Get_Object_Suffix.all);
+
+      --  Compile.
+      declare
+         P : Natural;
+         Nbr_Args : constant Natural :=
+           Last (Compiler_Args) + Options'Length + 4;
+         Args : Argument_List (1 .. Nbr_Args);
+      begin
+         P := 0;
+         for I in First .. Last (Compiler_Args) loop
+            P := P + 1;
+            Args (P) := Compiler_Args.Table (I);
+         end loop;
+         for I in Options'Range loop
+            P := P + 1;
+            Args (P) := Options (I);
+         end loop;
+
+         --  Add -quiet.
+         case Compile_Kind is
+            when Compile_Gcc =>
+               if not Flag_Not_Quiet then
+                  P := P + 1;
+                  Args (P) := Dash_Quiet;
+               end if;
+            when Compile_Llvm =>
+               P := P + 1;
+               Args (P) := Dash_c;
+            when Compile_Debug
+              | Compile_Mcode =>
+               null;
+         end case;
+
+         Args (P + 1) := Dash_o;
+         case Compile_Kind is
+            when Compile_Debug =>
+               Args (P + 2) := Post_File;
+            when Compile_Gcc =>
+               Args (P + 2) := Asm_File;
+            when Compile_Mcode
+              | Compile_Llvm =>
+               Args (P + 2) := Obj_File;
+         end case;
+         Args (P + 3) := new String'(File);
+
+         My_Spawn (Compiler_Path.all, Args (1 .. P + 3));
+         Free (Args (P + 3));
+      exception
+         when Compile_Error =>
+            --  Delete temporary file in case of error.
+            Delete_File (Args (P + 2).all, Success);
+            --  FIXME: delete object file too ?
+            raise;
+      end;
+
+      --  Post-process.
+      if Compile_Kind = Compile_Debug then
+         declare
+            P : Natural;
+            Nbr_Args : constant Natural := Last (Postproc_Args) + 4;
+            Args : Argument_List (1 .. Nbr_Args);
+         begin
+            P := 0;
+            for I in First .. Last (Postproc_Args) loop
+               P := P + 1;
+               Args (P) := Postproc_Args.Table (I);
+            end loop;
+
+            if not Flag_Not_Quiet then
+               P := P + 1;
+               Args (P) := Dash_Quiet;
+            end if;
+
+            Args (P + 1) := Dash_o;
+            Args (P + 2) := Asm_File;
+            Args (P + 3) := Post_File;
+            My_Spawn (Post_Processor_Path.all, Args (1 .. P + 3));
+         end;
+
+         Free (Post_File);
+      end if;
+
+      --  Assemble.
+      if Compile_Kind >= Compile_Gcc then
+         if Flag_Expect_Failure then
+            Delete_File (Asm_File.all, Success);
+         elsif not Flag_Asm then
+            declare
+               P : Natural;
+               Nbr_Args : constant Natural := Last (Assembler_Args) + 4;
+               Args : Argument_List (1 .. Nbr_Args);
+               Success : Boolean;
+            begin
+               P := 0;
+               for I in First .. Last (Assembler_Args) loop
+                  P := P + 1;
+                  Args (P) := Assembler_Args.Table (I);
+               end loop;
+
+               Args (P + 1) := Dash_o;
+               Args (P + 2) := Obj_File;
+               Args (P + 3) := Asm_File;
+               My_Spawn (Assembler_Path.all, Args (1 .. P + 3));
+               Delete_File (Asm_File.all, Success);
+            end;
+         end if;
+      end if;
+
+      Free (Asm_File);
+      Free (Obj_File);
+   end Do_Compile;
+
+   package Filelist is new GNAT.Table
+     (Table_Component_Type => String_Access,
+      Table_Index_Type => Natural,
+      Table_Low_Bound => 1,
+      Table_Initial => 16,
+      Table_Increment => 100);
+
+   Link_Obj_Suffix : String_Access;
+
+   --  Read a list of files from file FILENAME.
+   --  Lines starting with a '#' are ignored (comments)
+   --  Lines starting with a '>' are directory lines
+   --  If first character of a line is a '@', it is replaced with
+   --    the lib_prefix_path.
+   --  If TO_OBJ is true, then each file is converted to an object file name
+   --   (suffix is replaced by the object file extension).
+   procedure Add_File_List (Filename : String; To_Obj : Boolean)
+   is
+      use Interfaces.C_Streams;
+      use System;
+      use Ada.Characters.Latin_1;
+
+      --  Replace the first '@' with the machine path.
+      function Substitute (Str : String) return String
+      is
+      begin
+         for I in Str'Range loop
+            if Str (I) = '@' then
+               return Str (Str'First .. I - 1)
+                 & Get_Machine_Path_Prefix
+                 & Str (I + 1 .. Str'Last);
+            end if;
+         end loop;
+         return Str;
+      end Substitute;
+
+      Dir : String (1 .. max_path_len);
+      Dir_Len : Natural;
+      Line : String (1 .. max_path_len);
+      Stream : Interfaces.C_Streams.FILEs;
+      Mode : constant String := "rt" & Ghdllocal.Nul;
+      L : Natural;
+      File : String_Access;
+   begin
+      Line (1 .. Filename'Length) := Filename;
+      Line (Filename'Length + 1) := Ghdllocal.Nul;
+      Stream := fopen (Line'Address, Mode'Address);
+      if Stream = NULL_Stream then
+         Error ("cannot open " & Filename);
+         raise Compile_Error;
+      end if;
+      Dir_Len := 0;
+      loop
+         exit when fgets (Line'Address, Line'Length, Stream) = NULL_Stream;
+         if Line (1) /= '#' then
+            --  Compute string length.
+            L := 0;
+            while Line (L + 1) /= Ghdllocal.Nul loop
+               L := L + 1;
+            end loop;
+
+            --  Remove trailing NL.
+            while L > 0 and then (Line (L) = LF or Line (L) = CR) loop
+               L := L - 1;
+            end loop;
+
+            if Line (1) = '>' then
+               Dir_Len := L - 1;
+               Dir (1 .. Dir_Len) := Line (2 .. L);
+            else
+               if To_Obj then
+                  File := new String'(Dir (1 .. Dir_Len)
+                                      & Get_Base_Name (Line (1 .. L))
+                                      & Link_Obj_Suffix.all);
+               else
+                  File := new String'(Substitute (Line (1 .. L)));
+               end if;
+
+               Filelist.Increment_Last;
+               Filelist.Table (Filelist.Last) := File;
+
+               Dir_Len := 0;
+            end if;
+         end if;
+      end loop;
+      if fclose (Stream) /= 0 then
+         Error ("cannot close " & Filename);
+      end if;
+   end Add_File_List;
+
+   function Get_Object_Filename (File : Iir_Design_File) return String
+   is
+      Dir : Name_Id;
+      Name : Name_Id;
+   begin
+      Dir := Get_Library_Directory (Get_Library (File));
+      Name := Get_Design_File_Filename (File);
+      return Image (Dir) & Get_Base_Name (Image (Name))
+        & Get_Object_Suffix.all;
+   end Get_Object_Filename;
+
+   Last_Stamp : Time_Stamp_Id;
+   Last_Stamp_File : Iir;
+
+   function Is_File_Outdated (Design_File : Iir_Design_File) return Boolean
+   is
+      use Files_Map;
+
+      Name : Name_Id;
+
+      File : Source_File_Entry;
+   begin
+      --  Std.Standard is never outdated.
+      if Design_File = Std_Package.Std_Standard_File then
+         return False;
+      end if;
+
+      Name := Get_Design_File_Filename (Design_File);
+      declare
+         Obj_Pathname : String := Get_Object_Filename (Design_File) & Nul;
+         Stamp : Time_Stamp_Id;
+      begin
+         Stamp := Get_File_Time_Stamp (Obj_Pathname'Address);
+
+         --  If the object file does not exist, recompile the file.
+         if Stamp = Null_Time_Stamp then
+            if Flag_Verbose then
+               Put_Line ("no object file for " & Image (Name));
+            end if;
+            return True;
+         end if;
+
+         --  Keep the time stamp of the most recently analyzed unit.
+         if Last_Stamp = Null_Time_Stamp
+           or else Is_Gt (Stamp, Last_Stamp)
+         then
+            Last_Stamp := Stamp;
+            Last_Stamp_File := Design_File;
+         end if;
+      end;
+
+      --  2) file has been modified.
+      File := Load_Source_File (Get_Design_File_Directory (Design_File),
+                                Get_Design_File_Filename (Design_File));
+      if not Is_Eq (Get_File_Time_Stamp (File),
+                    Get_File_Time_Stamp (Design_File))
+      then
+         if Flag_Verbose then
+            Put_Line ("file " & Image (Get_File_Name (File))
+                 & " has been modified");
+         end if;
+         return True;
+      end if;
+
+      return False;
+   end Is_File_Outdated;
+
+   function Is_Unit_Outdated (Unit : Iir_Design_Unit) return Boolean
+   is
+      Design_File : Iir_Design_File;
+   begin
+      --  Std.Standard is never outdated.
+      if Unit = Std_Package.Std_Standard_Unit then
+         return False;
+      end if;
+
+      Design_File := Get_Design_File (Unit);
+
+      --  1) not yet analyzed:
+      if Get_Date (Unit) not in Date_Valid then
+         if Flag_Verbose then
+            Disp_Library_Unit (Get_Library_Unit (Unit));
+            Put_Line (" was not analyzed");
+         end if;
+         return True;
+      end if;
+
+      --  3) the object file does not exist.
+      --  Already checked.
+
+      --  4) one of the dependence is newer
+      declare
+         Depends : Iir_List;
+         El : Iir;
+         Dep : Iir_Design_Unit;
+         Stamp : Time_Stamp_Id;
+         Dep_File : Iir_Design_File;
+      begin
+         Depends := Get_Dependence_List (Unit);
+         Stamp := Get_Analysis_Time_Stamp (Design_File);
+         if Depends /= Null_Iir_List then
+            for I in Natural loop
+               El := Get_Nth_Element (Depends, I);
+               exit when El = Null_Iir;
+               Dep := Libraries.Find_Design_Unit (El);
+               if Dep = Null_Iir then
+                  if Flag_Verbose then
+                     Disp_Library_Unit (Unit);
+                     Put (" depends on an unknown unit ");
+                     Disp_Library_Unit (El);
+                     New_Line;
+                  end if;
+                  return True;
+               end if;
+               Dep_File := Get_Design_File (Dep);
+               if Dep /= Std_Package.Std_Standard_Unit
+                 and then Files_Map.Is_Gt (Get_Analysis_Time_Stamp (Dep_File),
+                                           Stamp)
+               then
+                  if Flag_Verbose then
+                     Disp_Library_Unit (Get_Library_Unit (Unit));
+                     Put (" depends on: ");
+                     Disp_Library_Unit (Get_Library_Unit (Dep));
+                     Put (" (more recently analyzed)");
+                     New_Line;
+                  end if;
+                  return True;
+               end if;
+            end loop;
+         end if;
+      end;
+
+      return False;
+   end Is_Unit_Outdated;
+
+   procedure Add_Argument (Inst : in out Instance; Arg : String_Access)
+   is
+   begin
+      Increment_Last (Inst);
+      Inst.Table (Last (Inst)) := Arg;
+   end Add_Argument;
+
+   --  Convert option "-Wx,OPTIONS" to arguments for tool X.
+   procedure Add_Arguments (Inst : in out Instance; Opt : String) is
+   begin
+      Add_Argument (Inst, new String'(Opt (Opt'First + 4 .. Opt'Last)));
+   end Add_Arguments;
+
+   procedure Tool_Not_Found (Name : String) is
+   begin
+      Error ("installation problem: " & Name & " not found");
+      raise Option_Error;
+   end Tool_Not_Found;
+
+   --  Set the compiler command according to the configuration (and swicthes).
+   procedure Set_Tools_Name is
+   begin
+      --  Set tools name.
+      if Compiler_Cmd = null then
+         case Compile_Kind is
+            when Compile_Debug =>
+               Compiler_Cmd := new String'(Default_Pathes.Compiler_Debug);
+            when Compile_Gcc =>
+               Compiler_Cmd := new String'(Default_Pathes.Compiler_Gcc);
+            when Compile_Mcode =>
+               Compiler_Cmd := new String'(Default_Pathes.Compiler_Mcode);
+            when Compile_Llvm =>
+               Compiler_Cmd := new String'(Default_Pathes.Compiler_Llvm);
+         end case;
+      end if;
+      if Post_Processor_Cmd = null then
+         Post_Processor_Cmd := new String'(Default_Pathes.Post_Processor);
+      end if;
+   end Set_Tools_Name;
+
+   function Locate_Exec_Tool (Toolname : String) return String_Access is
+   begin
+      if Is_Absolute_Path (Toolname) then
+         if Is_Executable_File (Toolname) then
+            return new String'(Toolname);
+         end if;
+      else
+         --  Try from install prefix
+         if Exec_Prefix /= null then
+            declare
+               Path : constant String :=
+                 Exec_Prefix.all & Directory_Separator & Toolname;
+            begin
+               if Is_Executable_File (Path) then
+                  return new String'(Path);
+               end if;
+            end;
+         end if;
+
+         --  Try configured prefix
+         declare
+            Path : constant String :=
+              Default_Pathes.Install_Prefix & Directory_Separator & Toolname;
+         begin
+            if Is_Executable_File (Path) then
+               return new String'(Path);
+            end if;
+         end;
+      end if;
+
+      --  Search the basename on path.
+      declare
+         Pos : constant Natural := Get_Basename_Pos (Toolname);
+      begin
+         if Pos = 0 then
+            return Locate_Exec_On_Path (Toolname);
+         else
+            return Locate_Exec_On_Path (Toolname (Pos .. Toolname'Last));
+         end if;
+      end;
+   end Locate_Exec_Tool;
+
+   procedure Locate_Tools is
+   begin
+      Compiler_Path := Locate_Exec_Tool (Compiler_Cmd.all);
+      if Compiler_Path = null then
+         Tool_Not_Found (Compiler_Cmd.all);
+      end if;
+      if Compile_Kind >= Compile_Debug then
+         Post_Processor_Path := Locate_Exec_Tool (Post_Processor_Cmd.all);
+         if Post_Processor_Path = null then
+            Tool_Not_Found (Post_Processor_Cmd.all);
+         end if;
+      end if;
+      if Compile_Kind >= Compile_Gcc then
+         Assembler_Path := Locate_Exec_On_Path (Assembler_Cmd);
+         if Assembler_Path = null and not Flag_Asm then
+            Tool_Not_Found (Assembler_Cmd);
+         end if;
+      end if;
+      Linker_Path := Locate_Exec_On_Path (Linker_Cmd);
+      if Linker_Path = null then
+         Tool_Not_Found (Linker_Cmd);
+      end if;
+   end Locate_Tools;
+
+   procedure Setup_Compiler (Load : Boolean)
+   is
+      use Libraries;
+   begin
+      Set_Tools_Name;
+      Setup_Libraries (Load);
+      Locate_Tools;
+      for I in 2 .. Get_Nbr_Pathes loop
+         Add_Argument (Compiler_Args,
+                       new String'("-P" & Image (Get_Path (I))));
+      end loop;
+   end Setup_Compiler;
+
+   type Command_Comp is abstract new Command_Lib with null record;
+
+   --  Setup GHDL.
+   procedure Init (Cmd : in out Command_Comp);
+
+   --  Handle:
+   --  all ghdl flags.
+   --  some GCC flags.
+   procedure Decode_Option (Cmd : in out Command_Comp;
+                            Option : String;
+                            Arg : String;
+                            Res : out Option_Res);
+
+   procedure Disp_Long_Help (Cmd : Command_Comp);
+
+   procedure Init (Cmd : in out Command_Comp)
+   is
+   begin
+      --  Init options.
+      Flag_Not_Quiet := False;
+      Flag_Disp_Commands := False;
+      Flag_Asm := False;
+      Flag_Expect_Failure := False;
+      Output_File := null;
+
+      --  Initialize argument tables.
+      Init (Compiler_Args);
+      Init (Postproc_Args);
+      Init (Assembler_Args);
+      Init (Linker_Args);
+      Init (Command_Lib (Cmd));
+   end Init;
+
+   procedure Decode_Option (Cmd : in out Command_Comp;
+                            Option : String;
+                            Arg : String;
+                            Res : out Option_Res)
+   is
+      Str : String_Access;
+      Opt : constant String (1 .. Option'Length) := Option;
+   begin
+      Res := Option_Bad;
+      if Opt = "-v" and then Flag_Verbose = False then
+         --  Note: this is also decoded for command_lib, but we set
+         --  Flag_Disp_Commands too.
+         Flag_Verbose := True;
+         --Flags.Verbose := True;
+         Flag_Disp_Commands := True;
+         Res := Option_Ok;
+      elsif Opt'Length > 8 and then Opt (1 .. 8) = "--GHDL1=" then
+         Compiler_Cmd := new String'(Opt (9 .. Opt'Last));
+         Res := Option_Ok;
+      elsif Opt = "-S" then
+         Flag_Asm := True;
+         Res := Option_Ok;
+      elsif Opt = "--post" then
+         Compile_Kind := Compile_Debug;
+         Res := Option_Ok;
+      elsif Opt = "--mcode" then
+         Compile_Kind := Compile_Mcode;
+         Res := Option_Ok;
+      elsif Opt = "--llvm" then
+         Compile_Kind := Compile_Llvm;
+         Res := Option_Ok;
+      elsif Opt = "-o" then
+         if Arg'Length = 0 then
+            Res := Option_Arg_Req;
+         else
+            Output_File := new String'(Arg);
+            Res := Option_Arg;
+         end if;
+      elsif Opt = "-m32" then
+         Add_Argument (Compiler_Args, new String'("-m32"));
+         Add_Argument (Assembler_Args, new String'("--32"));
+         Add_Argument (Linker_Args, new String'("-m32"));
+         Decode_Option (Command_Lib (Cmd), Opt, Arg, Res);
+      elsif Opt'Length > 4
+        and then Opt (2) = 'W' and then Opt (4) = ','
+      then
+         if Opt (3) = 'c' then
+            Add_Arguments (Compiler_Args, Opt);
+         elsif Opt (3) = 'a' then
+            Add_Arguments (Assembler_Args, Opt);
+         elsif Opt (3) = 'p' then
+            Add_Arguments (Postproc_Args, Opt);
+         elsif Opt (3) = 'l' then
+            Add_Arguments (Linker_Args, Opt);
+         else
+            Error ("unknown tool name in '-W" & Opt (3) & ",' option");
+            raise Option_Error;
+         end if;
+         Res := Option_Ok;
+      elsif Opt'Length >= 2 and then Opt (2) = 'g' then
+         --  Debugging option.
+         Str := new String'(Opt);
+         Add_Argument (Compiler_Args, Str);
+         Add_Argument (Linker_Args, Str);
+         Res := Option_Ok;
+      elsif Opt = "-Q" then
+         Flag_Not_Quiet := True;
+         Res := Option_Ok;
+      elsif Opt = "--expect-failure" then
+         Add_Argument (Compiler_Args, new String'(Opt));
+         Flag_Expect_Failure := True;
+         Res := Option_Ok;
+      elsif Opt = "-C" then
+         --  Translate -C into --mb-comments, as gcc already has a definition
+         --  for -C.  Done before Flags.Parse_Option.
+         Add_Argument (Compiler_Args, new String'("--mb-comments"));
+         Res := Option_Ok;
+      elsif Options.Parse_Option (Opt) then
+         Add_Argument (Compiler_Args, new String'(Opt));
+         Res := Option_Ok;
+      elsif Opt'Length >= 2
+        and then (Opt (2) = 'O' or Opt (2) = 'f')
+      then
+         --  Optimization option.
+         --  This is put after Flags.Parse_Option, since it may catch -fxxx
+         --  options.
+         Add_Argument (Compiler_Args, new String'(Opt));
+         Res := Option_Ok;
+      else
+         Decode_Option (Command_Lib (Cmd), Opt, Arg, Res);
+      end if;
+   end Decode_Option;
+
+   procedure Disp_Long_Help (Cmd : Command_Comp) is
+   begin
+      Disp_Long_Help (Command_Lib (Cmd));
+      Put_Line (" -v             Be verbose");
+      Put_Line (" --GHDL1=PATH   Set the path of the ghdl1 compiler");
+      Put_Line (" -S             Do not assemble");
+      Put_Line (" -o FILE        Set the name of the output file");
+   -- Put_Line (" -m32           Generate 32bit code on 64bit machines");
+      Put_Line (" -WX,OPTION     Pass OPTION to X, where X is one of");
+      Put_Line ("                 c: compiler, a: assembler, l: linker");
+      Put_Line (" -g[XX]         Pass debugging option to the compiler");
+      Put_Line (" -O[XX]/-f[XX]  Pass optimization option to the compiler");
+      Put_Line (" -Q             Do not add -quiet option to compiler");
+      Put_Line (" --expect-failure  Expect analysis/elaboration failure");
+   end Disp_Long_Help;
+
+   --  Command dispconfig.
+   type Command_Dispconfig is new Command_Comp with null record;
+   function Decode_Command (Cmd : Command_Dispconfig; Name : String)
+                           return Boolean;
+   function Get_Short_Help (Cmd : Command_Dispconfig) return String;
+   procedure Perform_Action (Cmd : in out Command_Dispconfig;
+                             Args : Argument_List);
+
+   function Decode_Command (Cmd : Command_Dispconfig; Name : String)
+                           return Boolean
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return Name = "--dispconfig" or else Name = "--disp-config";
+   end Decode_Command;
+
+   function Get_Short_Help (Cmd : Command_Dispconfig) return String
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return "--disp-config      Disp tools path";
+   end Get_Short_Help;
+
+   procedure Perform_Action (Cmd : in out Command_Dispconfig;
+                             Args : Argument_List)
+   is
+      use Libraries;
+      pragma Unreferenced (Cmd);
+   begin
+      if Args'Length /= 0 then
+         Error ("--dispconfig does not accept any argument");
+         raise Option_Error;
+      end if;
+
+      Set_Tools_Name;
+      Put_Line ("Pathes at configuration:");
+      Put ("compiler command: ");
+      Put_Line (Compiler_Cmd.all);
+      if Compile_Kind >= Compile_Debug then
+         Put ("post-processor command: ");
+         Put_Line (Post_Processor_Cmd.all);
+      end if;
+      if Compile_Kind >= Compile_Gcc then
+         Put ("assembler command: ");
+         Put_Line (Assembler_Cmd);
+      end if;
+      Put ("linker command: ");
+      Put_Line (Linker_Cmd);
+      Put_Line ("default lib prefix: " & Default_Pathes.Lib_Prefix);
+
+      New_Line;
+
+      Put ("command line prefix (--PREFIX): ");
+      if Switch_Prefix_Path = null then
+         Put_Line ("(not set)");
+      else
+         Put_Line (Switch_Prefix_Path.all);
+      end if;
+
+      Put ("environment prefix (GHDL_PREFIX): ");
+      if Prefix_Env = null then
+         Put_Line ("(not set)");
+      else
+         Put_Line (Prefix_Env.all);
+      end if;
+
+      Setup_Libraries (False);
+
+      Put ("exec prefix (from program name): ");
+      if Exec_Prefix = null then
+         Put_Line ("(not found)");
+      else
+         Put_Line (Exec_Prefix.all);
+      end if;
+
+      New_Line;
+
+      Put_Line ("library prefix: " & Lib_Prefix_Path.all);
+      Put ("library directory: ");
+      Put_Line (Get_Machine_Path_Prefix);
+      Locate_Tools;
+      Put ("compiler path: ");
+      Put_Line (Compiler_Path.all);
+      if Compile_Kind >= Compile_Debug then
+         Put ("post-processor path: ");
+         Put_Line (Post_Processor_Path.all);
+      end if;
+      if Compile_Kind >= Compile_Gcc then
+         Put ("assembler path: ");
+         Put_Line (Assembler_Path.all);
+      end if;
+      Put ("linker path: ");
+      Put_Line (Linker_Path.all);
+
+      New_Line;
+
+      Put_Line ("default library pathes:");
+      for I in 2 .. Get_Nbr_Pathes loop
+         Put (' ');
+         Put_Line (Image (Get_Path (I)));
+      end loop;
+   end Perform_Action;
+
+   --  Command Analyze.
+   type Command_Analyze is new Command_Comp with null record;
+   function Decode_Command (Cmd : Command_Analyze; Name : String)
+                           return Boolean;
+   function Get_Short_Help (Cmd : Command_Analyze) return String;
+   procedure Perform_Action (Cmd : in out Command_Analyze;
+                             Args : Argument_List);
+
+   function Decode_Command (Cmd : Command_Analyze; Name : String)
+                           return Boolean
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return Name = "-a";
+   end Decode_Command;
+
+   function Get_Short_Help (Cmd : Command_Analyze) return String
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return "-a [OPTS] FILEs    Analyze FILEs";
+   end Get_Short_Help;
+
+   procedure Perform_Action (Cmd : in out Command_Analyze;
+                             Args : Argument_List)
+   is
+      pragma Unreferenced (Cmd);
+      Nil_Opt : Argument_List (2 .. 1);
+   begin
+      if Args'Length = 0 then
+         Error ("no file to analyze");
+         raise Option_Error;
+      end if;
+      Setup_Compiler (False);
+
+      for I in Args'Range loop
+         Do_Compile (Nil_Opt, Args (I).all);
+      end loop;
+   end Perform_Action;
+
+   --  Elaboration.
+
+   Base_Name : String_Access;
+   Elab_Name : String_Access;
+   Filelist_Name : String_Access;
+   Unit_Name : String_Access;
+
+   procedure Set_Elab_Units (Cmd_Name : String;
+                             Args : Argument_List;
+                             Run_Arg : out Natural)
+   is
+   begin
+      Extract_Elab_Unit (Cmd_Name, Args, Run_Arg);
+      if Sec_Name = null then
+         Base_Name := Prim_Name;
+         Unit_Name := Prim_Name;
+      else
+         Base_Name := new String'(Prim_Name.all & '-' & Sec_Name.all);
+         Unit_Name := new String'(Prim_Name.all & '(' & Sec_Name.all & ')');
+      end if;
+
+      Elab_Name := new String'(Elab_Prefix & Base_Name.all);
+      Filelist_Name := null;
+
+      if Output_File = null then
+         Output_File := new String'(Base_Name.all);
+      end if;
+   end Set_Elab_Units;
+
+   procedure Set_Elab_Units (Cmd_Name : String; Args : Argument_List)
+   is
+      Next_Arg : Natural;
+   begin
+      Set_Elab_Units (Cmd_Name, Args, Next_Arg);
+      if Next_Arg <= Args'Last then
+         Error ("too many unit names for command '" & Cmd_Name & "'");
+         raise Option_Error;
+      end if;
+   end Set_Elab_Units;
+
+   procedure Bind
+   is
+      Comp_List : Argument_List (1 .. 4);
+   begin
+      Filelist_Name := new String'(Elab_Name.all & List_Suffix);
+
+      Comp_List (1) := new String'("--elab");
+      Comp_List (2) := Unit_Name;
+      Comp_List (3) := new String'("-l");
+      Comp_List (4) := Filelist_Name;
+      Do_Compile (Comp_List, Elab_Name.all);
+      Free (Comp_List (3));
+      Free (Comp_List (1));
+   end Bind;
+
+   procedure Bind_Anaelab (Files : Argument_List)
+   is
+      Comp_List : Argument_List (1 .. Files'Length + 2);
+      Index : Natural;
+   begin
+      Comp_List (1) := new String'("--anaelab");
+      Comp_List (2) := Unit_Name;
+      Index := 3;
+      for I in Files'Range loop
+         Comp_List (Index) := new String'("--ghdl-source=" & Files (I).all);
+         Index := Index + 1;
+      end loop;
+      Do_Compile (Comp_List, Elab_Name.all);
+      Free (Comp_List (1));
+      for I in 3 .. Comp_List'Last loop
+         Free (Comp_List (I));
+      end loop;
+   end Bind_Anaelab;
+
+   procedure Link (Add_Std : Boolean;
+                   Disp_Only : Boolean)
+   is
+      Last_File : Natural;
+   begin
+      Link_Obj_Suffix := Get_Object_Suffix;
+
+      --  read files list
+      if Filelist_Name /= null then
+         Add_File_List (Filelist_Name.all, True);
+      end if;
+      Last_File := Filelist.Last;
+      Add_File_List (Get_Machine_Path_Prefix & "grt" & List_Suffix, False);
+
+      --  call the linker
+      declare
+         P : Natural;
+         Nbr_Args : constant Natural := Last (Linker_Args) + Filelist.Last + 4;
+         Args : Argument_List (1 .. Nbr_Args);
+         Obj_File : String_Access;
+         Std_File : String_Access;
+      begin
+         Obj_File := Append_Suffix (Elab_Name.all, Link_Obj_Suffix.all);
+         P := 0;
+         Args (P + 1) := Dash_o;
+         Args (P + 2) := Output_File;
+         Args (P + 3) := Obj_File;
+         P := P + 3;
+         if Add_Std then
+            Std_File := new
+              String'(Get_Machine_Path_Prefix
+                      & Get_Version_Path & Directory_Separator
+                      & "std" & Directory_Separator
+                      & "std_standard" & Link_Obj_Suffix.all);
+            P := P + 1;
+            Args (P) := Std_File;
+         else
+            Std_File := null;
+         end if;
+
+         --  Object files of the design.
+         for I in Filelist.First .. Last_File loop
+            P := P + 1;
+            Args (P) := Filelist.Table (I);
+         end loop;
+         --  User added options.
+         for I in First .. Last (Linker_Args) loop
+            P := P + 1;
+            Args (P) := Linker_Args.Table (I);
+         end loop;
+         --  GRT files (should be the last one, since it contains an
+         --  optional main).
+         for I in Last_File + 1 .. Filelist.Last loop
+            P := P + 1;
+            Args (P) := Filelist.Table (I);
+         end loop;
+
+         if Disp_Only then
+            for I in 3 .. P loop
+               Put_Line (Args (I).all);
+            end loop;
+         else
+            My_Spawn (Linker_Path.all, Args (1 .. P));
+         end if;
+
+         Free (Obj_File);
+         Free (Std_File);
+      end;
+
+      for I in Filelist.First .. Filelist.Last loop
+         Free (Filelist.Table (I));
+      end loop;
+   end Link;
+
+   --  Command Elab.
+   type Command_Elab is new Command_Comp with null record;
+   function Decode_Command (Cmd : Command_Elab; Name : String)
+                           return Boolean;
+   function Get_Short_Help (Cmd : Command_Elab) return String;
+   procedure Perform_Action (Cmd : in out Command_Elab;
+                             Args : Argument_List);
+
+   function Decode_Command (Cmd : Command_Elab; Name : String)
+                           return Boolean
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return Name = "-e";
+   end Decode_Command;
+
+   function Get_Short_Help (Cmd : Command_Elab) return String
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return "-e [OPTS] UNIT [ARCH]      Elaborate UNIT";
+   end Get_Short_Help;
+
+   procedure Perform_Action (Cmd : in out Command_Elab; Args : Argument_List)
+   is
+      pragma Unreferenced (Cmd);
+      Success : Boolean;
+      pragma Unreferenced (Success);
+   begin
+      Set_Elab_Units ("-e", Args);
+      Setup_Compiler (False);
+
+      Bind;
+      if not Flag_Expect_Failure then
+         Link (Add_Std => True, Disp_Only => False);
+      end if;
+      Delete_File (Filelist_Name.all, Success);
+   end Perform_Action;
+
+   --  Command Run.
+   type Command_Run is new Command_Comp with null record;
+   function Decode_Command (Cmd : Command_Run; Name : String)
+                           return Boolean;
+   function Get_Short_Help (Cmd : Command_Run) return String;
+   procedure Perform_Action (Cmd : in out Command_Run;
+                             Args : Argument_List);
+
+   function Decode_Command (Cmd : Command_Run; Name : String)
+                           return Boolean
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return Name = "-r";
+   end Decode_Command;
+
+   function Get_Short_Help (Cmd : Command_Run) return String
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return "-r UNIT [ARCH] [OPTS]      Run UNIT";
+   end Get_Short_Help;
+
+   procedure Perform_Action (Cmd : in out Command_Run; Args : Argument_List)
+   is
+      pragma Unreferenced (Cmd);
+      Opt_Arg : Natural;
+   begin
+      Extract_Elab_Unit ("-r", Args, Opt_Arg);
+      if Sec_Name = null then
+         Base_Name := Prim_Name;
+      else
+         Base_Name := new String'(Prim_Name.all & '-' & Sec_Name.all);
+      end if;
+      if not Is_Regular_File (Base_Name.all & Nul) then
+         Error ("file '" & Base_Name.all & "' does not exists");
+         Error ("Please elaborate your design.");
+         raise Exec_Error;
+      end if;
+      My_Spawn ('.' & Directory_Separator & Base_Name.all,
+                Args (Opt_Arg .. Args'Last));
+   end Perform_Action;
+
+   --  Command Elab_Run.
+   type Command_Elab_Run is new Command_Comp with null record;
+   function Decode_Command (Cmd : Command_Elab_Run; Name : String)
+                           return Boolean;
+   function Get_Short_Help (Cmd : Command_Elab_Run) return String;
+   procedure Perform_Action (Cmd : in out Command_Elab_Run;
+                             Args : Argument_List);
+
+   function Decode_Command (Cmd : Command_Elab_Run; Name : String)
+                           return Boolean
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return Name = "--elab-run";
+   end Decode_Command;
+
+   function Get_Short_Help (Cmd : Command_Elab_Run) return String
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return "--elab-run [OPTS] UNIT [ARCH] [OPTS]  Elaborate and run UNIT";
+   end Get_Short_Help;
+
+   procedure Perform_Action (Cmd : in out Command_Elab_Run;
+                             Args : Argument_List)
+   is
+      pragma Unreferenced (Cmd);
+      Success : Boolean;
+      Run_Arg : Natural;
+   begin
+      Set_Elab_Units ("-elab-run", Args, Run_Arg);
+      Setup_Compiler (False);
+
+      Bind;
+      if Flag_Expect_Failure then
+         Delete_File (Filelist_Name.all, Success);
+      else
+         Link (Add_Std => True, Disp_Only => False);
+         Delete_File (Filelist_Name.all, Success);
+         My_Spawn ('.' & Directory_Separator & Output_File.all,
+                   Args (Run_Arg .. Args'Last));
+      end if;
+   end Perform_Action;
+
+   --  Command Bind.
+   type Command_Bind is new Command_Comp with null record;
+   function Decode_Command (Cmd : Command_Bind; Name : String)
+                           return Boolean;
+   function Get_Short_Help (Cmd : Command_Bind) return String;
+   procedure Perform_Action (Cmd : in out Command_Bind;
+                             Args : Argument_List);
+
+   function Decode_Command (Cmd : Command_Bind; Name : String)
+                           return Boolean
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return Name = "--bind";
+   end Decode_Command;
+
+   function Get_Short_Help (Cmd : Command_Bind) return String
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return "--bind [OPTS] UNIT [ARCH]  Bind UNIT";
+   end Get_Short_Help;
+
+   procedure Perform_Action (Cmd : in out Command_Bind; Args : Argument_List)
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      Set_Elab_Units ("--bind", Args);
+      Setup_Compiler (False);
+
+      Bind;
+   end Perform_Action;
+
+   --  Command Link.
+   type Command_Link is new Command_Comp with null record;
+   function Decode_Command (Cmd : Command_Link; Name : String)
+                           return Boolean;
+   function Get_Short_Help (Cmd : Command_Link) return String;
+   procedure Perform_Action (Cmd : in out Command_Link; Args : Argument_List);
+
+   function Decode_Command (Cmd : Command_Link; Name : String)
+                           return Boolean
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return Name = "--link";
+   end Decode_Command;
+
+   function Get_Short_Help (Cmd : Command_Link) return String
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return "--link [OPTS] UNIT [ARCH]  Link UNIT";
+   end Get_Short_Help;
+
+   procedure Perform_Action (Cmd : in out Command_Link; Args : Argument_List)
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      Set_Elab_Units ("--link", Args);
+      Setup_Compiler (False);
+
+      Filelist_Name := new String'(Elab_Name.all & List_Suffix);
+      Link (Add_Std => True, Disp_Only => False);
+   end Perform_Action;
+
+
+   --  Command List_Link.
+   type Command_List_Link is new Command_Comp with null record;
+   function Decode_Command (Cmd : Command_List_Link; Name : String)
+                           return Boolean;
+   function Get_Short_Help (Cmd : Command_List_Link) return String;
+   procedure Perform_Action (Cmd : in out Command_List_Link;
+                             Args : Argument_List);
+
+   function Decode_Command (Cmd : Command_List_Link; Name : String)
+                           return Boolean
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return Name = "--list-link";
+   end Decode_Command;
+
+   function Get_Short_Help (Cmd : Command_List_Link) return String
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return "--list-link [OPTS] UNIT [ARCH]  List objects file to link UNIT";
+   end Get_Short_Help;
+
+   procedure Perform_Action (Cmd : in out Command_List_Link;
+                             Args : Argument_List)
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      Set_Elab_Units ("--list-link", Args);
+      Setup_Compiler (False);
+
+      Filelist_Name := new String'(Elab_Name.all & List_Suffix);
+      Link (Add_Std => True, Disp_Only => True);
+   end Perform_Action;
+
+
+   --  Command analyze and elaborate
+   type Command_Anaelab is new Command_Comp with null record;
+   function Decode_Command (Cmd : Command_Anaelab; Name : String)
+                           return Boolean;
+   function Get_Short_Help (Cmd : Command_Anaelab) return String;
+   procedure Decode_Option (Cmd : in out Command_Anaelab;
+                            Option : String;
+                            Arg : String;
+                            Res : out Option_Res);
+
+   procedure Perform_Action (Cmd : in out Command_Anaelab;
+                             Args : Argument_List);
+
+   function Decode_Command (Cmd : Command_Anaelab; Name : String)
+                           return Boolean
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return Name = "-c";
+   end Decode_Command;
+
+   function Get_Short_Help (Cmd : Command_Anaelab) return String
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return "-c [OPTS] FILEs -e UNIT [ARCH]  "
+        & "Generate whole code to elab UNIT from FILEs";
+   end Get_Short_Help;
+
+   procedure Decode_Option (Cmd : in out Command_Anaelab;
+                            Option : String;
+                            Arg : String;
+                            Res : out Option_Res)
+   is
+   begin
+      if Option = "-e" then
+         Res := Option_End;
+         return;
+      else
+         Decode_Option (Command_Comp (Cmd), Option, Arg, Res);
+      end if;
+   end Decode_Option;
+
+   procedure Perform_Action (Cmd : in out Command_Anaelab;
+                             Args : Argument_List)
+   is
+      pragma Unreferenced (Cmd);
+      Elab_Index : Integer;
+   begin
+      Elab_Index := -1;
+      for I in Args'Range loop
+         if Args (I).all = "-e" then
+            Elab_Index := I;
+            exit;
+         end if;
+      end loop;
+      if Elab_Index < 0 then
+         Analyze_Files (Args, True);
+      else
+         Flags.Flag_Whole_Analyze := True;
+         Set_Elab_Units ("-c", Args (Elab_Index + 1 .. Args'Last));
+         Setup_Compiler (False);
+
+         Bind_Anaelab (Args (Args'First .. Elab_Index - 1));
+         Link (Add_Std => False, Disp_Only => False);
+      end if;
+   end Perform_Action;
+
+   --  Command Make.
+   type Command_Make is new Command_Comp with record
+      --  Disp dependences during make.
+      Flag_Depend_Unit : Boolean;
+
+      --  Force recompilation of units in work library.
+      Flag_Force : Boolean;
+   end record;
+
+   function Decode_Command (Cmd : Command_Make; Name : String)
+                           return Boolean;
+   procedure Init (Cmd : in out Command_Make);
+   procedure Decode_Option (Cmd : in out Command_Make;
+                            Option : String;
+                            Arg : String;
+                            Res : out Option_Res);
+
+   function Get_Short_Help (Cmd : Command_Make) return String;
+   procedure Disp_Long_Help (Cmd : Command_Make);
+
+   procedure Perform_Action (Cmd : in out Command_Make;
+                             Args : Argument_List);
+
+   function Decode_Command (Cmd : Command_Make; Name : String)
+                           return Boolean
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return Name = "-m";
+   end Decode_Command;
+
+   function Get_Short_Help (Cmd : Command_Make) return String
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return "-m [OPTS] UNIT [ARCH]  Make UNIT";
+   end Get_Short_Help;
+
+   procedure Disp_Long_Help (Cmd : Command_Make)
+   is
+   begin
+      Disp_Long_Help (Command_Comp (Cmd));
+      Put_Line (" -f             Force recompilation of work units");
+      Put_Line (" -Mu            Disp unit dependences (human format)");
+   end Disp_Long_Help;
+
+   procedure Init (Cmd : in out Command_Make) is
+   begin
+      Init (Command_Comp (Cmd));
+      Cmd.Flag_Depend_Unit := False;
+      Cmd.Flag_Force := False;
+   end Init;
+
+   procedure Decode_Option (Cmd : in out Command_Make;
+                            Option : String;
+                            Arg : String;
+                            Res : out Option_Res) is
+   begin
+      if Option = "-Mu" then
+         Cmd.Flag_Depend_Unit := True;
+         Res := Option_Ok;
+      elsif Option = "-f" then
+         Cmd.Flag_Force := True;
+         Res := Option_Ok;
+      else
+         Decode_Option (Command_Comp (Cmd), Option, Arg, Res);
+      end if;
+   end Decode_Option;
+
+   procedure Perform_Action (Cmd : in out Command_Make; Args : Argument_List)
+   is
+      use Configuration;
+
+      File : Iir_Design_File;
+      Unit : Iir;
+      Lib_Unit : Iir;
+      Lib : Iir_Library_Declaration;
+      In_Work : Boolean;
+
+      Files_List : Iir_List;
+
+      --  Set when a design file has been compiled.
+      Has_Compiled : Boolean;
+
+      Need_Analyze : Boolean;
+
+      Need_Elaboration : Boolean;
+
+      Stamp : Time_Stamp_Id;
+      File_Id : Name_Id;
+
+      Nil_Args : Argument_List (2 .. 1);
+      Success : Boolean;
+   begin
+      Set_Elab_Units ("-m", Args);
+      Setup_Compiler (True);
+
+      --  Create list of files.
+      Files_List := Build_Dependence (Prim_Name, Sec_Name);
+
+      if Cmd.Flag_Depend_Unit then
+         Put_Line ("Units analysis order:");
+         for I in Design_Units.First .. Design_Units.Last loop
+            Unit := Design_Units.Table (I);
+            Put ("  ");
+            Disp_Library_Unit (Get_Library_Unit (Unit));
+            New_Line;
+--             Put (" file: ");
+--             File := Get_Design_File (Unit);
+--             Image (Get_Design_File_Filename (File));
+--             Put_Line (Name_Buffer (1 .. Name_Length));
+         end loop;
+      end if;
+      if Cmd.Flag_Depend_Unit then
+         Put_Line ("File analysis order:");
+         for I in Natural loop
+            File := Get_Nth_Element (Files_List, I);
+            exit when File = Null_Iir;
+            Image (Get_Design_File_Filename (File));
+            Put ("  ");
+            Put (Name_Buffer (1 .. Name_Length));
+            if Flag_Verbose then
+               Put_Line (":");
+               declare
+                  Dep_List : Iir_List;
+                  Dep_File : Iir;
+               begin
+                  Dep_List := Get_File_Dependence_List (File);
+                  if Dep_List /= Null_Iir_List then
+                     for J in Natural loop
+                        Dep_File := Get_Nth_Element (Dep_List, J);
+                        exit when Dep_File = Null_Iir;
+                        Image (Get_Design_File_Filename (Dep_File));
+                        Put ("    ");
+                        Put_Line (Name_Buffer (1 .. Name_Length));
+                     end loop;
+                  end if;
+               end;
+            else
+               New_Line;
+            end if;
+         end loop;
+      end if;
+
+      Has_Compiled := False;
+      Last_Stamp := Null_Time_Stamp;
+
+      for I in Natural loop
+         File := Get_Nth_Element (Files_List, I);
+         exit when File = Null_Iir;
+
+         Need_Analyze := False;
+         if Is_File_Outdated (File) then
+            Need_Analyze := True;
+         else
+            Unit := Get_First_Design_Unit (File);
+            while Unit /= Null_Iir loop
+               Lib_Unit := Get_Library_Unit (Unit);
+               if not (Get_Kind (Lib_Unit) = Iir_Kind_Configuration_Declaration
+                       and then Get_Identifier (Lib_Unit) = Null_Identifier)
+               then
+                  if Is_Unit_Outdated (Unit) then
+                     Need_Analyze := True;
+                     exit;
+                  end if;
+               end if;
+               Unit := Get_Chain (Unit);
+            end loop;
+         end if;
+
+         Lib := Get_Library (File);
+         In_Work := Lib = Libraries.Work_Library;
+
+         if Need_Analyze or else (Cmd.Flag_Force and In_Work) then
+            File_Id := Get_Design_File_Filename (File);
+            if not Flag_Verbose then
+               Put ("analyze ");
+               Put (Image (File_Id));
+               --Disp_Library_Unit (Get_Library_Unit (Unit));
+               New_Line;
+            end if;
+
+            if In_Work then
+               Do_Compile (Nil_Args, Image (File_Id));
+            else
+               declare
+                  use Libraries;
+                  Lib_Args : Argument_List (1 .. 2);
+                  Prev_Workdir : Name_Id;
+               begin
+                  Prev_Workdir := Work_Directory;
+
+                  --  Must be set, since used to build the object filename.
+                  Work_Directory := Get_Library_Directory (Lib);
+
+                  --  Always overwrite --work and --workdir.
+                  Lib_Args (1) := new String'
+                    ("--work=" & Image (Get_Identifier (Lib)));
+                  if Work_Directory = Libraries.Local_Directory then
+                     Lib_Args (2) := new String'("--workdir=.");
+                  else
+                     Lib_Args (2) := new String'
+                       ("--workdir=" & Image (Work_Directory));
+                  end if;
+                  Do_Compile (Lib_Args, Image (File_Id));
+
+                  Work_Directory := Prev_Workdir;
+
+                  Free (Lib_Args (1));
+                  Free (Lib_Args (2));
+               end;
+            end if;
+
+            Has_Compiled := True;
+            --  Set the analysis time stamp since the file has just been
+            --  analyzed.
+            Set_Analysis_Time_Stamp (File, Files_Map.Get_Os_Time_Stamp);
+         end if;
+      end loop;
+
+      Need_Elaboration := False;
+      --  Elaboration.
+      --  if libgrt is more recent than the executable (FIXME).
+      if Has_Compiled then
+         if Flag_Verbose then
+            Put_Line ("link due to a file compilation");
+         end if;
+         Need_Elaboration := True;
+      else
+         declare
+            Exec_File : String := Output_File.all & Nul;
+         begin
+            Stamp := Files_Map.Get_File_Time_Stamp (Exec_File'Address);
+         end;
+
+         if Stamp = Null_Time_Stamp then
+            if Flag_Verbose then
+               Put_Line ("link due to no binary file");
+            end if;
+            Need_Elaboration := True;
+         else
+            if Files_Map.Is_Gt (Last_Stamp, Stamp) then
+               --  if a file is more recent than the executable.
+               if Flag_Verbose then
+                  Put ("link due to outdated binary file: ");
+                  Put (Image (Get_Design_File_Filename (Last_Stamp_File)));
+                  Put (" (");
+                  Put (Files_Map.Get_Time_Stamp_String (Last_Stamp));
+                  Put (" > ");
+                  Put (Files_Map.Get_Time_Stamp_String (Stamp));
+                  Put (")");
+                  New_Line;
+               end if;
+               Need_Elaboration := True;
+            end if;
+         end if;
+      end if;
+      if Need_Elaboration then
+         if not Flag_Verbose then
+            Put ("elaborate ");
+            Put (Prim_Name.all);
+            --Disp_Library_Unit (Get_Library_Unit (Unit));
+            New_Line;
+         end if;
+         Bind;
+         Link (Add_Std => True, Disp_Only => False);
+         Delete_File (Filelist_Name.all, Success);
+      end if;
+   exception
+      when Errorout.Compilation_Error =>
+         if Flag_Expect_Failure then
+            return;
+         else
+            raise;
+         end if;
+   end Perform_Action;
+
+   --  Command Gen_Makefile.
+   type Command_Gen_Makefile is new Command_Comp with null record;
+   function Decode_Command (Cmd : Command_Gen_Makefile; Name : String)
+                           return Boolean;
+   function Get_Short_Help (Cmd : Command_Gen_Makefile) return String;
+   procedure Perform_Action (Cmd : in out Command_Gen_Makefile;
+                             Args : Argument_List);
+
+   function Decode_Command (Cmd : Command_Gen_Makefile; Name : String)
+                           return Boolean
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return Name = "--gen-makefile";
+   end Decode_Command;
+
+   function Get_Short_Help (Cmd : Command_Gen_Makefile) return String
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return "--gen-makefile [OPTS] UNIT [ARCH]  Generate a Makefile for UNIT";
+   end Get_Short_Help;
+
+   function Is_Makeable_File (File : Iir_Design_File) return Boolean is
+   begin
+      if File = Std_Package.Std_Standard_File then
+         return False;
+      end if;
+      return True;
+   end Is_Makeable_File;
+
+   procedure Perform_Action (Cmd : in out Command_Gen_Makefile;
+                             Args : Argument_List)
+   is
+      pragma Unreferenced (Cmd);
+
+      HT : constant Character := Ada.Characters.Latin_1.HT;
+      Files_List : Iir_List;
+      File : Iir_Design_File;
+
+      Lib : Iir_Library_Declaration;
+      Dir_Id : Name_Id;
+
+      Dep_List : Iir_List;
+      Dep_File : Iir;
+   begin
+      Set_Elab_Units ("--gen-makefile", Args);
+      Setup_Libraries (True);
+      Files_List := Build_Dependence (Prim_Name, Sec_Name);
+
+      Put_Line ("# Makefile automatically generated by ghdl");
+      Put ("# Version: ");
+      Put (Version.Ghdl_Release);
+      Put (" - ");
+      if Version_String /= null then
+         Put (Version_String.all);
+      end if;
+      New_Line;
+      Put_Line ("# Command used to generate this makefile:");
+      Put ("# ");
+      Put (Command_Name);
+      for I in 1 .. Argument_Count loop
+         Put (' ');
+         Put (Argument (I));
+      end loop;
+      New_Line;
+
+      New_Line;
+
+      Put ("GHDL=");
+      Put_Line (Command_Name);
+
+      --  Extract options for command line.
+      Put ("GHDLFLAGS=");
+      for I in 2 .. Argument_Count loop
+         declare
+            Arg : constant String := Argument (I);
+         begin
+            if Arg (1) = '-' then
+               if (Arg'Length > 10 and then Arg (1 .. 10) = "--workdir=")
+                 or else (Arg'Length > 7 and then Arg (1 .. 7) = "--ieee=")
+                 or else (Arg'Length > 6 and then Arg (1 .. 6) = "--std=")
+                 or else (Arg'Length > 7 and then Arg (1 .. 7) = "--work=")
+                 or else (Arg'Length > 2 and then Arg (1 .. 2) = "-P")
+               then
+                  Put (" ");
+                  Put (Arg);
+               end if;
+            end if;
+         end;
+      end loop;
+      New_Line;
+
+      New_Line;
+
+      Put_Line ("# Default target");
+      Put ("all: ");
+      Put_Line (Base_Name.all);
+      New_Line;
+
+      Put_Line ("# Elaboration target");
+      Put (Base_Name.all);
+      Put (":");
+      for I in Natural loop
+         File := Get_Nth_Element (Files_List, I);
+         exit when File = Null_Iir;
+         if Is_Makeable_File (File) then
+            Put (" ");
+            Put (Get_Object_Filename (File));
+         end if;
+      end loop;
+      New_Line;
+      Put_Line (HT & "$(GHDL) -e $(GHDLFLAGS) $@");
+      New_Line;
+
+      Put_Line ("# Run target");
+      Put_Line ("run: " & Base_Name.all);
+      Put_Line (HT & "$(GHDL) -r " & Base_Name.all & " $(GHDLRUNFLAGS)");
+      New_Line;
+
+      Put_Line ("# Targets to analyze files");
+      for I in Natural loop
+         File := Get_Nth_Element (Files_List, I);
+         exit when File = Null_Iir;
+         Dir_Id := Get_Design_File_Directory (File);
+         if not Is_Makeable_File (File) then
+            --  Builtin file.
+            null;
+         else
+            Put (Get_Object_Filename (File));
+            Put (": ");
+            if Dir_Id /= Files_Map.Get_Home_Directory then
+               Put (Image (Dir_Id));
+               Put (Image (Get_Design_File_Filename (File)));
+               New_Line;
+
+               Put_Line
+                 (HT & "@echo ""This file was not locally built ($<)""");
+               Put_Line (HT & "exit 1");
+            else
+               Put (Image (Get_Design_File_Filename (File)));
+               New_Line;
+
+               Put (HT & "$(GHDL) -a $(GHDLFLAGS)");
+               Lib := Get_Library (File);
+               if Lib /= Libraries.Work_Library then
+                  --  Overwrite some options.
+                  Put (" --work=");
+                  Put (Image (Get_Identifier (Lib)));
+                  Dir_Id := Get_Library_Directory (Lib);
+                  Put (" --workdir=");
+                  if Dir_Id = Libraries.Local_Directory then
+                     Put (".");
+                  else
+                     Put (Image (Dir_Id));
+                  end if;
+               end if;
+               Put_Line (" $<");
+            end if;
+         end if;
+      end loop;
+      New_Line;
+
+      Put_Line ("# Files dependences");
+      for I in Natural loop
+         File := Get_Nth_Element (Files_List, I);
+         exit when File = Null_Iir;
+         if Is_Makeable_File (File) then
+            Put (Get_Object_Filename (File));
+            Put (": ");
+            Dep_List := Get_File_Dependence_List (File);
+            if Dep_List /= Null_Iir_List then
+               for J in Natural loop
+                  Dep_File := Get_Nth_Element (Dep_List, J);
+                  exit when Dep_File = Null_Iir;
+                  if Dep_File /= File and then Is_Makeable_File (Dep_File)
+                  then
+                     Put (" ");
+                     Put (Get_Object_Filename (Dep_File));
+                  end if;
+                  end loop;
+            end if;
+            New_Line;
+         end if;
+      end loop;
+   end Perform_Action;
+
+   procedure Register_Commands is
+   begin
+      Register_Command (new Command_Analyze);
+      Register_Command (new Command_Elab);
+      Register_Command (new Command_Run);
+      Register_Command (new Command_Elab_Run);
+      Register_Command (new Command_Bind);
+      Register_Command (new Command_Link);
+      Register_Command (new Command_List_Link);
+      Register_Command (new Command_Anaelab);
+      Register_Command (new Command_Make);
+      Register_Command (new Command_Gen_Makefile);
+      Register_Command (new Command_Dispconfig);
+   end Register_Commands;
+end Ghdldrv;
diff --git a/src/ghdldrv/ghdldrv.ads b/src/ghdldrv/ghdldrv.ads
new file mode 100644
index 000000000..3e37b38f1
--- /dev/null
+++ b/src/ghdldrv/ghdldrv.ads
@@ -0,0 +1,25 @@
+--  GHDL driver - commands invoking gcc.
+--  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 Ghdldrv is
+   --  Compiler to use.
+   type Compile_Kind_Type is
+     (Compile_Mcode, Compile_Llvm, Compile_Gcc, Compile_Debug);
+   Compile_Kind : Compile_Kind_Type := Compile_Gcc;
+
+   procedure Register_Commands;
+end Ghdldrv;
diff --git a/src/ghdldrv/ghdllocal.adb b/src/ghdldrv/ghdllocal.adb
new file mode 100644
index 000000000..a1d94bd77
--- /dev/null
+++ b/src/ghdldrv/ghdllocal.adb
@@ -0,0 +1,1415 @@
+--  GHDL driver - local commands.
+--  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.Text_IO;
+with Ada.Command_Line; use Ada.Command_Line;
+with GNAT.Directory_Operations;
+with Types; use Types;
+with Libraries;
+with Std_Package;
+with Flags;
+with Name_Table;
+with Std_Names;
+with Back_End;
+with Disp_Vhdl;
+with Default_Pathes;
+with Scanner;
+with Sem;
+with Canon;
+with Errorout;
+with Configuration;
+with Files_Map;
+with Post_Sems;
+with Disp_Tree;
+with Options;
+with Iirs_Utils; use Iirs_Utils;
+
+package body Ghdllocal is
+   --  Version of the IEEE library to use.  This just change pathes.
+   type Ieee_Lib_Kind is (Lib_Standard, Lib_None, Lib_Synopsys, Lib_Mentor);
+   Flag_Ieee : Ieee_Lib_Kind;
+
+   Flag_Create_Default_Config : constant Boolean := True;
+
+   --  If TRUE, generate 32bits code on 64bits machines.
+   Flag_32bit : Boolean := False;
+
+   procedure Finish_Compilation
+     (Unit : Iir_Design_Unit; Main : Boolean := False)
+   is
+      use Errorout;
+      use Ada.Text_IO;
+      Config : Iir_Design_Unit;
+      Lib : Iir;
+   begin
+      if (Main or Flags.Dump_All) and then Flags.Dump_Parse then
+         Disp_Tree.Disp_Tree (Unit);
+      end if;
+
+      if Flags.Verbose then
+         Put_Line ("semantize " & Disp_Node (Get_Library_Unit (Unit)));
+      end if;
+
+      Sem.Semantic (Unit);
+
+      if (Main or Flags.Dump_All) and then Flags.Dump_Sem then
+         Disp_Tree.Disp_Tree (Unit);
+      end if;
+
+      if Errorout.Nbr_Errors > 0 then
+         raise Compilation_Error;
+      end if;
+
+      if (Main or Flags.List_All) and then Flags.List_Sem then
+         Disp_Vhdl.Disp_Vhdl (Unit);
+      end if;
+
+      Post_Sems.Post_Sem_Checks (Unit);
+
+      if Errorout.Nbr_Errors > 0 then
+         raise Compilation_Error;
+      end if;
+
+      if Flags.Flag_Elaborate then
+         if Flags.Verbose then
+            Put_Line ("canonicalize " & Disp_Node (Get_Library_Unit (Unit)));
+         end if;
+
+         Canon.Canonicalize (Unit);
+
+         if Flag_Create_Default_Config then
+            Lib := Get_Library_Unit (Unit);
+            if Get_Kind (Lib) = Iir_Kind_Architecture_Body then
+               Config := Canon.Create_Default_Configuration_Declaration (Lib);
+               Set_Default_Configuration_Declaration (Lib, Config);
+            end if;
+         end if;
+      end if;
+   end Finish_Compilation;
+
+   procedure Init (Cmd : in out Command_Lib)
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      Options.Initialize;
+      Flag_Ieee := Lib_Standard;
+      Back_End.Finish_Compilation := Finish_Compilation'Access;
+      Flag_Verbose := False;
+   end Init;
+
+   procedure Decode_Option (Cmd : in out Command_Lib;
+                            Option : String;
+                            Arg : String;
+                            Res : out Option_Res)
+   is
+      pragma Unreferenced (Cmd);
+      pragma Unreferenced (Arg);
+      Opt : constant String (1 .. Option'Length) := Option;
+   begin
+      Res := Option_Bad;
+      if Opt = "-v" and then Flag_Verbose = False then
+         Flag_Verbose := True;
+         Res := Option_Ok;
+      elsif Opt'Length > 9 and then Opt (1 .. 9) = "--PREFIX=" then
+         Switch_Prefix_Path := new String'(Opt (10 .. Opt'Last));
+         Res := Option_Ok;
+      elsif Opt = "--ieee=synopsys" then
+         Flag_Ieee := Lib_Synopsys;
+         Res := Option_Ok;
+      elsif Opt = "--ieee=mentor" then
+         Flag_Ieee := Lib_Mentor;
+         Res := Option_Ok;
+      elsif Opt = "--ieee=none" then
+         Flag_Ieee := Lib_None;
+         Res := Option_Ok;
+      elsif Opt = "--ieee=standard" then
+         Flag_Ieee := Lib_Standard;
+         Res := Option_Ok;
+      elsif Opt = "-m32" then
+         Flag_32bit := True;
+         Res := Option_Ok;
+      elsif Opt'Length >= 2
+        and then (Opt (2) = 'g' or Opt (2) = 'O')
+      then
+         --  Silently accept -g and -O.
+         Res := Option_Ok;
+      else
+         if Options.Parse_Option (Opt) then
+            Res := Option_Ok;
+         end if;
+      end if;
+   end Decode_Option;
+
+   procedure Disp_Long_Help (Cmd : Command_Lib)
+   is
+      pragma Unreferenced (Cmd);
+      use Ada.Text_IO;
+      procedure P (Str : String) renames Put_Line;
+   begin
+      P ("Main options (try --options-help for details):");
+      P (" --std=XX       Use XX as VHDL standard (87,93c,93,00 or 02)");
+      P (" --work=NAME    Set the name of the WORK library");
+      P (" -PDIR          Add DIR in the library search path");
+      P (" --workdir=DIR  Specify the directory of the WORK library");
+      P (" --PREFIX=DIR   Specify installation prefix");
+      P (" --ieee=NAME    Use NAME as ieee library, where name is:");
+      P ("    standard: standard version (default)");
+      P ("    synopsys, mentor: vendor version (not advised)");
+      P ("    none: do not use a predefined ieee library");
+   end Disp_Long_Help;
+
+   function Is_Directory_Separator (C : Character) return Boolean is
+   begin
+      return C = '/' or else C = Directory_Separator;
+   end Is_Directory_Separator;
+
+   function Get_Basename_Pos (Pathname : String) return Natural is
+   begin
+      for I in reverse Pathname'Range loop
+         if Is_Directory_Separator (Pathname (I)) then
+            return I;
+         end if;
+      end loop;
+      return 0;
+   end Get_Basename_Pos;
+
+   procedure Set_Prefix_From_Program_Path (Prog_Path : String)
+   is
+      Dir_Pos : Natural;
+   begin
+      Dir_Pos := Get_Basename_Pos (Prog_Path);
+      if Dir_Pos = 0 then
+         --  No directory in Prog_Path.  This is not expected.
+         return;
+      end if;
+
+      declare
+         Pathname : String :=
+           Normalize_Pathname (Prog_Path (Dir_Pos + 1 .. Prog_Path'Last),
+                               Prog_Path (Prog_Path'First .. Dir_Pos - 1));
+         Pos : Natural;
+      begin
+         --  Stop now in case of error.
+         if Pathname'Length = 0 then
+            return;
+         end if;
+
+         --  Skip executable name
+         Dir_Pos := Get_Basename_Pos (Pathname);
+         if Dir_Pos = 0 then
+            return;
+         end if;
+
+         --  Simplify path:
+         --    /./ => /
+         --    // => /
+         Pos := Dir_Pos - 1;
+         while Pos >= Pathname'First loop
+            if Is_Directory_Separator (Pathname (Pos)) then
+               if Is_Directory_Separator (Pathname (Pos + 1)) then
+                  --  // => /
+                  Pathname (Pos .. Dir_Pos - 1) :=
+                    Pathname (Pos + 1 .. Dir_Pos);
+                  Dir_Pos := Dir_Pos - 1;
+               elsif Pos + 2 <= Dir_Pos
+                 and then Pathname (Pos + 1) = '.'
+                 and then Is_Directory_Separator (Pathname (Pos + 2))
+               then
+                  --  /./ => /
+                  Pathname (Pos .. Dir_Pos - 2) :=
+                    Pathname (Pos + 2 .. Dir_Pos);
+                  Dir_Pos := Dir_Pos - 2;
+               end if;
+            end if;
+            Pos := Pos - 1;
+         end loop;
+
+         --  Simplify path:
+         --    /xxx/../ => /
+         --  This is done after the previous simplication to avoid to deal
+         --  with cases like /xxx//../ or /xxx/./../
+         Pos := Dir_Pos - 3;
+         while Pos >= Pathname'First loop
+            if Is_Directory_Separator (Pathname (Pos))
+              and then Pathname (Pos + 1) = '.'
+              and then Pathname (Pos + 2) = '.'
+              and then Is_Directory_Separator (Pathname (Pos + 3))
+            then
+               declare
+                  Pos2 : constant Natural :=
+                    Get_Basename_Pos (Pathname (Pathname'First .. Pos - 1));
+                  --  /xxxxxxxxxx/../
+                  --  ^          ^
+                  --  Pos2       Pos
+                  Len : Natural;
+               begin
+                  if Pos2 = 0 then
+                     --  Shouldn't happen.
+                     return;
+                  end if;
+                  Len := Pos + 3 - Pos2;
+                  Pathname (Pos2 + 1 .. Dir_Pos - Len) :=
+                    Pathname (Pos + 4 .. Dir_Pos);
+                  Dir_Pos := Dir_Pos - Len;
+                  if Pos2 < Pathname'First + 3 then
+                     exit;
+                  end if;
+                  Pos := Pos2 - 3;
+               end;
+            else
+               Pos := Pos - 1;
+            end if;
+         end loop;
+
+         --  Remove last '/'
+         Dir_Pos := Dir_Pos - 1;
+
+         --  Skip directory.
+         Dir_Pos := Get_Basename_Pos (Pathname (Pathname'First .. Dir_Pos));
+         if Dir_Pos = 0 then
+            return;
+         end if;
+
+         Exec_Prefix := new String'(Pathname (Pathname'First .. Dir_Pos - 1));
+      end;
+   end Set_Prefix_From_Program_Path;
+
+   --  Extract Exec_Prefix from executable name.
+   procedure Set_Exec_Prefix
+   is
+      use GNAT.Directory_Operations;
+      Prog_Path : constant String := Ada.Command_Line.Command_Name;
+      Exec_Path : String_Access;
+   begin
+      --  If the command name is an absolute path, deduce prefix from it.
+      if Is_Absolute_Path (Prog_Path) then
+         Set_Prefix_From_Program_Path (Prog_Path);
+         return;
+      end if;
+
+      --  If the command name is a relative path, deduce prefix from it
+      --  and current path.
+      if Get_Basename_Pos (Prog_Path) /= 0 then
+         if Is_Executable_File (Prog_Path) then
+            Set_Prefix_From_Program_Path
+              (Get_Current_Dir & Directory_Separator & Prog_Path);
+         end if;
+         return;
+      end if;
+
+      --  Look for program name on the path.
+      Exec_Path := Locate_Exec_On_Path (Prog_Path);
+      if Exec_Path /= null then
+         Set_Prefix_From_Program_Path (Exec_Path.all);
+         Free (Exec_Path);
+      end if;
+   end Set_Exec_Prefix;
+
+   function Get_Version_Path return String
+   is
+      use Flags;
+   begin
+      case Vhdl_Std is
+         when Vhdl_87 =>
+            return "v87";
+         when Vhdl_93c
+           | Vhdl_93
+           | Vhdl_00
+           | Vhdl_02 =>
+            return "v93";
+         when Vhdl_08 =>
+            return "v08";
+      end case;
+   end Get_Version_Path;
+
+   function Get_Machine_Path_Prefix return String is
+   begin
+      if Flag_32bit then
+         return Lib_Prefix_Path.all & "32";
+      else
+         return Lib_Prefix_Path.all;
+      end if;
+   end Get_Machine_Path_Prefix;
+
+   procedure Add_Library_Path (Name : String)
+   is
+   begin
+      Libraries.Add_Library_Path
+        (Get_Machine_Path_Prefix & Directory_Separator
+         & Get_Version_Path & Directory_Separator
+         & Name & Directory_Separator);
+   end Add_Library_Path;
+
+   procedure Setup_Libraries (Load : Boolean)
+   is
+   begin
+      --  Get environment variable.
+      Prefix_Env := GNAT.OS_Lib.Getenv ("GHDL_PREFIX");
+      if Prefix_Env = null or else Prefix_Env.all = "" then
+         Prefix_Env := null;
+      end if;
+
+      --  Compute Exec_Prefix.
+      Set_Exec_Prefix;
+
+      --  Set prefix path.
+      --  If not set by command line, try environment variable.
+      if Switch_Prefix_Path /= null then
+         Lib_Prefix_Path := Switch_Prefix_Path;
+      else
+         Lib_Prefix_Path := Prefix_Env;
+      end if;
+      --  Else try default path.
+      if Lib_Prefix_Path = null then
+         if Is_Absolute_Path (Default_Pathes.Lib_Prefix) then
+            Lib_Prefix_Path := new String'(Default_Pathes.Lib_Prefix);
+         else
+            if Exec_Prefix /= null then
+               Lib_Prefix_Path := new
+                 String'(Exec_Prefix.all & Directory_Separator
+                           & Default_Pathes.Lib_Prefix);
+            end if;
+            if Lib_Prefix_Path = null
+              or else not Is_Directory (Lib_Prefix_Path.all)
+            then
+               Free (Lib_Prefix_Path);
+               Lib_Prefix_Path := new
+                 String'(Default_Pathes.Install_Prefix
+                           & Directory_Separator
+                           & Default_Pathes.Lib_Prefix);
+            end if;
+         end if;
+      else
+         -- Assume the user has set the correct path, so do not insert 32.
+         Flag_32bit := False;
+      end if;
+
+      --  Add pathes for predefined libraries.
+      if not Flags.Bootstrap then
+         Add_Library_Path ("std");
+         case Flag_Ieee is
+            when Lib_Standard =>
+               Add_Library_Path ("ieee");
+            when Lib_Synopsys =>
+               Add_Library_Path ("synopsys");
+            when Lib_Mentor =>
+               Add_Library_Path ("mentor");
+            when Lib_None =>
+               null;
+         end case;
+      end if;
+      if Load then
+         Libraries.Load_Std_Library;
+         Libraries.Load_Work_Library;
+      end if;
+   end Setup_Libraries;
+
+   procedure Disp_Library_Unit (Unit : Iir)
+   is
+      use Ada.Text_IO;
+      use Name_Table;
+      Id : Name_Id;
+   begin
+      Id := Get_Identifier (Unit);
+      case Get_Kind (Unit) is
+         when Iir_Kind_Entity_Declaration =>
+            Put ("entity ");
+         when Iir_Kind_Architecture_Body =>
+            Put ("architecture ");
+         when Iir_Kind_Configuration_Declaration =>
+            Put ("configuration ");
+         when Iir_Kind_Package_Declaration =>
+            Put ("package ");
+         when Iir_Kind_Package_Instantiation_Declaration =>
+            Put ("package instance ");
+         when Iir_Kind_Package_Body =>
+            Put ("package body ");
+         when others =>
+            Put ("???");
+            return;
+      end case;
+      Image (Id);
+      Put (Name_Buffer (1 .. Name_Length));
+      case Get_Kind (Unit) is
+         when Iir_Kind_Architecture_Body =>
+            Put (" of ");
+            Image (Get_Entity_Identifier_Of_Architecture (Unit));
+            Put (Name_Buffer (1 .. Name_Length));
+         when Iir_Kind_Configuration_Declaration =>
+            if Id = Null_Identifier then
+               Put ("<default> of entity ");
+               Image (Get_Entity_Identifier_Of_Architecture (Unit));
+               Put (Name_Buffer (1 .. Name_Length));
+            end if;
+         when others =>
+            null;
+      end case;
+   end Disp_Library_Unit;
+
+   procedure Disp_Library (Name : Name_Id)
+   is
+      use Ada.Text_IO;
+      use Libraries;
+      Lib : Iir_Library_Declaration;
+      File : Iir_Design_File;
+      Unit : Iir;
+   begin
+      if Name = Std_Names.Name_Work then
+         Lib := Work_Library;
+      elsif Name = Std_Names.Name_Std then
+         Lib := Std_Library;
+      else
+         Lib := Get_Library (Name, Command_Line_Location);
+      end if;
+
+      --  Disp contents of files.
+      File := Get_Design_File_Chain (Lib);
+      while File /= Null_Iir loop
+         Unit := Get_First_Design_Unit (File);
+         while Unit /= Null_Iir loop
+            Disp_Library_Unit (Get_Library_Unit (Unit));
+            New_Line;
+            Unit := Get_Chain (Unit);
+         end loop;
+         File := Get_Chain (File);
+      end loop;
+   end Disp_Library;
+
+   --  Return FILENAME without the extension.
+   function Get_Base_Name (Filename : String; Remove_Dir : Boolean := True)
+                           return String
+   is
+      First : Natural;
+      Last : Natural;
+   begin
+      First := Filename'First;
+      Last := Filename'Last;
+      for I in Filename'Range loop
+         if Filename (I) = '.' then
+            Last := I - 1;
+         elsif Remove_Dir and then Filename (I) = Directory_Separator then
+            First := I + 1;
+            Last := Filename'Last;
+         end if;
+      end loop;
+      return Filename (First .. Last);
+   end Get_Base_Name;
+
+   function Append_Suffix (File : String; Suffix : String) return String_Access
+   is
+      use Name_Table;
+      Basename : constant String := Get_Base_Name (File);
+   begin
+      Image (Libraries.Work_Directory);
+      Name_Buffer (Name_Length + 1 .. Name_Length + Basename'Length) :=
+        Basename;
+      Name_Length := Name_Length + Basename'Length;
+      Name_Buffer (Name_Length + 1 .. Name_Length + Suffix'Length) := Suffix;
+      Name_Length := Name_Length + Suffix'Length;
+      return new String'(Name_Buffer (1 .. Name_Length));
+   end Append_Suffix;
+
+
+   --  Command Dir.
+   type Command_Dir is new Command_Lib with null record;
+   function Decode_Command (Cmd : Command_Dir; Name : String) return Boolean;
+   function Get_Short_Help (Cmd : Command_Dir) return String;
+   procedure Perform_Action (Cmd : in out Command_Dir; Args : Argument_List);
+
+   function Decode_Command (Cmd : Command_Dir; Name : String) return Boolean
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return Name = "-d" or else Name = "--dir";
+   end Decode_Command;
+
+   function Get_Short_Help (Cmd : Command_Dir) return String
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return "-d or --dir        Disp contents of the work library";
+   end Get_Short_Help;
+
+   procedure Perform_Action (Cmd : in out Command_Dir; Args : Argument_List)
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      if Args'Length /= 0 then
+         Error ("command '-d' does not accept any argument");
+         raise Option_Error;
+      end if;
+
+      Flags.Bootstrap := True;
+      --  Load word library.
+      Libraries.Load_Std_Library;
+      Libraries.Load_Work_Library;
+
+      Disp_Library (Std_Names.Name_Work);
+
+--       else
+--          for L in Libs'Range loop
+--             Id := Get_Identifier (Libs (L).all);
+--             Disp_Library (Id);
+--          end loop;
+--       end if;
+   end Perform_Action;
+
+   --  Command Find.
+   type Command_Find is new Command_Lib with null record;
+   function Decode_Command (Cmd : Command_Find; Name : String) return Boolean;
+   function Get_Short_Help (Cmd : Command_Find) return String;
+   procedure Perform_Action (Cmd : in out Command_Find; Args : Argument_List);
+
+   function Decode_Command (Cmd : Command_Find; Name : String) return Boolean
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return Name = "-f";
+   end Decode_Command;
+
+   function Get_Short_Help (Cmd : Command_Find) return String
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return "-f FILEs           Disp units in FILES";
+   end Get_Short_Help;
+
+   --  Return TRUE is UNIT can be at the apex of a design hierarchy.
+   function Is_Top_Entity (Unit : Iir) return Boolean
+   is
+   begin
+      if Get_Kind (Unit) /= Iir_Kind_Entity_Declaration then
+         return False;
+      end if;
+      if Get_Port_Chain (Unit) /= Null_Iir then
+         return False;
+      end if;
+      if Get_Generic_Chain (Unit) /= Null_Iir then
+         return False;
+      end if;
+      return True;
+   end Is_Top_Entity;
+
+   --  Disp contents design files FILES.
+   procedure Perform_Action (Cmd : in out Command_Find; Args : Argument_List)
+   is
+      pragma Unreferenced (Cmd);
+
+      use Ada.Text_IO;
+      use Name_Table;
+      Id : Name_Id;
+      Design_File : Iir_Design_File;
+      Unit : Iir;
+      Lib : Iir;
+      Flag_Add : constant Boolean := False;
+   begin
+      Flags.Bootstrap := True;
+      Libraries.Load_Std_Library;
+      Libraries.Load_Work_Library;
+
+      for I in Args'Range loop
+         Id := Get_Identifier (Args (I).all);
+         Design_File := Libraries.Load_File (Id);
+         if Design_File /= Null_Iir then
+            Unit := Get_First_Design_Unit (Design_File);
+            while Unit /= Null_Iir loop
+               Lib := Get_Library_Unit (Unit);
+               Disp_Library_Unit (Lib);
+               if Is_Top_Entity (Lib) then
+                  Put (" **");
+               end if;
+               New_Line;
+               if Flag_Add then
+                  Libraries.Add_Design_Unit_Into_Library (Unit);
+               end if;
+               Unit := Get_Chain (Unit);
+            end loop;
+         end if;
+      end loop;
+      if Flag_Add then
+         Libraries.Save_Work_Library;
+      end if;
+   end Perform_Action;
+
+   --  Command Import.
+   type Command_Import is new Command_Lib with null record;
+   function Decode_Command (Cmd : Command_Import; Name : String)
+                           return Boolean;
+   function Get_Short_Help (Cmd : Command_Import) return String;
+   procedure Perform_Action (Cmd : in out Command_Import;
+                             Args : Argument_List);
+
+   function Decode_Command (Cmd : Command_Import; Name : String)
+                           return Boolean
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return Name = "-i";
+   end Decode_Command;
+
+   function Get_Short_Help (Cmd : Command_Import) return String
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return "-i [OPTS] FILEs    Import units of FILEs";
+   end Get_Short_Help;
+
+   procedure Perform_Action (Cmd : in out Command_Import; Args : Argument_List)
+   is
+      pragma Unreferenced (Cmd);
+      use Ada.Text_IO;
+      Id : Name_Id;
+      Design_File : Iir_Design_File;
+      Unit : Iir;
+      Next_Unit : Iir;
+      Lib : Iir;
+   begin
+      Setup_Libraries (True);
+
+      --  Parse all files.
+      for I in Args'Range loop
+         Id := Name_Table.Get_Identifier (Args (I).all);
+         Design_File := Libraries.Load_File (Id);
+         if Design_File /= Null_Iir then
+            Unit := Get_First_Design_Unit (Design_File);
+            while Unit /= Null_Iir loop
+               if Flag_Verbose then
+                  Lib := Get_Library_Unit (Unit);
+                  Disp_Library_Unit (Lib);
+                  if Is_Top_Entity (Lib) then
+                     Put (" **");
+                  end if;
+                  New_Line;
+               end if;
+               Next_Unit := Get_Chain (Unit);
+               Set_Chain (Unit, Null_Iir);
+               Libraries.Add_Design_Unit_Into_Library (Unit);
+               Unit := Next_Unit;
+            end loop;
+         end if;
+      end loop;
+
+      --  Analyze all files.
+      if False then
+         Design_File := Get_Design_File_Chain (Libraries.Work_Library);
+         while Design_File /= Null_Iir loop
+            Unit := Get_First_Design_Unit (Design_File);
+            while Unit /= Null_Iir loop
+               case Get_Date (Unit) is
+                  when Date_Valid
+                    | Date_Analyzed =>
+                     null;
+                  when Date_Parsed =>
+                     Back_End.Finish_Compilation (Unit, False);
+                  when others =>
+                     raise Internal_Error;
+               end case;
+               Unit := Get_Chain (Unit);
+            end loop;
+            Design_File := Get_Chain (Design_File);
+         end loop;
+      end if;
+
+      Libraries.Save_Work_Library;
+   exception
+      when Errorout.Compilation_Error =>
+         Error ("importation has failed due to compilation error");
+         raise;
+   end Perform_Action;
+
+   --  Command Check_Syntax.
+   type Command_Check_Syntax is new Command_Lib with null record;
+   function Decode_Command (Cmd : Command_Check_Syntax; Name : String)
+                           return Boolean;
+   function Get_Short_Help (Cmd : Command_Check_Syntax) return String;
+   procedure Perform_Action (Cmd : in out Command_Check_Syntax;
+                             Args : Argument_List);
+
+   function Decode_Command (Cmd : Command_Check_Syntax; Name : String)
+                           return Boolean
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return Name = "-s";
+   end Decode_Command;
+
+   function Get_Short_Help (Cmd : Command_Check_Syntax) return String
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return "-s [OPTS] FILEs    Check syntax of FILEs";
+   end Get_Short_Help;
+
+   procedure Analyze_One_File (File_Name : String)
+   is
+      use Ada.Text_IO;
+      Id : Name_Id;
+      Design_File : Iir_Design_File;
+      Unit : Iir;
+      Next_Unit : Iir;
+   begin
+      Id := Name_Table.Get_Identifier (File_Name);
+      if Flag_Verbose then
+         Put (File_Name);
+         Put_Line (":");
+      end if;
+      Design_File := Libraries.Load_File (Id);
+      if Design_File = Null_Iir then
+         raise Errorout.Compilation_Error;
+      end if;
+
+      Unit := Get_First_Design_Unit (Design_File);
+      while Unit /= Null_Iir loop
+         if Flag_Verbose then
+            Put (' ');
+            Disp_Library_Unit (Get_Library_Unit (Unit));
+            New_Line;
+         end if;
+         -- Sem, canon, annotate a design unit.
+         Back_End.Finish_Compilation (Unit, True);
+
+         Next_Unit := Get_Chain (Unit);
+         if Errorout.Nbr_Errors = 0 then
+            Set_Chain (Unit, Null_Iir);
+            Libraries.Add_Design_Unit_Into_Library (Unit);
+         end if;
+
+         Unit := Next_Unit;
+      end loop;
+
+      if Errorout.Nbr_Errors > 0 then
+         raise Errorout.Compilation_Error;
+      end if;
+   end Analyze_One_File;
+
+   procedure Analyze_Files (Files : Argument_List; Save_Library : Boolean) is
+   begin
+      Setup_Libraries (True);
+
+      --  Parse all files.
+      for I in Files'Range loop
+         Analyze_One_File (Files (I).all);
+      end loop;
+
+      if Save_Library then
+         Libraries.Save_Work_Library;
+      end if;
+   end Analyze_Files;
+
+   procedure Perform_Action (Cmd : in out Command_Check_Syntax;
+                             Args : Argument_List)
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      Analyze_Files (Args, False);
+   end Perform_Action;
+
+   --  Command --clean: remove object files.
+   type Command_Clean is new Command_Lib with null record;
+   function Decode_Command (Cmd : Command_Clean; Name : String) return Boolean;
+   function Get_Short_Help (Cmd : Command_Clean) return String;
+   procedure Perform_Action (Cmd : in out Command_Clean; Args : Argument_List);
+
+   function Decode_Command (Cmd : Command_Clean; Name : String) return Boolean
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return Name = "--clean";
+   end Decode_Command;
+
+   function Get_Short_Help (Cmd : Command_Clean) return String
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return "--clean            Remove generated files";
+   end Get_Short_Help;
+
+   procedure Delete (Str : String)
+   is
+      use Ada.Text_IO;
+      Status : Boolean;
+   begin
+      Delete_File (Str'Address, Status);
+      if Flag_Verbose and Status then
+         Put_Line ("delete " & Str (Str'First .. Str'Last - 1));
+      end if;
+   end Delete;
+
+   procedure Perform_Action (Cmd : in out Command_Clean; Args : Argument_List)
+   is
+      pragma Unreferenced (Cmd);
+      use Name_Table;
+
+      procedure Delete_Asm_Obj (Str : String) is
+      begin
+         Delete (Str & Get_Object_Suffix.all & Nul);
+         Delete (Str & Asm_Suffix & Nul);
+      end Delete_Asm_Obj;
+
+      procedure Delete_Top_Unit (Str : String) is
+      begin
+         --  Delete elaboration file
+         Delete_Asm_Obj (Image (Libraries.Work_Directory) & Elab_Prefix & Str);
+
+         --  Delete file list.
+         Delete (Image (Libraries.Work_Directory) & Str & List_Suffix & Nul);
+
+         --  Delete executable.
+         Delete (Str & Nul);
+      end Delete_Top_Unit;
+
+      File : Iir_Design_File;
+      Design_Unit : Iir_Design_Unit;
+      Lib_Unit : Iir;
+      Str : String_Access;
+   begin
+      if Args'Length /= 0 then
+         Error ("command '--clean' does not accept any argument");
+         raise Option_Error;
+      end if;
+
+      Flags.Bootstrap := True;
+      --  Load libraries.
+      Libraries.Load_Std_Library;
+      Libraries.Load_Work_Library;
+
+      File := Get_Design_File_Chain (Libraries.Work_Library);
+      while File /= Null_Iir loop
+         --  Delete compiled file.
+         Str := Append_Suffix (Image (Get_Design_File_Filename (File)), "");
+         Delete_Asm_Obj (Str.all);
+         Free (Str);
+
+         Design_Unit := Get_First_Design_Unit (File);
+         while Design_Unit /= Null_Iir loop
+            Lib_Unit := Get_Library_Unit (Design_Unit);
+            case Get_Kind (Lib_Unit) is
+               when Iir_Kind_Entity_Declaration
+                 | Iir_Kind_Configuration_Declaration =>
+                  Delete_Top_Unit (Image (Get_Identifier (Lib_Unit)));
+               when Iir_Kind_Architecture_Body =>
+                  Delete_Top_Unit
+                    (Image (Get_Entity_Identifier_Of_Architecture (Lib_Unit))
+                       & '-'
+                       & Image (Get_Identifier (Lib_Unit)));
+               when others =>
+                  null;
+            end case;
+            Design_Unit := Get_Chain (Design_Unit);
+         end loop;
+         File := Get_Chain (File);
+      end loop;
+   end Perform_Action;
+
+   --  Command --remove: remove object file and library file.
+   type Command_Remove is new Command_Clean with null record;
+   function Decode_Command (Cmd : Command_Remove; Name : String)
+                           return Boolean;
+   function Get_Short_Help (Cmd : Command_Remove) return String;
+   procedure Perform_Action (Cmd : in out Command_Remove;
+                             Args : Argument_List);
+
+   function Decode_Command (Cmd : Command_Remove; Name : String) return Boolean
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return Name = "--remove";
+   end Decode_Command;
+
+   function Get_Short_Help (Cmd : Command_Remove) return String
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return "--remove           Remove generated files and library file";
+   end Get_Short_Help;
+
+   procedure Perform_Action (Cmd : in out Command_Remove; Args : Argument_List)
+   is
+      use Name_Table;
+   begin
+      if Args'Length /= 0 then
+         Error ("command '--remove' does not accept any argument");
+         raise Option_Error;
+      end if;
+      Perform_Action (Command_Clean (Cmd), Args);
+      Delete (Image (Libraries.Work_Directory)
+              & Back_End.Library_To_File_Name (Libraries.Work_Library)
+              & Nul);
+   end Perform_Action;
+
+   --  Command --copy: copy work library to current directory.
+   type Command_Copy is new Command_Lib with null record;
+   function Decode_Command (Cmd : Command_Copy; Name : String) return Boolean;
+   function Get_Short_Help (Cmd : Command_Copy) return String;
+   procedure Perform_Action (Cmd : in out Command_Copy; Args : Argument_List);
+
+   function Decode_Command (Cmd : Command_Copy; Name : String) return Boolean
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return Name = "--copy";
+   end Decode_Command;
+
+   function Get_Short_Help (Cmd : Command_Copy) return String
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return "--copy             Copy work library to current directory";
+   end Get_Short_Help;
+
+   procedure Perform_Action (Cmd : in out Command_Copy; Args : Argument_List)
+   is
+      pragma Unreferenced (Cmd);
+      use Name_Table;
+      use Libraries;
+
+      File : Iir_Design_File;
+      Dir : Name_Id;
+   begin
+      if Args'Length /= 0 then
+         Error ("command '--copy' does not accept any argument");
+         raise Option_Error;
+      end if;
+
+      Setup_Libraries (False);
+      Libraries.Load_Std_Library;
+      Dir := Work_Directory;
+      Work_Directory := Null_Identifier;
+      Libraries.Load_Work_Library;
+      Work_Directory := Dir;
+
+      Dir := Get_Library_Directory (Libraries.Work_Library);
+      if Dir = Name_Nil or else Dir = Files_Map.Get_Home_Directory then
+         Error ("cannot copy library on itself (use --remove first)");
+         raise Option_Error;
+      end if;
+
+      File := Get_Design_File_Chain (Libraries.Work_Library);
+      while File /= Null_Iir loop
+         --  Copy object files (if any).
+         declare
+            Basename : constant String :=
+              Get_Base_Name (Image (Get_Design_File_Filename (File)));
+            Src : String_Access;
+            Dst : String_Access;
+            Success : Boolean;
+            pragma Unreferenced (Success);
+         begin
+            Src := new String'(Image (Dir) & Basename & Get_Object_Suffix.all);
+            Dst := new String'(Basename & Get_Object_Suffix.all);
+            Copy_File (Src.all, Dst.all, Success, Overwrite, Full);
+            --  Be silent in case of error.
+            Free (Src);
+            Free (Dst);
+         end;
+         if Get_Design_File_Directory (File) = Name_Nil then
+            Set_Design_File_Directory (File, Dir);
+         end if;
+
+         File := Get_Chain (File);
+      end loop;
+      Libraries.Work_Directory := Name_Nil;
+      Libraries.Save_Work_Library;
+   end Perform_Action;
+
+   --  Command --disp-standard.
+   type Command_Disp_Standard is new Command_Lib with null record;
+   function Decode_Command (Cmd : Command_Disp_Standard; Name : String)
+                           return Boolean;
+   function Get_Short_Help (Cmd : Command_Disp_Standard) return String;
+   procedure Perform_Action (Cmd : in out Command_Disp_Standard;
+                             Args : Argument_List);
+
+   function Decode_Command (Cmd : Command_Disp_Standard; Name : String)
+                           return Boolean
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return Name = "--disp-standard";
+   end Decode_Command;
+
+   function Get_Short_Help (Cmd : Command_Disp_Standard) return String
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return "--disp-standard    Disp std.standard in pseudo-vhdl";
+   end Get_Short_Help;
+
+   procedure Perform_Action (Cmd : in out Command_Disp_Standard;
+                             Args : Argument_List)
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      if Args'Length /= 0 then
+         Error ("command '--disp-standard' does not accept any argument");
+         raise Option_Error;
+      end if;
+      Flags.Bootstrap := True;
+      Libraries.Load_Std_Library;
+      Disp_Vhdl.Disp_Vhdl (Std_Package.Std_Standard_Unit);
+   end Perform_Action;
+
+   procedure Load_All_Libraries_And_Files
+   is
+      use Files_Map;
+      use Libraries;
+      use Errorout;
+
+      procedure Extract_Library_Clauses (Unit : Iir_Design_Unit)
+      is
+         Lib1 : Iir_Library_Declaration;
+         pragma Unreferenced (Lib1);
+         Ctxt_Item : Iir;
+      begin
+         --  Extract library clauses.
+         Ctxt_Item := Get_Context_Items (Unit);
+         while Ctxt_Item /= Null_Iir loop
+            if Get_Kind (Ctxt_Item) = Iir_Kind_Library_Clause then
+               Lib1 := Get_Library (Get_Identifier (Ctxt_Item),
+                                    Get_Location (Ctxt_Item));
+            end if;
+            Ctxt_Item := Get_Chain (Ctxt_Item);
+         end loop;
+      end Extract_Library_Clauses;
+
+      Lib : Iir_Library_Declaration;
+      Fe : Source_File_Entry;
+      File, Next_File : Iir_Design_File;
+      Unit, Next_Unit : Iir_Design_Unit;
+      Design_File : Iir_Design_File;
+
+      Old_Work : Iir_Library_Declaration;
+   begin
+      Lib := Std_Library;
+      Lib := Get_Chain (Lib);
+      Old_Work := Work_Library;
+      while Lib /= Null_Iir loop
+         --  Design units are always put in the work library.
+         Work_Library := Lib;
+
+         File := Get_Design_File_Chain (Lib);
+         while File /= Null_Iir loop
+            Next_File := Get_Chain (File);
+            Fe := Load_Source_File (Get_Design_File_Directory (File),
+                                    Get_Design_File_Filename (File));
+            if Fe = No_Source_File_Entry then
+               --  FIXME: should remove all the design file from the library.
+               null;
+            elsif Is_Eq (Get_File_Time_Stamp (Fe),
+                         Get_File_Time_Stamp (File))
+            then
+               --  File has not been modified.
+               --  Extract libraries.
+               --  Note: we can't parse it only, since we need to keep the
+               --    date.
+               Unit := Get_First_Design_Unit (File);
+               while Unit /= Null_Iir loop
+                  Load_Parse_Design_Unit (Unit, Null_Iir);
+                  Extract_Library_Clauses (Unit);
+                  Unit := Get_Chain (Unit);
+               end loop;
+            else
+               --  File has been modified.
+               --  Parse it.
+               Design_File := Load_File (Fe);
+
+               --  Exit now in case of parse error.
+               if Design_File = Null_Iir
+                 or else Nbr_Errors > 0
+               then
+                  raise Compilation_Error;
+               end if;
+
+               Unit := Get_First_Design_Unit (Design_File);
+               while Unit /= Null_Iir loop
+                  Extract_Library_Clauses (Unit);
+
+                  Next_Unit := Get_Chain (Unit);
+                  Set_Chain (Unit, Null_Iir);
+                  Add_Design_Unit_Into_Library (Unit);
+                  Unit := Next_Unit;
+               end loop;
+            end if;
+            File := Next_File;
+         end loop;
+         Lib := Get_Chain (Lib);
+      end loop;
+      Work_Library := Old_Work;
+   end Load_All_Libraries_And_Files;
+
+   procedure Check_No_Elab_Flag (Lib : Iir_Library_Declaration)
+   is
+      File : Iir_Design_File;
+      Unit : Iir_Design_Unit;
+   begin
+      File := Get_Design_File_Chain (Lib);
+      while File /= Null_Iir loop
+         Unit := Get_First_Design_Unit (File);
+         while Unit /= Null_Iir loop
+            if Get_Elab_Flag (Unit) then
+               raise Internal_Error;
+            end if;
+            Unit := Get_Chain (Unit);
+         end loop;
+         File := Get_Chain (File);
+      end loop;
+   end Check_No_Elab_Flag;
+
+   function Build_Dependence (Prim : String_Access; Sec : String_Access)
+     return Iir_List
+   is
+      procedure Build_Dependence_List (File : Iir_Design_File; List : Iir_List)
+      is
+         El : Iir_Design_File;
+         Depend_List : Iir_List;
+      begin
+         if Get_Elab_Flag (File) then
+            return;
+         end if;
+
+         Set_Elab_Flag (File, True);
+         Depend_List := Get_File_Dependence_List (File);
+         if Depend_List /= Null_Iir_List then
+            for I in Natural loop
+               El := Get_Nth_Element (Depend_List, I);
+               exit when El = Null_Iir;
+               Build_Dependence_List (El, List);
+            end loop;
+         end if;
+         Append_Element (List, File);
+      end Build_Dependence_List;
+
+      use Configuration;
+      use Name_Table;
+
+      Top : Iir;
+      Primary_Id : Name_Id;
+      Secondary_Id : Name_Id;
+
+      File : Iir_Design_File;
+      Unit : Iir;
+
+      Files_List : Iir_List;
+   begin
+      Check_No_Elab_Flag (Libraries.Work_Library);
+
+      Primary_Id := Get_Identifier (Prim.all);
+      if Sec /= null then
+         Secondary_Id := Get_Identifier (Sec.all);
+      else
+         Secondary_Id := Null_Identifier;
+      end if;
+
+      if True then
+         Load_All_Libraries_And_Files;
+      else
+         --  Re-parse modified files in order configure could find all design
+         --  units.
+         declare
+            use Files_Map;
+            Fe : Source_File_Entry;
+            Next_File : Iir_Design_File;
+            Design_File : Iir_Design_File;
+         begin
+            File := Get_Design_File_Chain (Libraries.Work_Library);
+            while File /= Null_Iir loop
+               Next_File := Get_Chain (File);
+               Fe := Load_Source_File (Get_Design_File_Directory (File),
+                                       Get_Design_File_Filename (File));
+               if Fe = No_Source_File_Entry then
+                  --  FIXME: should remove all the design file from
+                  --  the library.
+                  null;
+               else
+                  if not Is_Eq (Get_File_Time_Stamp (Fe),
+                                Get_File_Time_Stamp (File))
+                  then
+                     --  FILE has been modified.
+                     Design_File := Libraries.Load_File (Fe);
+                     if Design_File /= Null_Iir then
+                        Libraries.Add_Design_File_Into_Library (Design_File);
+                     end if;
+                  end if;
+               end if;
+               File := Next_File;
+            end loop;
+         end;
+      end if;
+
+      Flags.Flag_Elaborate := True;
+      Flags.Flag_Elaborate_With_Outdated := True;
+      Flag_Load_All_Design_Units := True;
+      Flag_Build_File_Dependence := True;
+
+      Top := Configure (Primary_Id, Secondary_Id);
+      if Top = Null_Iir then
+         --Error ("cannot find primary unit " & Prim.all);
+         raise Option_Error;
+      end if;
+
+      --  Add unused design units.
+      declare
+         N : Natural;
+      begin
+         N := Design_Units.First;
+         while N <= Design_Units.Last loop
+            Unit := Design_Units.Table (N);
+            N := N + 1;
+            File := Get_Design_File (Unit);
+            if not Get_Elab_Flag (File) then
+               Set_Elab_Flag (File, True);
+               Unit := Get_First_Design_Unit (File);
+               while Unit /= Null_Iir loop
+                  if not Get_Elab_Flag (Unit) then
+                     Add_Design_Unit (Unit, Null_Iir);
+                  end if;
+                  Unit := Get_Chain (Unit);
+               end loop;
+            end if;
+         end loop;
+      end;
+
+      --  Clear elab flag on design files.
+      for I in reverse Design_Units.First .. Design_Units.Last loop
+         Unit := Design_Units.Table (I);
+         File := Get_Design_File (Unit);
+         Set_Elab_Flag (File, False);
+      end loop;
+
+      --  Create a list of files, from the last to the first.
+      Files_List := Create_Iir_List;
+      for I in Design_Units.First .. Design_Units.Last loop
+         Unit := Design_Units.Table (I);
+         File := Get_Design_File (Unit);
+         Build_Dependence_List (File, Files_List);
+      end loop;
+
+      return Files_List;
+   end Build_Dependence;
+
+   --  Convert NAME to lower cases, unless it is an extended identifier.
+   function Convert_Name (Name : String_Access) return String_Access
+   is
+      use Name_Table;
+
+      function Is_Bad_Unit_Name return Boolean is
+      begin
+         if Name_Length = 0 then
+            return True;
+         end if;
+         --  Don't try to handle extended identifier.
+         if Name_Buffer (1) = '\' then
+            return False;
+         end if;
+         --  Look for suspicious characters.
+         --  Do not try to be exhaustive as the correct check will be done
+         --  by convert_identifier.
+         for I in 1 .. Name_Length loop
+            case Name_Buffer (I) is
+               when '.' | '/' | '\' =>
+                  return True;
+               when others =>
+                  null;
+            end case;
+         end loop;
+         return False;
+      end Is_Bad_Unit_Name;
+
+      function Is_A_File_Name return Boolean is
+      begin
+         --  Check .vhd
+         if Name_Length > 4
+           and then Name_Buffer (Name_Length - 3 .. Name_Length) = ".vhd"
+         then
+            return True;
+         end if;
+         --  Check .vhdl
+         if Name_Length > 5
+           and then Name_Buffer (Name_Length - 4 .. Name_Length) = ".vhdl"
+         then
+            return True;
+         end if;
+         --  Check ../
+         if Name_Length > 3
+           and then Name_Buffer (1 .. 3) = "../"
+         then
+            return True;
+         end if;
+         --  Check ..\
+         if Name_Length > 3
+           and then Name_Buffer (1 .. 3) = "..\"
+         then
+            return True;
+         end if;
+         --  Should try to find the file ?
+         return False;
+      end Is_A_File_Name;
+   begin
+      Name_Length := Name'Length;
+      Name_Buffer (1 .. Name_Length) := Name.all;
+
+      --  Try to identifier bad names (such as file names), so that
+      --  friendly message can be displayed.
+      if Is_Bad_Unit_Name then
+         Errorout.Error_Msg_Option_NR ("bad unit name '" & Name.all & "'");
+         if Is_A_File_Name then
+            Errorout.Error_Msg_Option_NR
+              ("(a unit name is required instead of a filename)");
+         end if;
+         raise Option_Error;
+      end if;
+      Scanner.Convert_Identifier;
+      return new String'(Name_Buffer (1 .. Name_Length));
+   end Convert_Name;
+
+   procedure Extract_Elab_Unit
+     (Cmd_Name : String; Args : Argument_List; Next_Arg : out Natural)
+   is
+   begin
+      if Args'Length = 0 then
+         Error ("command '" & Cmd_Name & "' required an unit name");
+         raise Option_Error;
+      end if;
+
+      Prim_Name := Convert_Name (Args (Args'First));
+      Next_Arg := Args'First + 1;
+      Sec_Name := null;
+
+      if Args'Length >= 2 then
+         declare
+            Sec : constant String_Access := Args (Next_Arg);
+         begin
+            if Sec (Sec'First) /= '-' then
+               Sec_Name := Convert_Name (Sec);
+               Next_Arg := Args'First + 2;
+            end if;
+         end;
+      end if;
+   end Extract_Elab_Unit;
+
+   procedure Register_Commands is
+   begin
+      Register_Command (new Command_Import);
+      Register_Command (new Command_Check_Syntax);
+      Register_Command (new Command_Dir);
+      Register_Command (new Command_Find);
+      Register_Command (new Command_Clean);
+      Register_Command (new Command_Remove);
+      Register_Command (new Command_Copy);
+      Register_Command (new Command_Disp_Standard);
+   end Register_Commands;
+end Ghdllocal;
diff --git a/src/ghdldrv/ghdllocal.ads b/src/ghdldrv/ghdllocal.ads
new file mode 100644
index 000000000..2c7018adc
--- /dev/null
+++ b/src/ghdldrv/ghdllocal.ads
@@ -0,0 +1,116 @@
+--  GHDL driver - local commands.
+--  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.OS_Lib; use GNAT.OS_Lib;
+with Ghdlmain; use Ghdlmain;
+with Iirs; use Iirs;
+
+package Ghdllocal is
+   type Command_Lib is abstract new Command_Type with null record;
+
+   --  Setup GHDL.
+   procedure Init (Cmd : in out Command_Lib);
+
+   --  Handle:
+   --  --std=xx, --work=xx, -Pxxx, --workdir=x, --ieee=x, -Px, and -v
+   procedure Decode_Option (Cmd : in out Command_Lib;
+                            Option : String;
+                            Arg : String;
+                            Res : out Option_Res);
+
+   --  Disp detailled help.
+   procedure Disp_Long_Help (Cmd : Command_Lib);
+
+   --  Value of --PREFIX
+   Switch_Prefix_Path : String_Access := null;
+
+   --  getenv ("GHDL_PREFIX").  Set by Setup_Libraries.
+   Prefix_Env : String_Access := null;
+
+   --  Installation prefix (deduced from executable path).
+   Exec_Prefix : String_Access;
+
+   --  Path prefix for libraries.
+   Lib_Prefix_Path : String_Access := null;
+
+   --  Set with -v option.
+   Flag_Verbose : Boolean := False;
+
+   --  Suffix for asm files.
+   Asm_Suffix : constant String := ".s";
+
+   --  Suffix for llvm byte-code files.
+   Llvm_Suffix : constant String := ".bc";
+
+   --  Suffix for post files.
+   Post_Suffix : constant String := ".on";
+
+   --  Suffix for list files.
+   List_Suffix : constant String := ".lst";
+
+   --  Prefix for elab files.
+   Elab_Prefix : constant String := "e~";
+
+   Nul : constant Character := Character'Val (0);
+
+   --  Return FILENAME without the extension.
+   function Get_Base_Name (Filename : String; Remove_Dir : Boolean := True)
+                          return String;
+
+   --  Get the position of the last directory separator or 0 if none.
+   function Get_Basename_Pos (Pathname : String) return Natural;
+
+   function Append_Suffix (File : String; Suffix : String)
+                          return String_Access;
+
+   --  Return TRUE is UNIT can be at the apex of a design hierarchy.
+   function Is_Top_Entity (Unit : Iir) return Boolean;
+
+   --  Display the name of library unit UNIT.
+   procedure Disp_Library_Unit (Unit : Iir);
+
+   --  Translate vhdl version into a path element.
+   --  Used to search Std and IEEE libraries.
+   function Get_Version_Path return String;
+
+   -- Get Prefix_Path, but with 32 added if -m32 is requested
+   function Get_Machine_Path_Prefix return String;
+
+   --  Setup standard libaries path.  If LOAD is true, then load them now.
+   procedure Setup_Libraries (Load : Boolean);
+
+   --  Setup library, analyze FILES, and if SAVE_LIBRARY is set save the
+   --  work library only
+   procedure Analyze_Files (Files : Argument_List; Save_Library : Boolean);
+
+   --  Load and parse all libraries and files, starting from the work library.
+   --  The work library must already be loaded.
+   --  Raise errorout.compilation_error in case of error (parse error).
+   procedure Load_All_Libraries_And_Files;
+
+   function Build_Dependence (Prim : String_Access; Sec : String_Access)
+     return Iir_List;
+
+   Prim_Name : String_Access;
+   Sec_Name : String_Access;
+
+   --  Set PRIM_NAME and SEC_NAME.
+   procedure Extract_Elab_Unit
+     (Cmd_Name : String; Args : Argument_List; Next_Arg : out Natural);
+
+   procedure Register_Commands;
+end Ghdllocal;
diff --git a/src/ghdldrv/ghdlmain.adb b/src/ghdldrv/ghdlmain.adb
new file mode 100644
index 000000000..45d9615f9
--- /dev/null
+++ b/src/ghdldrv/ghdlmain.adb
@@ -0,0 +1,359 @@
+--  GHDL driver - main part.
+--  Copyright (C) 2002 - 2010 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.Text_IO;
+with Ada.Command_Line;
+with Version;
+with Bug;
+with Options;
+
+package body Ghdlmain is
+   procedure Init (Cmd : in out Command_Type)
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      null;
+   end Init;
+
+   procedure Decode_Option (Cmd : in out Command_Type;
+                            Option : String;
+                            Arg : String;
+                            Res : out Option_Res)
+   is
+      pragma Unreferenced (Cmd);
+      pragma Unreferenced (Option);
+      pragma Unreferenced (Arg);
+   begin
+      Res := Option_Bad;
+   end Decode_Option;
+
+   procedure Disp_Long_Help (Cmd : Command_Type)
+   is
+      pragma Unreferenced (Cmd);
+      use Ada.Text_IO;
+   begin
+      Put_Line ("This command does not accept options.");
+   end Disp_Long_Help;
+
+   First_Cmd : Command_Acc := null;
+   Last_Cmd : Command_Acc := null;
+
+   procedure Register_Command (Cmd : Command_Acc) is
+   begin
+      if First_Cmd = null then
+         First_Cmd := Cmd;
+      else
+         Last_Cmd.Next := Cmd;
+      end if;
+      Last_Cmd := Cmd;
+   end Register_Command;
+
+   --  Find the command.
+   function Find_Command (Action : String) return Command_Acc
+   is
+      Cmd : Command_Acc;
+   begin
+      Cmd := First_Cmd;
+      while Cmd /= null loop
+         if Decode_Command (Cmd.all, Action) then
+            return Cmd;
+         end if;
+         Cmd := Cmd.Next;
+      end loop;
+      return null;
+   end Find_Command;
+
+   --  Command help.
+   type Command_Help is new Command_Type with null record;
+   function Decode_Command (Cmd : Command_Help; Name : String) return Boolean;
+   procedure Decode_Option (Cmd : in out Command_Help;
+                            Option : String;
+                            Arg : String;
+                            Res : out Option_Res);
+
+   function Get_Short_Help (Cmd : Command_Help) return String;
+   procedure Perform_Action (Cmd : in out Command_Help; Args : Argument_List);
+
+   function Decode_Command (Cmd : Command_Help; Name : String) return Boolean
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return Name = "-h" or else Name = "--help";
+   end Decode_Command;
+
+   procedure Decode_Option (Cmd : in out Command_Help;
+                            Option : String;
+                            Arg : String;
+                            Res : out Option_Res)
+   is
+      pragma Unreferenced (Cmd);
+      pragma Unreferenced (Option);
+      pragma Unreferenced (Arg);
+   begin
+      Res := Option_End;
+   end Decode_Option;
+
+   function Get_Short_Help (Cmd : Command_Help) return String
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return "-h or --help [CMD] Disp this help or [help on CMD]";
+   end Get_Short_Help;
+
+   procedure Perform_Action (Cmd : in out Command_Help; Args : Argument_List)
+   is
+      pragma Unreferenced (Cmd);
+
+      use Ada.Text_IO;
+      use Ada.Command_Line;
+      C : Command_Acc;
+   begin
+      if Args'Length = 0 then
+         Put_Line ("usage: " & Command_Name & " COMMAND [OPTIONS] ...");
+         Put_Line ("COMMAND is one of:");
+         C := First_Cmd;
+         while C /= null loop
+            Put_Line (Get_Short_Help (C.all));
+            C := C.Next;
+         end loop;
+         New_Line;
+         Put_Line ("To display the options of a GHDL program,");
+         Put_Line ("  run your program with the --help option.");
+         Put_Line ("Also see --options-help for analyzer options.");
+         New_Line;
+         Put_Line ("Please, refer to the GHDL manual for more information.");
+         Put_Line ("Report bugs on http://gna.org/projects/ghdl");
+      elsif Args'Length = 1 then
+         C := Find_Command (Args (1).all);
+         if C = null then
+            Error ("Command '" & Args (1).all & "' is unknown.");
+            raise Option_Error;
+         end if;
+         Put_Line (Get_Short_Help (C.all));
+         Disp_Long_Help (C.all);
+      else
+         Error ("Command '--help' accepts at most one argument.");
+         raise Option_Error;
+      end if;
+   end Perform_Action;
+
+   --  Command options help.
+   type Command_Option_Help is new Command_Type with null record;
+   function Decode_Command (Cmd : Command_Option_Help; Name : String)
+                           return Boolean;
+   function Get_Short_Help (Cmd : Command_Option_Help) return String;
+   procedure Perform_Action (Cmd : in out Command_Option_Help;
+                             Args : Argument_List);
+
+   function Decode_Command (Cmd : Command_Option_Help; Name : String)
+                           return Boolean
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return Name = "--options-help";
+   end Decode_Command;
+
+   function Get_Short_Help (Cmd : Command_Option_Help) return String
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return "--options-help     Disp help for analyzer options";
+   end Get_Short_Help;
+
+   procedure Perform_Action (Cmd : in out Command_Option_Help;
+                             Args : Argument_List)
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      if Args'Length /= 0 then
+         Error
+           ("warning: command '--option-help' does not accept any argument");
+      end if;
+      Options.Disp_Options_Help;
+   end Perform_Action;
+
+   --  Command Version
+   type Command_Version is new Command_Type with null record;
+   function Decode_Command (Cmd : Command_Version; Name : String)
+                           return Boolean;
+   function Get_Short_Help (Cmd : Command_Version) return String;
+   procedure Perform_Action (Cmd : in out Command_Version;
+                             Args : Argument_List);
+
+   function Decode_Command (Cmd : Command_Version; Name : String)
+                           return Boolean
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return Name = "-v" or Name = "--version";
+   end Decode_Command;
+
+   function Get_Short_Help (Cmd : Command_Version) return String
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return "-v or --version    Disp ghdl version";
+   end Get_Short_Help;
+
+   procedure Perform_Action (Cmd : in out Command_Version;
+                             Args : Argument_List)
+   is
+      pragma Unreferenced (Cmd);
+      use Ada.Text_IO;
+   begin
+      Put_Line (Version.Ghdl_Release);
+      Put_Line (" Compiled with " & Bug.Get_Gnat_Version);
+      if Version_String /= null then
+         Put (" ");
+         Put (Version_String.all);
+      end if;
+      New_Line;
+      Put_Line ("Written by Tristan Gingold.");
+      New_Line;
+      --  Display copyright.  Assume 80 cols terminal.
+      Put_Line ("Copyright (C) 2003 - 2014 Tristan Gingold.");
+      Put_Line ("GHDL is free software, covered by the "
+                & "GNU General Public License.  There is NO");
+      Put_Line ("warranty; not even for MERCHANTABILITY or"
+                & " FITNESS FOR A PARTICULAR PURPOSE.");
+      if Args'Length /= 0 then
+         Error ("warning: command '--version' does not accept any argument");
+      end if;
+   end Perform_Action;
+
+   --  Disp MSG on the standard output with the command name.
+   procedure Error (Msg : String)
+   is
+      use Ada.Command_Line;
+      use Ada.Text_IO;
+   begin
+      Put (Standard_Error, Command_Name);
+      Put (Standard_Error, ": ");
+      Put_Line (Standard_Error, Msg);
+      --Has_Error := True;
+   end Error;
+
+   procedure Main
+   is
+      use Ada.Command_Line;
+      Cmd : Command_Acc;
+      Arg_Index : Natural;
+      First_Arg : Natural;
+
+   begin
+      if Argument_Count = 0 then
+         Error ("missing command, try " & Command_Name & " --help");
+         raise Option_Error;
+      end if;
+
+      Cmd := Find_Command (Argument (1));
+      if Cmd = null then
+         Error ("unknown command '" & Argument (1) & "', try --help");
+         raise Option_Error;
+      end if;
+
+      Init (Cmd.all);
+
+      --  decode options.
+
+      First_Arg := 0;
+      Arg_Index := 2;
+      while Arg_Index <= Argument_Count loop
+         declare
+            Arg : constant String := Argument (Arg_Index);
+            Res : Option_Res;
+         begin
+            if Arg (1) = '-' then
+               --  Argument is an option.
+
+               if First_Arg > 0 then
+                  Error ("options after file");
+                  raise Option_Error;
+               end if;
+
+               Decode_Option (Cmd.all, Arg, "", Res);
+               case Res is
+                  when Option_Bad =>
+                     Error ("unknown option '" & Arg & "' for command '"
+                            & Argument (1) & "'");
+                     raise Option_Error;
+                  when Option_Ok =>
+                     Arg_Index := Arg_Index + 1;
+                  when Option_Arg_Req =>
+                     if Arg_Index + 1 > Argument_Count then
+                        Error ("option '" & Arg & "' requires an argument");
+                        raise Option_Error;
+                     end if;
+                     Decode_Option
+                       (Cmd.all, Arg, Argument (Arg_Index + 1), Res);
+                     if Res /= Option_Arg then
+                        raise Program_Error;
+                     end if;
+                     Arg_Index := Arg_Index + 2;
+                  when Option_Arg =>
+                     raise Program_Error;
+                  when Option_End =>
+                     First_Arg := Arg_Index;
+                     exit;
+               end case;
+            else
+               First_Arg := Arg_Index;
+               exit;
+            end if;
+         end;
+      end loop;
+
+      if First_Arg = 0 then
+         First_Arg := Argument_Count + 1;
+      end if;
+
+      declare
+         Args : Argument_List (1 .. Argument_Count - First_Arg + 1);
+      begin
+         for I in Args'Range loop
+            Args (I) := new String'(Argument (First_Arg + I - 1));
+         end loop;
+         Perform_Action (Cmd.all, Args);
+         for I in Args'Range loop
+            Free (Args (I));
+         end loop;
+      end;
+      --if Flags.Dump_Stats then
+      --   Name_Table.Disp_Stats;
+      --   Iirs.Disp_Stats;
+      --end if;
+      Set_Exit_Status (Success);
+   exception
+      when Option_Error
+        | Compile_Error
+        | Errorout.Compilation_Error =>
+         Set_Exit_Status (Failure);
+      when Exec_Error =>
+         Set_Exit_Status (3);
+      when E: others =>
+         Bug.Disp_Bug_Box (E);
+         Set_Exit_Status (2);
+   end Main;
+
+   procedure Register_Commands is
+   begin
+      Register_Command (new Command_Help);
+      Register_Command (new Command_Version);
+      Register_Command (new Command_Option_Help);
+   end Register_Commands;
+end Ghdlmain;
+
diff --git a/src/ghdldrv/ghdlmain.ads b/src/ghdldrv/ghdlmain.ads
new file mode 100644
index 000000000..c01f1d63e
--- /dev/null
+++ b/src/ghdldrv/ghdlmain.ads
@@ -0,0 +1,85 @@
+--  GHDL driver - main part.
+--  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.OS_Lib; use GNAT.OS_Lib;
+with Errorout;
+
+package Ghdlmain is
+   type Command_Type;
+
+   type Command_Acc is access all Command_Type'Class;
+
+   type Command_Type is abstract tagged record
+      Next : Command_Acc;
+   end record;
+
+   --  Return TRUE iff CMD handle action ACTION.
+   function Decode_Command (Cmd : Command_Type; Name : String) return Boolean
+     is abstract;
+
+   --  Initialize the command, before decoding actions.
+   procedure Init (Cmd : in out Command_Type);
+
+   --  Option_OK: OPTION is handled.
+   --  Option_Bad: OPTION is unknown.
+   --  Option_Arg_Req: OPTION requires an argument.  Must be set only when
+   --     ARG = "", the manager will recall Decode_Option.
+   --  Option_Arg: OPTION used the argument.
+   type Option_Res is
+     (Option_Bad, Option_Ok, Option_Arg, Option_Arg_Req, Option_End);
+   procedure Decode_Option (Cmd : in out Command_Type;
+                            Option : String;
+                            Arg : String;
+                            Res : out Option_Res);
+
+   --  Get a one-line help for the command.
+   function Get_Short_Help (Cmd : Command_Type) return String
+     is abstract;
+
+   --  Disp detailled help.
+   procedure Disp_Long_Help (Cmd : Command_Type);
+
+   --  Perform the action.
+   procedure Perform_Action (Cmd : in out Command_Type; Args : Argument_List)
+     is abstract;
+
+   --  Register a command.
+   procedure Register_Command (Cmd : Command_Acc);
+
+   --  Disp MSG on the standard output with the command name.
+   procedure Error (Msg : String);
+
+   --  May be raise by perform_action if the arguments are bad.
+   Option_Error : exception renames Errorout.Option_Error;
+
+   --  Action failed.
+   Compile_Error : exception;
+
+   --  Exec failed: either the program was not found, or failed.
+   Exec_Error : exception;
+
+   procedure Main;
+
+   --  Additionnal one-line message displayed by the --version command,
+   --  if defined.
+   --  Used to customize.
+   type String_Cst_Acc is access constant String;
+   Version_String : String_Cst_Acc := null;
+
+   --  Registers all commands in this package.
+   procedure Register_Commands;
+end Ghdlmain;
diff --git a/src/ghdldrv/ghdlprint.adb b/src/ghdldrv/ghdlprint.adb
new file mode 100644
index 000000000..45e70e118
--- /dev/null
+++ b/src/ghdldrv/ghdlprint.adb
@@ -0,0 +1,1757 @@
+--  GHDL driver - print commands.
+--  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.Characters.Latin_1;
+with Ada.Text_IO; use Ada.Text_IO;
+with GNAT.Directory_Operations;
+with GNAT.OS_Lib; use GNAT.OS_Lib;
+with GNAT.Table;
+with Types; use Types;
+with Flags;
+with Name_Table; use Name_Table;
+with Files_Map;
+with Libraries;
+with Errorout; use Errorout;
+with Iirs; use Iirs;
+with Iirs_Utils; use Iirs_Utils;
+with Tokens;
+with Scanner;
+with Parse;
+with Version;
+with Xrefs;
+with Ghdlmain; use Ghdlmain;
+with Ghdllocal; use Ghdllocal;
+with Disp_Vhdl;
+with Back_End;
+
+package body Ghdlprint is
+   type Html_Format_Type is (Html_2, Html_Css);
+   Html_Format : Html_Format_Type := Html_2;
+
+   procedure Put_Html (C : Character) is
+   begin
+      case C is
+         when '>' =>
+            Put ("&gt;");
+         when '<' =>
+            Put ("&lt;");
+         when '&' =>
+            Put ("&amp;");
+         when others =>
+            Put (C);
+      end case;
+   end Put_Html;
+
+   procedure Put_Html (S : String) is
+   begin
+      for I in S'Range loop
+         Put_Html (S (I));
+      end loop;
+   end Put_Html;
+
+   package Nat_IO is new Ada.Text_IO.Integer_IO (Num => Natural);
+   procedure Put_Nat (N : Natural) is
+   begin
+      Nat_IO.Put (N, Width => 0);
+   end Put_Nat;
+
+   type Filexref_Info_Type is record
+      Output : String_Acc;
+      Referenced : Boolean;
+   end record;
+   type Filexref_Info_Arr is array (Source_File_Entry range <>)
+     of Filexref_Info_Type;
+   type Filexref_Info_Arr_Acc is access Filexref_Info_Arr;
+   Filexref_Info : Filexref_Info_Arr_Acc := null;
+
+   --  If True, at least one xref is missing.
+   Missing_Xref : Boolean := False;
+
+   procedure PP_Html_File (File : Source_File_Entry)
+   is
+      use Flags;
+      use Scanner;
+      use Tokens;
+      use Files_Map;
+      use Ada.Characters.Latin_1;
+
+      Line : Natural;
+      Buf : File_Buffer_Acc;
+      Prev_Tok : Token_Type;
+
+      --  Current logical column number.  Used to expand TABs.
+      Col : Natural;
+
+      --  Position just after the last token.
+      Last_Tok : Source_Ptr;
+
+      --  Position just before the current token.
+      Bef_Tok : Source_Ptr;
+
+      --  Position just after the current token.
+      Aft_Tok : Source_Ptr;
+
+      procedure Disp_Ln
+      is
+         N : Natural;
+         Str : String (1 .. 5);
+      begin
+         case Html_Format is
+            when Html_2 =>
+               Put ("<font size=-1>");
+            when Html_Css =>
+               Put ("<i>");
+         end case;
+         N := Line;
+         for I in reverse Str'Range loop
+            if N = 0 then
+               Str (I) := ' ';
+            else
+               Str (I) := Character'Val (48 + N mod 10);
+               N := N / 10;
+            end if;
+         end loop;
+         Put (Str);
+         case Html_Format is
+            when Html_2 =>
+               Put ("</font>");
+            when Html_Css =>
+               Put ("</i>");
+         end case;
+         Put (" ");
+         Col := 0;
+      end Disp_Ln;
+
+      procedure Disp_Spaces
+      is
+         C : Character;
+         P : Source_Ptr;
+         N_Col : Natural;
+      begin
+         P := Last_Tok;
+         while P < Bef_Tok loop
+            C := Buf (P);
+            if C = HT then
+               --  Expand TABS.
+               N_Col := Col + 8;
+               N_Col := N_Col - N_Col mod 8;
+               while Col < N_Col loop
+                  Put (' ');
+                  Col := Col + 1;
+               end loop;
+            else
+               Put (' ');
+               Col := Col + 1;
+            end if;
+            P := P + 1;
+         end loop;
+      end Disp_Spaces;
+
+      procedure Disp_Text
+      is
+         P : Source_Ptr;
+      begin
+         P := Bef_Tok;
+         while P < Aft_Tok loop
+            Put_Html (Buf (P));
+            Col := Col + 1;
+            P := P + 1;
+         end loop;
+      end Disp_Text;
+
+      procedure Disp_Reserved is
+      begin
+         Disp_Spaces;
+         case Html_Format is
+            when Html_2 =>
+               Put ("<font color=red>");
+               Disp_Text;
+               Put ("</font>");
+            when Html_Css =>
+               Put ("<em>");
+               Disp_Text;
+               Put ("</em>");
+         end case;
+      end Disp_Reserved;
+
+      procedure Disp_Href (Loc : Location_Type)
+      is
+         L_File : Source_File_Entry;
+         L_Pos : Source_Ptr;
+      begin
+         Location_To_File_Pos (Loc, L_File, L_Pos);
+         Put (" href=""");
+         if L_File /= File then
+            --  External reference.
+            if Filexref_Info (L_File).Output /= null then
+               Put (Filexref_Info (L_File).Output.all);
+               Put ("#");
+               Put_Nat (Natural (L_Pos));
+            else
+               --  Reference to an unused file.
+               Put ("index.html#f");
+               Put_Nat (Natural (L_File));
+               Filexref_Info (L_File).Referenced := True;
+            end if;
+         else
+            --  Local reference.
+            Put ("#");
+            Put_Nat (Natural (L_Pos));
+         end if;
+         Put ("""");
+      end Disp_Href;
+
+      procedure Disp_Anchor (Loc : Location_Type)
+      is
+         L_File : Source_File_Entry;
+         L_Pos : Source_Ptr;
+      begin
+         Put (" name=""");
+         Location_To_File_Pos (Loc, L_File, L_Pos);
+         Put_Nat (Natural (L_Pos));
+         Put ("""");
+      end Disp_Anchor;
+
+      procedure Disp_Identifier
+      is
+         use Xrefs;
+         Ref : Xref;
+         Decl : Iir;
+         Bod : Iir;
+         Loc : Location_Type;
+      begin
+         Disp_Spaces;
+         if Flags.Flag_Xref then
+            Loc := File_Pos_To_Location (File, Bef_Tok);
+            Ref := Find (Loc);
+            if Ref = Bad_Xref then
+               Disp_Text;
+               Warning_Msg_Sem ("cannot find xref", Loc);
+               Missing_Xref := True;
+               return;
+            end if;
+         else
+            Disp_Text;
+            return;
+         end if;
+         case Get_Xref_Kind (Ref) is
+            when Xref_Decl =>
+               Put ("<a");
+               Disp_Anchor (Loc);
+               Decl := Get_Xref_Node (Ref);
+               case Get_Kind (Decl) is
+                  when Iir_Kind_Function_Declaration
+                    | Iir_Kind_Procedure_Declaration =>
+                     Bod := Get_Subprogram_Body (Decl);
+                  when Iir_Kind_Package_Declaration =>
+                     Bod := Get_Package_Body (Decl);
+                  when Iir_Kind_Type_Declaration =>
+                     Decl := Get_Type (Decl);
+                     case Get_Kind (Decl) is
+                        when Iir_Kind_Protected_Type_Declaration =>
+                           Bod := Get_Protected_Type_Body (Decl);
+                        when Iir_Kind_Incomplete_Type_Definition =>
+                           Bod := Get_Type_Declarator (Decl);
+                        when others =>
+                           Bod := Null_Iir;
+                     end case;
+                  when others =>
+                     Bod := Null_Iir;
+               end case;
+               if Bod /= Null_Iir then
+                  Disp_Href (Get_Location (Bod));
+               end if;
+               Put (">");
+               Disp_Text;
+               Put ("</a>");
+            when Xref_Ref
+              | Xref_End =>
+               Decl := Get_Xref_Node (Ref);
+               Loc := Get_Location (Decl);
+               if Loc /= Location_Nil then
+                  Put ("<a");
+                  Disp_Href (Loc);
+                  Put (">");
+                  Disp_Text;
+                  Put ("</a>");
+               else
+                  --  This may happen for overload list, in use clauses.
+                  Disp_Text;
+               end if;
+            when Xref_Body =>
+               Put ("<a");
+               Disp_Anchor (Loc);
+               Disp_Href (Get_Location (Get_Xref_Node (Ref)));
+               Put (">");
+               Disp_Text;
+               Put ("</a>");
+         end case;
+      end Disp_Identifier;
+
+      procedure Disp_Attribute
+      is
+         use Xrefs;
+         Ref : Xref;
+         Decl : Iir;
+         Loc : Location_Type;
+      begin
+         Disp_Spaces;
+         if Flags.Flag_Xref then
+            Loc := File_Pos_To_Location (File, Bef_Tok);
+            Ref := Find (Loc);
+         else
+            Ref := Bad_Xref;
+         end if;
+         if Ref = Bad_Xref then
+            case Html_Format is
+               when Html_2 =>
+                  Put ("<font color=orange>");
+                  Disp_Text;
+                  Put ("</font>");
+               when Html_Css =>
+                  Put ("<var>");
+                  Disp_Text;
+                  Put ("</var>");
+            end case;
+         else
+            Decl := Get_Xref_Node (Ref);
+            Loc := Get_Location (Decl);
+            Put ("<a");
+            Disp_Href (Loc);
+            Put (">");
+            Disp_Text;
+            Put ("</a>");
+         end if;
+      end Disp_Attribute;
+   begin
+      Scanner.Flag_Comment := True;
+      Scanner.Flag_Newline := True;
+
+      Set_File (File);
+      Buf := Get_File_Source (File);
+
+      Put_Line ("<pre>");
+      Line := 1;
+      Disp_Ln;
+      Last_Tok := Source_Ptr_Org;
+      Prev_Tok := Tok_Invalid;
+      loop
+         Scan;
+         Bef_Tok := Get_Token_Position;
+         Aft_Tok := Get_Position;
+         case Current_Token is
+            when Tok_Eof =>
+               exit;
+            when Tok_Newline =>
+               New_Line;
+               Line := Line + 1;
+               Disp_Ln;
+            when Tok_Comment =>
+               Disp_Spaces;
+               case Html_Format is
+                  when Html_2 =>
+                     Put ("<font color=green>");
+                     Disp_Text;
+                     Put ("</font>");
+                  when Html_Css =>
+                     Put ("<tt>");
+                     Disp_Text;
+                     Put ("</tt>");
+               end case;
+            when Tok_Access .. Tok_Elsif
+              | Tok_Entity .. Tok_With
+              | Tok_Mod .. Tok_Rem
+              | Tok_And .. Tok_Not =>
+               Disp_Reserved;
+            when Tok_End =>
+               Disp_Reserved;
+            when Tok_Semi_Colon =>
+               Disp_Spaces;
+               Disp_Text;
+            when Tok_Xnor .. Tok_Ror =>
+               Disp_Reserved;
+            when Tok_Protected =>
+               Disp_Reserved;
+            when Tok_Across .. Tok_Tolerance =>
+               Disp_Reserved;
+            when Tok_Psl_Default
+              | Tok_Psl_Clock
+              | Tok_Psl_Property
+              | Tok_Psl_Sequence
+              | Tok_Psl_Endpoint
+              | Tok_Psl_Assert
+              | Tok_Psl_Cover
+              | Tok_Psl_Boolean
+              | Tok_Psl_Const
+              | Tok_Inf
+              | Tok_Within
+              | Tok_Abort
+              | Tok_Before
+              | Tok_Always
+              | Tok_Never
+              | Tok_Eventually
+              | Tok_Next_A
+              | Tok_Next_E
+              | Tok_Next_Event
+              | Tok_Next_Event_A
+              | Tok_Next_Event_E =>
+               Disp_Spaces;
+               Disp_Text;
+            when Tok_String
+              | Tok_Bit_String
+              | Tok_Character =>
+               Disp_Spaces;
+               case Html_Format is
+                  when Html_2 =>
+                     Put ("<font color=blue>");
+                     Disp_Text;
+                     Put ("</font>");
+                  when Html_Css =>
+                     Put ("<kbd>");
+                     Disp_Text;
+                     Put ("</kbd>");
+               end case;
+            when Tok_Identifier =>
+               if Prev_Tok = Tok_Tick then
+                  Disp_Attribute;
+               else
+                  Disp_Identifier;
+               end if;
+            when Tok_Left_Paren .. Tok_Colon
+              | Tok_Comma .. Tok_Dot
+              | Tok_Equal_Equal
+              | Tok_Integer
+              | Tok_Real
+              | Tok_Equal .. Tok_Slash
+              | Tok_Invalid =>
+               Disp_Spaces;
+               Disp_Text;
+         end case;
+         Last_Tok := Aft_Tok;
+         Prev_Tok := Current_Token;
+      end loop;
+      Close_File;
+      New_Line;
+      Put_Line ("</pre>");
+      Put_Line ("<hr/>");
+   end PP_Html_File;
+
+   procedure Put_Html_Header
+   is
+   begin
+      Put ("<html>");
+      Put_Line (" <head>");
+      case Html_Format is
+         when Html_2 =>
+            null;
+         when Html_Css =>
+            Put_Line (" <link rel=stylesheet type=""text/css""");
+            Put_Line ("  href=""ghdl.css"" title=""default""/>");
+      end case;
+      --Put_Line ("<?xml version=""1.0"" encoding=""utf-8"" ?>");
+      --Put_Line("<!DOCTYPE html PUBLIC ""-//W3C//DTD XHTML 1.0 Strict//EN""");
+      --Put_Line ("""http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd"">");
+      --Put_Line ("<html xmlns=""http://www.w3.org/1999/xhtml"""
+      --         & " xml:lang=""en"">");
+      --Put_Line ("<head>");
+   end Put_Html_Header;
+
+   procedure Put_Css is
+   begin
+      Put_Line ("/* EM is used for reserved words */");
+      Put_Line ("EM { color : red; font-style: normal }");
+      New_Line;
+      Put_Line ("/* TT is used for comments */");
+      Put_Line ("TT { color : green; font-style: normal }");
+      New_Line;
+      Put_Line ("/* KBD is used for literals and strings */");
+      Put_Line ("KBD { color : blue; font-style: normal }");
+      New_Line;
+      Put_Line ("/* I is used for line numbers */");
+      Put_Line ("I { color : gray; font-size: 50% }");
+      New_Line;
+      Put_Line ("/* VAR is used for attributes name */");
+      Put_Line ("VAR { color : orange; font-style: normal }");
+      New_Line;
+      Put_Line ("/* A is used for identifiers.  */");
+      Put_Line ("A { color: blue; font-style: normal;");
+      Put_Line ("    text-decoration: none }");
+   end Put_Css;
+
+   procedure Put_Html_Foot
+   is
+   begin
+      Put_Line ("<p>");
+      Put ("<small>This page was generated using ");
+      Put ("<a href=""http://ghdl.free.fr"">");
+      Put (Version.Ghdl_Release);
+      Put ("</a>, a program written by");
+      Put (" Tristan Gingold");
+      New_Line;
+      Put_Line ("</p>");
+      Put_Line ("</body>");
+      Put_Line ("</html>");
+   end Put_Html_Foot;
+
+   function Create_Output_Filename (Name : String; Num : Natural)
+                                   return String_Acc
+   is
+      --  Position of the extension.  0 if none.
+      Ext_Pos : Natural;
+
+      Num_Str : String := Natural'Image (Num);
+   begin
+      --  Search for the extension.
+      Ext_Pos := 0;
+      for I in reverse Name'Range loop
+         exit when Name (I) = Directory_Separator;
+         if Name (I) = '.' then
+            Ext_Pos := I - 1;
+            exit;
+         end if;
+      end loop;
+      if Ext_Pos = 0 then
+         Ext_Pos := Name'Last;
+      end if;
+      Num_Str (1) := '.';
+      return new String'(Name (Name'First .. Ext_Pos) & Num_Str & ".html");
+   end Create_Output_Filename;
+
+   --  Command --chop.
+   type Command_Chop is new Command_Lib with null record;
+   function Decode_Command (Cmd : Command_Chop; Name : String)
+                           return Boolean;
+   function Get_Short_Help (Cmd : Command_Chop) return String;
+   procedure Perform_Action (Cmd : in out Command_Chop;
+                             Args : Argument_List);
+
+   function Decode_Command (Cmd : Command_Chop; Name : String)
+                           return Boolean
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return Name = "--chop";
+   end Decode_Command;
+
+   function Get_Short_Help (Cmd : Command_Chop) return String
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return "--chop [OPTS] FILEs  Chop FILEs";
+   end Get_Short_Help;
+
+   procedure Perform_Action (Cmd : in out Command_Chop; Args : Argument_List)
+   is
+      pragma Unreferenced (Cmd);
+      use Ada.Characters.Latin_1;
+
+      function Build_File_Name_Length (Lib : Iir) return Natural
+      is
+         Id : constant Name_Id := Get_Identifier (Lib);
+         Len : Natural;
+         Id1 : Name_Id;
+      begin
+         Len := Get_Name_Length (Id);
+         case Get_Kind (Lib) is
+            when Iir_Kind_Configuration_Declaration
+              | Iir_Kind_Entity_Declaration
+              | Iir_Kind_Package_Declaration
+              | Iir_Kind_Package_Instantiation_Declaration =>
+               null;
+            when Iir_Kind_Package_Body =>
+               Len := Len + 1 + 4; -- add -body
+            when Iir_Kind_Architecture_Body =>
+               Id1 := Get_Entity_Identifier_Of_Architecture (Lib);
+               Len := Len + 1 + Get_Name_Length (Id1);
+            when others =>
+               Error_Kind ("build_file_name", Lib);
+         end case;
+         Len := Len + 1 + 4; --  add .vhdl
+         return Len;
+      end Build_File_Name_Length;
+
+      procedure Build_File_Name (Lib : Iir; Res : out String)
+      is
+         Id : constant Name_Id := Get_Identifier (Lib);
+         P : Natural;
+
+         procedure Append (Str : String) is
+         begin
+            Res (P + 1 .. P + Str'Length) := Str;
+            P := P + Str'Length;
+         end Append;
+      begin
+         P := Res'First - 1;
+         case Get_Kind (Lib) is
+            when Iir_Kind_Configuration_Declaration
+              | Iir_Kind_Entity_Declaration
+              | Iir_Kind_Package_Declaration
+              | Iir_Kind_Package_Instantiation_Declaration =>
+               Image (Id);
+               Append (Name_Buffer (1 .. Name_Length));
+            when Iir_Kind_Package_Body =>
+               Image (Id);
+               Append (Name_Buffer (1 .. Name_Length));
+               Append ("-body");
+            when Iir_Kind_Architecture_Body =>
+               Image (Get_Entity_Identifier_Of_Architecture (Lib));
+               Append (Name_Buffer (1 .. Name_Length));
+               Append ("-");
+               Image (Id);
+               Append (Name_Buffer (1 .. Name_Length));
+            when others =>
+               raise Internal_Error;
+         end case;
+         Append (".vhdl");
+      end Build_File_Name;
+
+      --  Scan source file BUF+START until end of line.
+      --  Return line kind to KIND and position of next line to NEXT.
+      type Line_Type is (Line_Blank, Line_Comment, Line_Text);
+      procedure Find_Eol (Buf : File_Buffer_Acc;
+                          Start : Source_Ptr;
+                          Next : out Source_Ptr;
+                          Kind : out Line_Type)
+      is
+         P : Source_Ptr;
+      begin
+         P := Start;
+
+         Kind := Line_Blank;
+
+         --  Skip blanks.
+         while Buf (P) = ' ' or Buf (P) = HT loop
+            P := P + 1;
+         end loop;
+
+         --  Skip comment if any.
+         if Buf (P) = '-' and Buf (P + 1) = '-' then
+            Kind := Line_Comment;
+            P := P + 2;
+         elsif Buf (P) /= CR and Buf (P) /= LF and Buf (P) /= EOT then
+            Kind := Line_Text;
+         end if;
+
+         --  Skip until end of line.
+         while Buf (P) /= CR and Buf (P) /= LF and Buf (P) /= EOT loop
+            P := P + 1;
+         end loop;
+
+         if Buf (P) = CR then
+            P := P + 1;
+            if Buf (P) = LF then
+               P := P + 1;
+            end if;
+         elsif Buf (P) = LF then
+            P := P + 1;
+            if Buf (P) = CR then
+               P := P + 1;
+            end if;
+         end if;
+
+         Next := P;
+      end Find_Eol;
+
+      Id : Name_Id;
+      Design_File : Iir_Design_File;
+      Unit : Iir;
+      Lib : Iir;
+      Len : Natural;
+   begin
+      Flags.Bootstrap := True;
+      --  Load word library.
+      Libraries.Load_Std_Library;
+      Libraries.Load_Work_Library;
+
+      --  First loop: parse source file, check destination file does not
+      --  exist.
+      for I in Args'Range loop
+         Id := Get_Identifier (Args (I).all);
+         Design_File := Libraries.Load_File (Id);
+         if Design_File = Null_Iir then
+            raise Compile_Error;
+         end if;
+         Unit := Get_First_Design_Unit (Design_File);
+         while Unit /= Null_Iir loop
+            Lib := Get_Library_Unit (Unit);
+            Len := Build_File_Name_Length (Lib);
+            declare
+               Filename : String (1 .. Len + 1);
+            begin
+               Build_File_Name (Lib, Filename);
+               Filename (Len + 1) := Ghdllocal.Nul;
+               if Is_Regular_File (Filename) then
+                  Error ("file '" & Filename (1 .. Len) & "' already exists");
+                  raise Compile_Error;
+               end if;
+               Put (Filename (1 .. Len));
+               Put ("  (for ");
+               Disp_Library_Unit (Lib);
+               Put (")");
+               New_Line;
+            end;
+            Unit := Get_Chain (Unit);
+         end loop;
+      end loop;
+
+      --  Second loop: do the real work.
+      for I in Args'Range loop
+         Id := Get_Identifier (Args (I).all);
+         Design_File := Libraries.Load_File (Id);
+         Unit := Get_First_Design_Unit (Design_File);
+         declare
+            use Files_Map;
+
+            File_Entry : Source_File_Entry;
+            Buffer : File_Buffer_Acc;
+
+            Start : Source_Ptr;
+            Lend : Source_Ptr;
+            First : Source_Ptr;
+            Next : Source_Ptr;
+            Kind : Line_Type;
+         begin
+            --  A design_file must have at least one design unit.
+            if Unit = Null_Iir then
+               raise Compile_Error;
+            end if;
+
+            Location_To_File_Pos
+              (Get_Location (Unit), File_Entry, Start);
+            Buffer := Get_File_Source (File_Entry);
+
+            First := Source_Ptr_Org;
+            if Get_Chain (Unit) /= Null_Iir then
+               --  If there is only one unit, then the whole file is written.
+               --  First last blank line.
+               Next := Source_Ptr_Org;
+               loop
+                  Start := Next;
+                  Find_Eol (Buffer, Start, Next, Kind);
+                  exit when Kind = Line_Text;
+                  if Kind = Line_Blank then
+                     First := Next;
+                  end if;
+               end loop;
+
+               --  FIXME: write header.
+            end if;
+
+            while Unit /= Null_Iir loop
+               Lib := Get_Library_Unit (Unit);
+
+               Location_To_File_Pos
+                 (Get_End_Location (Unit), File_Entry, Lend);
+               if Lend < First then
+                  raise Internal_Error;
+               end if;
+
+               Location_To_File_Pos
+                 (Get_End_Location (Unit), File_Entry, Lend);
+               --  Find the ';'.
+               while Buffer (Lend) /= ';' loop
+                  Lend := Lend + 1;
+               end loop;
+               Lend := Lend + 1;
+               --  Find end of line.
+               Find_Eol (Buffer, Lend, Next, Kind);
+               if Kind = Line_Text then
+                  --  There is another unit on the same line.
+                  Next := Lend;
+                  --  Skip blanks.
+                  while Buffer (Next) = ' ' or Buffer (Next) = HT loop
+                     Next := Next + 1;
+                  end loop;
+               else
+                  --  Find first blank line.
+                  loop
+                     Start := Next;
+                     Find_Eol (Buffer, Start, Next, Kind);
+                     exit when Kind /= Line_Comment;
+                  end loop;
+                  if Kind = Line_Text then
+                     --  There is not blank lines.
+                     --  All the comments are supposed to belong to the next
+                     --  unit.
+                     Find_Eol (Buffer, Lend, Next, Kind);
+                     Lend := Next;
+                  else
+                     Lend := Start;
+                  end if;
+               end if;
+
+               if Get_Chain (Unit) = Null_Iir then
+                  --  Last unit.
+                  --  Put the end of the file in it.
+                  Lend := Get_File_Length (File_Entry);
+               end if;
+
+               --  FIXME: file with only one unit.
+               --  FIXME: set extension.
+               Len := Build_File_Name_Length (Lib);
+               declare
+                  Filename : String (1 .. Len + 1);
+                  Fd : File_Descriptor;
+
+                  Wlen : Integer;
+               begin
+                  Build_File_Name (Lib, Filename);
+                  Filename (Len + 1) := Character'Val (0);
+                  Fd := Create_File (Filename, Binary);
+                  if Fd = Invalid_FD then
+                     Error
+                       ("cannot create file '" & Filename (1 .. Len) & "'");
+                     raise Compile_Error;
+                  end if;
+                  Wlen := Integer (Lend - First);
+                  if Write (Fd, Buffer (First)'Address, Wlen) /= Wlen then
+                     Error ("cannot write to '" & Filename (1 .. Len) & "'");
+                     raise Compile_Error;
+                  end if;
+                  Close (Fd);
+               end;
+               First := Next;
+
+               Unit := Get_Chain (Unit);
+            end loop;
+         end;
+      end loop;
+   end Perform_Action;
+
+   --  Command --lines.
+   type Command_Lines is new Command_Lib with null record;
+   function Decode_Command (Cmd : Command_Lines; Name : String)
+                           return Boolean;
+   function Get_Short_Help (Cmd : Command_Lines) return String;
+   procedure Perform_Action (Cmd : in out Command_Lines;
+                             Args : Argument_List);
+
+   function Decode_Command (Cmd : Command_Lines; Name : String)
+                           return Boolean
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return Name = "--lines";
+   end Decode_Command;
+
+   function Get_Short_Help (Cmd : Command_Lines) return String
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return "--lines FILEs      Precede line with its number";
+   end Get_Short_Help;
+
+   procedure Perform_Action (Cmd : in out Command_Lines; Args : Argument_List)
+   is
+      pragma Unreferenced (Cmd);
+      use Scanner;
+      use Tokens;
+      use Files_Map;
+      use Ada.Characters.Latin_1;
+
+      Id : Name_Id;
+      Fe : Source_File_Entry;
+      Local_Id : Name_Id;
+      Line : Natural;
+      File : Source_File_Entry;
+      Buf : File_Buffer_Acc;
+      Ptr : Source_Ptr;
+      Eptr : Source_Ptr;
+      C : Character;
+      N : Natural;
+      Log : Natural;
+      Str : String (1 .. 10);
+   begin
+      Local_Id := Get_Identifier ("");
+      for I in Args'Range loop
+         --  Load the file.
+         Id := Get_Identifier (Args (I).all);
+         Fe := Files_Map.Load_Source_File (Local_Id, Id);
+         if Fe = No_Source_File_Entry then
+            Error ("cannot open file " & Args (I).all);
+            raise Compile_Error;
+         end if;
+         Set_File (Fe);
+
+         --  Scan the content, to compute the number of lines.
+         loop
+            Scan;
+            exit when Current_Token = Tok_Eof;
+         end loop;
+         File := Get_Current_Source_File;
+         Line := Get_Current_Line;
+         Close_File;
+
+         --  Compute log10 of line.
+         N := Line;
+         Log := 0;
+         loop
+            N := N / 10;
+            Log := Log + 1;
+            exit when N = 0;
+         end loop;
+
+         --  Disp file name.
+         Put (Args (I).all);
+         Put (':');
+         New_Line;
+
+         Buf := Get_File_Source (File);
+         for J in 1 .. Line loop
+            Ptr := Line_To_Position (File, J);
+            exit when Ptr = Source_Ptr_Bad;
+            exit when Buf (Ptr) = Files_Map.EOT;
+
+            --  Disp line number.
+            N := J;
+            for K in reverse 1 .. Log loop
+               if N = 0 then
+                  Str (K) := ' ';
+               else
+                  Str (K) := Character'Val (48 + N mod 10);
+                  N := N / 10;
+               end if;
+            end loop;
+            Put (Str (1 .. Log));
+            Put (": ");
+
+            --  Search for end of line (or end of file).
+            Eptr := Ptr;
+            loop
+               C := Buf (Eptr);
+               exit when C = Files_Map.EOT or C = LF or C = CR;
+               Eptr := Eptr + 1;
+            end loop;
+
+            --  Disp line.
+            if Eptr > Ptr then
+               --  Avoid constraint error on conversion of nul array.
+               Put (String (Buf (Ptr .. Eptr - 1)));
+            end if;
+            New_Line;
+         end loop;
+      end loop;
+   end Perform_Action;
+
+   --  Command Reprint.
+   type Command_Reprint is new Command_Lib with null record;
+   function Decode_Command (Cmd : Command_Reprint; Name : String)
+                           return Boolean;
+   function Get_Short_Help (Cmd : Command_Reprint) return String;
+   procedure Perform_Action (Cmd : in out Command_Reprint;
+                             Args : Argument_List);
+
+   function Decode_Command (Cmd : Command_Reprint; Name : String)
+                           return Boolean
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return Name = "--reprint";
+   end Decode_Command;
+
+   function Get_Short_Help (Cmd : Command_Reprint) return String
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return "--reprint [OPTS] FILEs    Redisplay FILEs";
+   end Get_Short_Help;
+
+   procedure Perform_Action (Cmd : in out Command_Reprint;
+                             Args : Argument_List)
+   is
+      pragma Unreferenced (Cmd);
+      Design_File : Iir_Design_File;
+      Unit : Iir;
+
+      Id : Name_Id;
+      Next_Unit : Iir;
+   begin
+      Setup_Libraries (True);
+      Parse.Flag_Parse_Parenthesis := True;
+
+      --  Parse all files.
+      for I in Args'Range loop
+         Id := Name_Table.Get_Identifier (Args (I).all);
+         Design_File := Libraries.Load_File (Id);
+         if Design_File = Null_Iir then
+            raise Errorout.Compilation_Error;
+         end if;
+
+         Unit := Get_First_Design_Unit (Design_File);
+         while Unit /= Null_Iir loop
+            --  Analyze the design unit.
+            Back_End.Finish_Compilation (Unit, True);
+
+            Next_Unit := Get_Chain (Unit);
+            if Errorout.Nbr_Errors = 0 then
+               Disp_Vhdl.Disp_Vhdl (Unit);
+               Set_Chain (Unit, Null_Iir);
+               Libraries.Add_Design_Unit_Into_Library (Unit);
+            end if;
+
+            Unit := Next_Unit;
+         end loop;
+
+         if Errorout.Nbr_Errors > 0 then
+            raise Errorout.Compilation_Error;
+         end if;
+      end loop;
+   end Perform_Action;
+
+   --  Command compare tokens.
+   type Command_Compare_Tokens is new Command_Lib with null record;
+   function Decode_Command (Cmd : Command_Compare_Tokens; Name : String)
+                           return Boolean;
+   function Get_Short_Help (Cmd : Command_Compare_Tokens) return String;
+   procedure Perform_Action (Cmd : in out Command_Compare_Tokens;
+                             Args : Argument_List);
+
+   function Decode_Command (Cmd : Command_Compare_Tokens; Name : String)
+                           return Boolean
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return Name = "--compare-tokens";
+   end Decode_Command;
+
+   function Get_Short_Help (Cmd : Command_Compare_Tokens) return String
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return "--compare-tokens [OPTS] REF FILEs    Compare FILEs with REF";
+   end Get_Short_Help;
+
+   procedure Perform_Action (Cmd : in out Command_Compare_Tokens;
+                             Args : Argument_List)
+   is
+      pragma Unreferenced (Cmd);
+      use Tokens;
+      use Scanner;
+
+      package Ref_Tokens is new GNAT.Table
+        (Table_Component_Type => Token_Type,
+         Table_Index_Type => Integer,
+         Table_Low_Bound => 0,
+         Table_Initial => 1024,
+         Table_Increment => 100);
+
+      Id : Name_Id;
+      Fe : Source_File_Entry;
+      Local_Id : Name_Id;
+      Tok_Idx : Natural;
+   begin
+      if Args'Length < 1 then
+         Error ("missing ref file");
+         raise Compile_Error;
+      end if;
+
+      Local_Id := Get_Identifier ("");
+
+      for I in Args'Range loop
+         --  Load the file.
+         Id := Get_Identifier (Args (I).all);
+         Fe := Files_Map.Load_Source_File (Local_Id, Id);
+         if Fe = No_Source_File_Entry then
+            Error ("cannot open file " & Args (I).all);
+            raise Compile_Error;
+         end if;
+         Set_File (Fe);
+
+         if I = Args'First then
+            --  Scan ref file
+            loop
+               Scan;
+               Ref_Tokens.Append (Current_Token);
+               exit when Current_Token = Tok_Eof;
+            end loop;
+         else
+            --  Scane file
+            Tok_Idx := Ref_Tokens.First;
+            loop
+               Scan;
+               if Ref_Tokens.Table (Tok_Idx) /= Current_Token then
+                  Error_Msg_Parse ("token mismatch");
+                  exit;
+               end if;
+               case Current_Token is
+                  when Tok_Eof =>
+                     exit;
+                  when others =>
+                     null;
+               end case;
+               Tok_Idx := Tok_Idx + 1;
+            end loop;
+         end if;
+         Close_File;
+      end loop;
+
+      Ref_Tokens.Free;
+
+      if Nbr_Errors /= 0 then
+         raise Compilation_Error;
+      end if;
+   end Perform_Action;
+
+   --  Command html.
+   type Command_Html is abstract new Command_Lib with null record;
+
+   procedure Decode_Option (Cmd : in out Command_Html;
+                            Option : String;
+                            Arg : String;
+                            Res : out Option_Res);
+
+   procedure Disp_Long_Help (Cmd : Command_Html);
+
+   procedure Decode_Option (Cmd : in out Command_Html;
+                            Option : String;
+                            Arg : String;
+                            Res : out Option_Res)
+   is
+   begin
+      if Option = "--format=css" then
+         Html_Format := Html_Css;
+         Res := Option_Ok;
+      elsif Option = "--format=html2" then
+         Html_Format := Html_2;
+         Res := Option_Ok;
+      else
+         Decode_Option (Command_Lib (Cmd), Option, Arg, Res);
+      end if;
+   end Decode_Option;
+
+   procedure Disp_Long_Help (Cmd : Command_Html) is
+   begin
+      Disp_Long_Help (Command_Lib (Cmd));
+      Put_Line ("--format=html2  Use FONT attributes");
+      Put_Line ("--format=css    Use ghdl.css file");
+   end Disp_Long_Help;
+
+   --  Command --pp-html.
+   type Command_PP_Html is new Command_Html with null record;
+   function Decode_Command (Cmd : Command_PP_Html; Name : String)
+                           return Boolean;
+   function Get_Short_Help (Cmd : Command_PP_Html) return String;
+   procedure Perform_Action (Cmd : in out Command_PP_Html;
+                             Files : Argument_List);
+
+   function Decode_Command (Cmd : Command_PP_Html; Name : String)
+                           return Boolean
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return Name = "--pp-html";
+   end Decode_Command;
+
+   function Get_Short_Help (Cmd : Command_PP_Html) return String
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return "--pp-html FILEs    Pretty-print FILEs in HTML";
+   end Get_Short_Help;
+
+   procedure Perform_Action (Cmd : in out Command_PP_Html;
+                             Files : Argument_List)
+   is
+      pragma Unreferenced (Cmd);
+      use Scanner;
+      use Tokens;
+      use Files_Map;
+      use Ada.Characters.Latin_1;
+
+      Id : Name_Id;
+      Fe : Source_File_Entry;
+      Local_Id : Name_Id;
+   begin
+      Local_Id := Get_Identifier ("");
+      Put_Html_Header;
+      Put_Line ("  <title>");
+      for I in Files'Range loop
+         Put ("    ");
+         Put_Line (Files (I).all);
+      end loop;
+      Put_Line ("  </title>");
+      Put_Line ("</head>");
+      New_Line;
+      Put_Line ("<body>");
+
+      for I in Files'Range loop
+         Id := Get_Identifier (Files (I).all);
+         Fe := Files_Map.Load_Source_File (Local_Id, Id);
+         if Fe = No_Source_File_Entry then
+            Error ("cannot open file " & Files (I).all);
+            raise Compile_Error;
+         end if;
+         Put ("  <h1>");
+         Put (Files (I).all);
+         Put ("</h1>");
+         New_Line;
+
+         PP_Html_File (Fe);
+      end loop;
+      Put_Html_Foot;
+   end Perform_Action;
+
+   --  Command --xref-html.
+   type Command_Xref_Html is new Command_Html with record
+      Output_Dir : String_Access := null;
+      Check_Missing : Boolean := False;
+   end record;
+
+   function Decode_Command (Cmd : Command_Xref_Html; Name : String)
+                           return Boolean;
+   function Get_Short_Help (Cmd : Command_Xref_Html) return String;
+   procedure Decode_Option (Cmd : in out Command_Xref_Html;
+                            Option : String;
+                            Arg : String;
+                            Res : out Option_Res);
+   procedure Disp_Long_Help (Cmd : Command_Xref_Html);
+
+   procedure Perform_Action (Cmd : in out Command_Xref_Html;
+                             Files_Name : Argument_List);
+
+   function Decode_Command (Cmd : Command_Xref_Html; Name : String)
+                           return Boolean
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return Name = "--xref-html";
+   end Decode_Command;
+
+   function Get_Short_Help (Cmd : Command_Xref_Html) return String
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return "--xref-html FILEs  Display FILEs in HTML with xrefs";
+   end Get_Short_Help;
+
+   procedure Decode_Option (Cmd : in out Command_Xref_Html;
+                            Option : String;
+                            Arg : String;
+                            Res : out Option_Res)
+   is
+   begin
+      if Option = "-o" then
+         if Arg = "" then
+            Res := Option_Arg_Req;
+         else
+            Cmd.Output_Dir := new String'(Arg);
+            Res := Option_Arg;
+         end if;
+      elsif Option = "--check-missing" then
+         Cmd.Check_Missing := True;
+         Res := Option_Ok;
+      else
+         Decode_Option (Command_Html (Cmd), Option, Arg, Res);
+      end if;
+   end Decode_Option;
+
+   procedure Disp_Long_Help (Cmd : Command_Xref_Html) is
+   begin
+      Disp_Long_Help (Command_Html (Cmd));
+      Put_Line ("-o DIR          Put generated files into DIR (def: html/)");
+      Put_Line ("--check-missing Fail if a reference is missing");
+      New_Line;
+      Put_Line ("When format is css, the CSS file 'ghdl.css' "
+                & "is never overwritten.");
+   end Disp_Long_Help;
+
+   procedure Analyze_Design_File_Units (File : Iir_Design_File)
+   is
+      Unit : Iir_Design_Unit;
+   begin
+      Unit := Get_First_Design_Unit (File);
+      while Unit /= Null_Iir loop
+         case Get_Date_State (Unit) is
+            when Date_Extern
+              | Date_Disk =>
+               raise Internal_Error;
+            when Date_Parse =>
+               Libraries.Load_Design_Unit (Unit, Null_Iir);
+            when Date_Analyze =>
+               null;
+         end case;
+         Unit := Get_Chain (Unit);
+      end loop;
+   end Analyze_Design_File_Units;
+
+   procedure Perform_Action
+     (Cmd : in out Command_Xref_Html; Files_Name : Argument_List)
+   is
+      use GNAT.Directory_Operations;
+
+      Id : Name_Id;
+      File : Source_File_Entry;
+
+      type File_Data is record
+         Fe : Source_File_Entry;
+         Design_File : Iir;
+         Output : String_Acc;
+      end record;
+      type File_Data_Array is array (Files_Name'Range) of File_Data;
+
+      Files : File_Data_Array;
+      Output : File_Type;
+   begin
+      Xrefs.Init;
+      Flags.Flag_Xref := True;
+
+      --  Load work library.
+      Setup_Libraries (True);
+
+      if Cmd.Output_Dir = null then
+         Cmd.Output_Dir := new String'("html");
+      elsif Cmd.Output_Dir.all = "-" then
+         Cmd.Output_Dir := null;
+      end if;
+
+      --  Try to create the directory.
+      if Cmd.Output_Dir /= null
+        and then not Is_Directory (Cmd.Output_Dir.all)
+      then
+         declare
+         begin
+            Make_Dir (Cmd.Output_Dir.all);
+         exception
+            when Directory_Error =>
+               Error ("cannot create directory " & Cmd.Output_Dir.all);
+               return;
+         end;
+      end if;
+
+      --  Parse all files.
+      for I in Files'Range loop
+         Id := Get_Identifier (Files_Name (I).all);
+         File := Files_Map.Load_Source_File (Libraries.Local_Directory, Id);
+         if File = No_Source_File_Entry then
+            Error ("cannot open " & Image (Id));
+            return;
+         end if;
+         Files (I).Fe := File;
+         Files (I).Design_File := Libraries.Load_File (File);
+         if Files (I).Design_File = Null_Iir then
+            return;
+         end if;
+         Files (I).Output := Create_Output_Filename
+           (Base_Name (Files_Name (I).all), I);
+         if Is_Regular_File (Files (I).Output.all) then
+            --  Prevent overwrite.
+            null;
+         end if;
+         --  Put units in library.
+         Libraries.Add_Design_File_Into_Library (Files (I).Design_File);
+      end loop;
+
+      --  Analyze all files.
+      for I in Files'Range loop
+         Analyze_Design_File_Units (Files (I).Design_File);
+      end loop;
+
+      Xrefs.Sort_By_Location;
+
+      if False then
+         for I in 1 .. Xrefs.Get_Last_Xref loop
+            declare
+               use Xrefs;
+
+               procedure Put_Loc (L : Location_Type)
+               is
+                  use Files_Map;
+
+                  L_File : Source_File_Entry;
+                  L_Pos : Source_Ptr;
+               begin
+                  Files_Map.Location_To_File_Pos (L, L_File, L_Pos);
+                  Put_Nat (Natural (L_File));
+                  --Image (Get_File_Name (L_File));
+                  --Put (Name_Buffer (1 .. Name_Length));
+                  Put (":");
+                  Put_Nat (Natural (L_Pos));
+               end Put_Loc;
+            begin
+               Put_Loc (Get_Xref_Location (I));
+               case Get_Xref_Kind (I) is
+                  when Xref_Decl =>
+                     Put (" decl ");
+                     Put (Image (Get_Identifier (Get_Xref_Node (I))));
+                  when Xref_Ref =>
+                     Put (" use ");
+                     Put_Loc (Get_Location (Get_Xref_Node (I)));
+                  when Xref_End =>
+                     Put (" end ");
+                  when Xref_Body =>
+                     Put (" body ");
+               end case;
+               New_Line;
+            end;
+         end loop;
+      end if;
+
+      --  Create filexref_info.
+      Filexref_Info := new Filexref_Info_Arr
+        (No_Source_File_Entry .. Files_Map.Get_Last_Source_File_Entry);
+      Filexref_Info.all := (others => (Output => null,
+                                       Referenced => False));
+      for I in Files'Range loop
+         Filexref_Info (Files (I).Fe).Output := Files (I).Output;
+      end loop;
+
+      for I in Files'Range loop
+         if Cmd.Output_Dir /= null then
+            Create (Output, Out_File,
+                    Cmd.Output_Dir.all & Directory_Separator
+                    & Files (I).Output.all);
+
+            Set_Output (Output);
+         end if;
+
+         Put_Html_Header;
+         Put_Line ("  <title>");
+         Put_Html (Files_Name (I).all);
+         Put ("</title>");
+         Put_Line ("</head>");
+         New_Line;
+         Put_Line ("<body>");
+
+         Put ("<h1>");
+         Put_Html (Files_Name (I).all);
+         Put ("</h1>");
+         New_Line;
+
+         PP_Html_File (Files (I).Fe);
+         Put_Html_Foot;
+
+         if Cmd.Output_Dir /= null then
+            Close (Output);
+         end if;
+      end loop;
+
+      --  Create indexes.
+      if Cmd.Output_Dir /= null then
+         Create (Output, Out_File,
+                 Cmd.Output_Dir.all & Directory_Separator & "index.html");
+         Set_Output (Output);
+
+         Put_Html_Header;
+         Put_Line ("  <title>Xrefs indexes</title>");
+         Put_Line ("</head>");
+         New_Line;
+         Put_Line ("<body>");
+         Put_Line ("<p>list of files:");
+         Put_Line ("<ul>");
+         for I in Files'Range loop
+            Put ("<li>");
+            Put ("<a href=""");
+            Put (Files (I).Output.all);
+            Put (""">");
+            Put_Html (Files_Name (I).all);
+            Put ("</a>");
+            Put ("</li>");
+            New_Line;
+         end loop;
+         Put_Line ("</ul></p>");
+         Put_Line ("<hr>");
+
+         --  TODO: list of design units.
+
+         Put_Line ("<p>list of files referenced but not available:");
+         Put_Line ("<ul>");
+         for I in No_Source_File_Entry + 1 .. Filexref_Info'Last loop
+            if Filexref_Info (I).Output = null
+              and then Filexref_Info (I).Referenced
+            then
+               Put ("<li><a name=""f");
+               Put_Nat (Natural (I));
+               Put (""">");
+               Put_Html (Image (Files_Map.Get_File_Name (I)));
+               Put ("</a></li>");
+               New_Line;
+            end if;
+         end loop;
+         Put_Line ("</ul></p><hr>");
+         Put_Html_Foot;
+
+         Close (Output);
+      end if;
+
+      if Html_Format = Html_Css
+        and then Cmd.Output_Dir /= null
+      then
+         declare
+            Css_Filename : constant String :=
+              Cmd.Output_Dir.all & Directory_Separator & "ghdl.css";
+         begin
+            if not Is_Regular_File (Css_Filename & Nul) then
+               Create (Output, Out_File, Css_Filename);
+               Set_Output (Output);
+               Put_Css;
+               Close (Output);
+            end if;
+         end;
+      end if;
+
+      if Missing_Xref and Cmd.Check_Missing then
+         Error ("missing xrefs");
+         raise Compile_Error;
+      end if;
+   exception
+      when Compilation_Error =>
+         Error ("xrefs has failed due to compilation error");
+   end Perform_Action;
+
+
+   --  Command --xref
+   type Command_Xref is new Command_Lib with null record;
+
+   function Decode_Command (Cmd : Command_Xref; Name : String)
+                           return Boolean;
+   function Get_Short_Help (Cmd : Command_Xref) return String;
+
+   procedure Perform_Action (Cmd : in out Command_Xref;
+                             Files_Name : Argument_List);
+
+   function Decode_Command (Cmd : Command_Xref; Name : String)
+                           return Boolean
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return Name = "--xref";
+   end Decode_Command;
+
+   function Get_Short_Help (Cmd : Command_Xref) return String
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return "--xref FILEs  Generate xrefs";
+   end Get_Short_Help;
+
+   procedure Perform_Action
+     (Cmd : in out Command_Xref; Files_Name : Argument_List)
+   is
+      pragma Unreferenced (Cmd);
+
+      use Files_Map;
+
+      Id : Name_Id;
+      File : Source_File_Entry;
+
+      type File_Data is record
+         Fe : Source_File_Entry;
+         Design_File : Iir;
+      end record;
+      type File_Data_Array is array (Files_Name'Range) of File_Data;
+
+      Files : File_Data_Array;
+   begin
+      --  Load work library.
+      Setup_Libraries (True);
+
+      Xrefs.Init;
+      Flags.Flag_Xref := True;
+
+      --  Parse all files.
+      for I in Files'Range loop
+         Id := Get_Identifier (Files_Name (I).all);
+         File := Load_Source_File (Libraries.Local_Directory, Id);
+         if File = No_Source_File_Entry then
+            Error ("cannot open " & Image (Id));
+            return;
+         end if;
+         Files (I).Fe := File;
+         Files (I).Design_File := Libraries.Load_File (File);
+         if Files (I).Design_File = Null_Iir then
+            return;
+         end if;
+         --  Put units in library.
+         --  Note: design_units stay while design_file get empty.
+         Libraries.Add_Design_File_Into_Library (Files (I).Design_File);
+      end loop;
+
+      --  Analyze all files.
+      for I in Files'Range loop
+         Analyze_Design_File_Units (Files (I).Design_File);
+      end loop;
+
+      Xrefs.Fix_End_Xrefs;
+      Xrefs.Sort_By_Node_Location;
+
+      for F in Files'Range loop
+
+         Put ("GHDL-XREF V0");
+
+         declare
+            use Xrefs;
+
+            Cur_Decl : Iir;
+            Cur_File : Source_File_Entry;
+
+            procedure Emit_Loc (Loc : Location_Type; C : Character)
+            is
+               L_File : Source_File_Entry;
+               L_Pos : Source_Ptr;
+               L_Line : Natural;
+               L_Off : Natural;
+            begin
+               Location_To_Coord (Loc, L_File, L_Pos, L_Line, L_Off);
+               --Put_Nat (Natural (L_File));
+               --Put (':');
+               Put_Nat (L_Line);
+               Put (C);
+               Put_Nat (L_Off);
+            end Emit_Loc;
+
+            procedure Emit_Decl (N : Iir)
+            is
+               Loc : Location_Type;
+               Loc_File : Source_File_Entry;
+               Loc_Pos : Source_Ptr;
+               C : Character;
+               Dir : Name_Id;
+            begin
+               New_Line;
+               Cur_Decl := N;
+               Loc := Get_Location (N);
+               Location_To_File_Pos (Loc, Loc_File, Loc_Pos);
+               if Loc_File /= Cur_File then
+                  Cur_File := Loc_File;
+                  Put ("XFILE: ");
+                  Dir := Get_Source_File_Directory (Cur_File);
+                  if Dir /= Null_Identifier then
+                     Image (Dir);
+                     Put (Name_Buffer (1 .. Name_Length));
+                  end if;
+                  Image (Get_File_Name (Cur_File));
+                  Put (Name_Buffer (1 .. Name_Length));
+                  New_Line;
+               end if;
+
+               --  Letters:
+               --   b d fgh jk  no qr  uvwxyz
+               --     D   H JK MNO QR  U WXYZ
+               case Get_Kind (N) is
+                  when Iir_Kind_Type_Declaration =>
+                     C := 'T';
+                  when Iir_Kind_Subtype_Declaration =>
+                     C := 't';
+                  when Iir_Kind_Entity_Declaration =>
+                     C := 'E';
+                  when Iir_Kind_Architecture_Body =>
+                     C := 'A';
+                  when Iir_Kind_Library_Declaration =>
+                     C := 'L';
+                  when Iir_Kind_Package_Declaration =>
+                     C := 'P';
+                  when Iir_Kind_Package_Body =>
+                     C := 'B';
+                  when Iir_Kind_Function_Declaration =>
+                     C := 'F';
+                  when Iir_Kind_Procedure_Declaration =>
+                     C := 'p';
+                  when Iir_Kind_Interface_Signal_Declaration =>
+                     C := 's';
+                  when Iir_Kind_Signal_Declaration =>
+                     C := 'S';
+                  when Iir_Kind_Interface_Constant_Declaration =>
+                     C := 'c';
+                  when Iir_Kind_Constant_Declaration =>
+                     C := 'C';
+                  when Iir_Kind_Variable_Declaration =>
+                     C := 'V';
+                  when Iir_Kind_Element_Declaration =>
+                     C := 'e';
+                  when Iir_Kind_Iterator_Declaration =>
+                     C := 'i';
+                  when Iir_Kind_Attribute_Declaration =>
+                     C := 'a';
+                  when Iir_Kind_Enumeration_Literal =>
+                     C := 'l';
+                  when Iir_Kind_Component_Declaration =>
+                     C := 'm';
+                  when Iir_Kind_Component_Instantiation_Statement =>
+                     C := 'I';
+                  when Iir_Kind_Generate_Statement =>
+                     C := 'G';
+                  when others =>
+                     C := '?';
+               end case;
+               Emit_Loc (Loc, C);
+               --Disp_Tree.Disp_Iir_Address (N);
+               Put (' ');
+               case Get_Kind (N) is
+                  when Iir_Kind_Function_Body
+                    | Iir_Kind_Procedure_Body =>
+                     null;
+                  when others =>
+                     Image (Get_Identifier (N));
+                     Put (Name_Buffer (1 .. Name_Length));
+               end case;
+            end Emit_Decl;
+
+            procedure Emit_Ref (R : Xref; T : Character)
+            is
+               N : Iir;
+            begin
+               N := Get_Xref_Node (R);
+               if N /= Cur_Decl then
+                  Emit_Decl (N);
+               end if;
+               Put (' ');
+               Emit_Loc (Get_Xref_Location (R), T);
+            end Emit_Ref;
+
+            Loc : Location_Type;
+            Loc_File : Source_File_Entry;
+            Loc_Pos : Source_Ptr;
+         begin
+            Cur_Decl := Null_Iir;
+            Cur_File := No_Source_File_Entry;
+
+            for I in First_Xref .. Get_Last_Xref loop
+               Loc := Get_Xref_Location (I);
+               Location_To_File_Pos (Loc, Loc_File, Loc_Pos);
+               if Loc_File = Files (F).Fe then
+                  --  This is a local location.
+                  case Get_Xref_Kind (I) is
+                     when Xref_Decl =>
+                        Emit_Decl (Get_Xref_Node (I));
+                     when Xref_End =>
+                        Emit_Ref (I, 'e');
+                     when Xref_Ref =>
+                        Emit_Ref (I, 'r');
+                     when Xref_Body =>
+                        Emit_Ref (I, 'b');
+                  end case;
+               end if;
+            end loop;
+            New_Line;
+         end;
+      end loop;
+   exception
+      when Compilation_Error =>
+         Error ("xrefs has failed due to compilation error");
+   end Perform_Action;
+
+   procedure Register_Commands is
+   begin
+      Register_Command (new Command_Chop);
+      Register_Command (new Command_Lines);
+      Register_Command (new Command_Reprint);
+      Register_Command (new Command_Compare_Tokens);
+      Register_Command (new Command_PP_Html);
+      Register_Command (new Command_Xref_Html);
+      Register_Command (new Command_Xref);
+   end Register_Commands;
+end Ghdlprint;
diff --git a/src/ghdldrv/ghdlprint.ads b/src/ghdldrv/ghdlprint.ads
new file mode 100644
index 000000000..82c3e6072
--- /dev/null
+++ b/src/ghdldrv/ghdlprint.ads
@@ -0,0 +1,20 @@
+--  GHDL driver - print commands.
+--  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 Ghdlprint is
+   procedure Register_Commands;
+end Ghdlprint;
diff --git a/src/ghdldrv/ghdlrun.adb b/src/ghdldrv/ghdlrun.adb
new file mode 100644
index 000000000..f6237214e
--- /dev/null
+++ b/src/ghdldrv/ghdlrun.adb
@@ -0,0 +1,661 @@
+--  GHDL driver - JIT commands.
+--  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.C;
+
+with Ghdlmain; use Ghdlmain;
+with Ghdllocal; use Ghdllocal;
+with GNAT.OS_Lib; use GNAT.OS_Lib;
+
+with Ada.Unchecked_Conversion;
+with Ada.Command_Line;
+with Ada.Text_IO;
+
+with Ortho_Jit;
+with Ortho_Nodes; use Ortho_Nodes;
+with Interfaces;
+with System; use System;
+with Trans_Decls;
+with Iirs; use Iirs;
+with Flags;
+with Errorout; use Errorout;
+with Libraries;
+with Canon;
+with Trans_Be;
+with Translation;
+with Ieee.Std_Logic_1164;
+
+with Lists;
+with Str_Table;
+with Nodes;
+with Files_Map;
+with Name_Table;
+
+with Grt.Main;
+with Grt.Modules;
+with Grt.Lib;
+with Grt.Processes;
+with Grt.Rtis;
+with Grt.Files;
+with Grt.Signals;
+with Grt.Options;
+with Grt.Types;
+with Grt.Images;
+with Grt.Values;
+with Grt.Names;
+with Grt.Std_Logic_1164;
+
+with Ghdlcomp;
+with Foreigns;
+with Grtlink;
+
+package body Ghdlrun is
+   procedure Foreign_Hook (Decl : Iir;
+                           Info : Translation.Foreign_Info_Type;
+                           Ortho : O_Dnode);
+
+   procedure Compile_Init (Analyze_Only : Boolean) is
+   begin
+      if Analyze_Only then
+         return;
+      end if;
+
+      Translation.Foreign_Hook := Foreign_Hook'Access;
+
+      --  FIXME: add a flag to force unnesting.
+      --  Translation.Flag_Unnest_Subprograms := True;
+
+      --  The design is always analyzed in whole.
+      Flags.Flag_Whole_Analyze := True;
+
+      Setup_Libraries (False);
+      Libraries.Load_Std_Library;
+
+      Ortho_Jit.Init;
+
+      Translation.Initialize;
+      Canon.Canon_Flag_Add_Labels := True;
+   end Compile_Init;
+
+   procedure Compile_Elab
+     (Cmd_Name : String; Args : Argument_List; Opt_Arg : out Natural)
+   is
+   begin
+      Extract_Elab_Unit (Cmd_Name, Args, Opt_Arg);
+      if Sec_Name = null then
+         Sec_Name := new String'("");
+      end if;
+
+      Flags.Flag_Elaborate := True;
+      Translation.Chap12.Elaborate (Prim_Name.all, Sec_Name.all, "", True);
+
+      if Errorout.Nbr_Errors > 0 then
+         --  This may happen (bad entity for example).
+         raise Compilation_Error;
+      end if;
+   end Compile_Elab;
+
+   --  Set options.
+   --  This is a little bit over-kill: from C to Ada and then again to C...
+   procedure Set_Run_Options (Args : Argument_List)
+   is
+      use Interfaces.C;
+      use Grt.Options;
+      use Grt.Types;
+
+      function Malloc (Size : size_t) return Argv_Type;
+      pragma Import (C, Malloc);
+
+      function Strdup (Str : String) return Ghdl_C_String;
+      pragma Import (C, Strdup);
+--        is
+--           T : Grt.Types.String_Access;
+--        begin
+--           T := new String'(Str & Ghdllocal.Nul);
+--           return To_Ghdl_C_String (T.all'Address);
+--        end Strdup;
+   begin
+      Argc := 1 + Args'Length;
+      Argv := Malloc
+        (size_t (Argc * (Ghdl_C_String'Size / System.Storage_Unit)));
+      Argv (0) := Strdup (Ada.Command_Line.Command_Name & Ghdllocal.Nul);
+      Progname := Argv (0);
+      for I in Args'Range loop
+         Argv (1 + I - Args'First) := Strdup (Args (I).all & Ghdllocal.Nul);
+      end loop;
+   end Set_Run_Options;
+
+   procedure Ghdl_Elaborate;
+   pragma Export (C, Ghdl_Elaborate, "__ghdl_ELABORATE");
+
+   type Elaborate_Acc is access procedure;
+   pragma Convention (C, Elaborate_Acc);
+   Elaborate_Proc : Elaborate_Acc := null;
+
+   procedure Ghdl_Elaborate is
+   begin
+      --Ada.Text_IO.Put_Line (Standard_Error, "ghdl_elaborate");
+      Elaborate_Proc.all;
+   end Ghdl_Elaborate;
+
+   procedure Def (Decl : O_Dnode; Addr : Address)
+     renames Ortho_Jit.Set_Address;
+
+   procedure Foreign_Hook (Decl : Iir;
+                           Info : Translation.Foreign_Info_Type;
+                           Ortho : O_Dnode)
+   is
+      use Translation;
+      Res : Address;
+   begin
+      case Info.Kind is
+         when Foreign_Vhpidirect =>
+            declare
+               Name : constant String :=
+                 Name_Table.Name_Buffer (Info.Subprg_First
+                                           .. Info.Subprg_Last);
+            begin
+               Res := Foreigns.Find_Foreign (Name);
+               if Res /= Null_Address then
+                  Def (Ortho, Res);
+               else
+                  Error_Msg_Sem ("unknown foreign VHPIDIRECT '" & Name & "'",
+                                 Decl);
+               end if;
+            end;
+         when Foreign_Intrinsic =>
+            Name_Table.Image (Get_Identifier (Decl));
+            declare
+               Name : constant String :=
+                 Name_Table.Name_Buffer (1 .. Name_Table.Name_Length);
+            begin
+               if Name = "untruncated_text_read" then
+                  Def (Ortho, Grt.Files.Ghdl_Untruncated_Text_Read'Address);
+               elsif Name = "control_simulation" then
+                  Def (Ortho, Grt.Lib.Ghdl_Control_Simulation'Address);
+               elsif Name = "get_resolution_limit" then
+                  Def (Ortho, Grt.Lib.Ghdl_Get_Resolution_Limit'Address);
+               else
+                  Error_Msg_Sem ("unknown foreign intrinsic '" & Name & "'",
+                                 Decl);
+               end if;
+            end;
+         when Foreign_Unknown =>
+            null;
+      end case;
+   end Foreign_Hook;
+
+   procedure Run
+   is
+      use Interfaces;
+      --use Ortho_Code.Binary;
+
+      function Conv is new Ada.Unchecked_Conversion
+        (Source => Address, Target => Elaborate_Acc);
+      Err : Boolean;
+      Decl : O_Dnode;
+   begin
+      if Flag_Verbose then
+         Ada.Text_IO.Put_Line ("Linking in memory");
+      end if;
+
+      Def (Trans_Decls.Ghdl_Memcpy,
+           Grt.Lib.Ghdl_Memcpy'Address);
+      Def (Trans_Decls.Ghdl_Bound_Check_Failed_L1,
+           Grt.Lib.Ghdl_Bound_Check_Failed_L1'Address);
+      Def (Trans_Decls.Ghdl_Malloc0,
+           Grt.Lib.Ghdl_Malloc0'Address);
+      Def (Trans_Decls.Ghdl_Std_Ulogic_To_Boolean_Array,
+           Grt.Lib.Ghdl_Std_Ulogic_To_Boolean_Array'Address);
+
+      Def (Trans_Decls.Ghdl_Report,
+           Grt.Lib.Ghdl_Report'Address);
+      Def (Trans_Decls.Ghdl_Assert_Failed,
+           Grt.Lib.Ghdl_Assert_Failed'Address);
+      Def (Trans_Decls.Ghdl_Ieee_Assert_Failed,
+           Grt.Lib.Ghdl_Ieee_Assert_Failed'Address);
+      Def (Trans_Decls.Ghdl_Psl_Assert_Failed,
+           Grt.Lib.Ghdl_Psl_Assert_Failed'Address);
+      Def (Trans_Decls.Ghdl_Psl_Cover,
+           Grt.Lib.Ghdl_Psl_Cover'Address);
+      Def (Trans_Decls.Ghdl_Psl_Cover_Failed,
+           Grt.Lib.Ghdl_Psl_Cover_Failed'Address);
+      Def (Trans_Decls.Ghdl_Program_Error,
+           Grt.Lib.Ghdl_Program_Error'Address);
+      Def (Trans_Decls.Ghdl_Malloc,
+           Grt.Lib.Ghdl_Malloc'Address);
+      Def (Trans_Decls.Ghdl_Deallocate,
+           Grt.Lib.Ghdl_Deallocate'Address);
+      Def (Trans_Decls.Ghdl_Real_Exp,
+           Grt.Lib.Ghdl_Real_Exp'Address);
+      Def (Trans_Decls.Ghdl_Integer_Exp,
+           Grt.Lib.Ghdl_Integer_Exp'Address);
+
+      Def (Trans_Decls.Ghdl_Sensitized_Process_Register,
+           Grt.Processes.Ghdl_Sensitized_Process_Register'Address);
+      Def (Trans_Decls.Ghdl_Process_Register,
+           Grt.Processes.Ghdl_Process_Register'Address);
+      Def (Trans_Decls.Ghdl_Postponed_Sensitized_Process_Register,
+           Grt.Processes.Ghdl_Postponed_Sensitized_Process_Register'Address);
+      Def (Trans_Decls.Ghdl_Postponed_Process_Register,
+           Grt.Processes.Ghdl_Postponed_Process_Register'Address);
+      Def (Trans_Decls.Ghdl_Finalize_Register,
+           Grt.Processes.Ghdl_Finalize_Register'Address);
+
+      Def (Trans_Decls.Ghdl_Stack2_Allocate,
+           Grt.Processes.Ghdl_Stack2_Allocate'Address);
+      Def (Trans_Decls.Ghdl_Stack2_Mark,
+           Grt.Processes.Ghdl_Stack2_Mark'Address);
+      Def (Trans_Decls.Ghdl_Stack2_Release,
+           Grt.Processes.Ghdl_Stack2_Release'Address);
+      Def (Trans_Decls.Ghdl_Process_Wait_Exit,
+           Grt.Processes.Ghdl_Process_Wait_Exit'Address);
+      Def (Trans_Decls.Ghdl_Process_Wait_Suspend,
+           Grt.Processes.Ghdl_Process_Wait_Suspend'Address);
+      Def (Trans_Decls.Ghdl_Process_Wait_Timeout,
+           Grt.Processes.Ghdl_Process_Wait_Timeout'Address);
+      Def (Trans_Decls.Ghdl_Process_Wait_Set_Timeout,
+           Grt.Processes.Ghdl_Process_Wait_Set_Timeout'Address);
+      Def (Trans_Decls.Ghdl_Process_Wait_Add_Sensitivity,
+           Grt.Processes.Ghdl_Process_Wait_Add_Sensitivity'Address);
+      Def (Trans_Decls.Ghdl_Process_Wait_Close,
+           Grt.Processes.Ghdl_Process_Wait_Close'Address);
+
+      Def (Trans_Decls.Ghdl_Process_Add_Sensitivity,
+           Grt.Processes.Ghdl_Process_Add_Sensitivity'Address);
+
+      Def (Trans_Decls.Ghdl_Now,
+           Grt.Types.Current_Time'Address);
+
+      Def (Trans_Decls.Ghdl_Process_Add_Driver,
+           Grt.Signals.Ghdl_Process_Add_Driver'Address);
+      Def (Trans_Decls.Ghdl_Signal_Add_Direct_Driver,
+           Grt.Signals.Ghdl_Signal_Add_Direct_Driver'Address);
+
+      Def (Trans_Decls.Ghdl_Signal_Add_Source,
+           Grt.Signals.Ghdl_Signal_Add_Source'Address);
+      Def (Trans_Decls.Ghdl_Signal_In_Conversion,
+           Grt.Signals.Ghdl_Signal_In_Conversion'Address);
+      Def (Trans_Decls.Ghdl_Signal_Out_Conversion,
+           Grt.Signals.Ghdl_Signal_Out_Conversion'Address);
+      Def (Trans_Decls.Ghdl_Signal_Effective_Value,
+           Grt.Signals.Ghdl_Signal_Effective_Value'Address);
+      Def (Trans_Decls.Ghdl_Signal_Create_Resolution,
+           Grt.Signals.Ghdl_Signal_Create_Resolution'Address);
+
+      Def (Trans_Decls.Ghdl_Signal_Disconnect,
+           Grt.Signals.Ghdl_Signal_Disconnect'Address);
+      Def (Trans_Decls.Ghdl_Signal_Set_Disconnect,
+           Grt.Signals.Ghdl_Signal_Set_Disconnect'Address);
+      Def (Trans_Decls.Ghdl_Signal_Merge_Rti,
+           Grt.Signals.Ghdl_Signal_Merge_Rti'Address);
+      Def (Trans_Decls.Ghdl_Signal_Name_Rti,
+           Grt.Signals.Ghdl_Signal_Name_Rti'Address);
+      Def (Trans_Decls.Ghdl_Signal_Read_Port,
+           Grt.Signals.Ghdl_Signal_Read_Port'Address);
+      Def (Trans_Decls.Ghdl_Signal_Read_Driver,
+           Grt.Signals.Ghdl_Signal_Read_Driver'Address);
+
+      Def (Trans_Decls.Ghdl_Signal_Driving,
+           Grt.Signals.Ghdl_Signal_Driving'Address);
+      Def (Trans_Decls.Ghdl_Signal_Driving_Value_B1,
+           Grt.Signals.Ghdl_Signal_Driving_Value_B1'Address);
+      Def (Trans_Decls.Ghdl_Signal_Driving_Value_E8,
+           Grt.Signals.Ghdl_Signal_Driving_Value_E8'Address);
+      Def (Trans_Decls.Ghdl_Signal_Driving_Value_E32,
+           Grt.Signals.Ghdl_Signal_Driving_Value_E32'Address);
+      Def (Trans_Decls.Ghdl_Signal_Driving_Value_I32,
+           Grt.Signals.Ghdl_Signal_Driving_Value_I32'Address);
+      Def (Trans_Decls.Ghdl_Signal_Driving_Value_I64,
+           Grt.Signals.Ghdl_Signal_Driving_Value_I64'Address);
+      Def (Trans_Decls.Ghdl_Signal_Driving_Value_F64,
+           Grt.Signals.Ghdl_Signal_Driving_Value_F64'Address);
+
+      Def (Trans_Decls.Ghdl_Signal_Create_Guard,
+           Grt.Signals.Ghdl_Signal_Create_Guard'Address);
+      Def (Trans_Decls.Ghdl_Signal_Guard_Dependence,
+           Grt.Signals.Ghdl_Signal_Guard_Dependence'Address);
+
+      Def (Trans_Decls.Ghdl_Signal_Simple_Assign_Error,
+           Grt.Signals.Ghdl_Signal_Simple_Assign_Error'Address);
+      Def (Trans_Decls.Ghdl_Signal_Start_Assign_Error,
+           Grt.Signals.Ghdl_Signal_Start_Assign_Error'Address);
+      Def (Trans_Decls.Ghdl_Signal_Next_Assign_Error,
+           Grt.Signals.Ghdl_Signal_Next_Assign_Error'Address);
+
+      Def (Trans_Decls.Ghdl_Signal_Start_Assign_Null,
+           Grt.Signals.Ghdl_Signal_Start_Assign_Null'Address);
+
+      Def (Trans_Decls.Ghdl_Signal_Direct_Assign,
+           Grt.Signals.Ghdl_Signal_Direct_Assign'Address);
+
+      Def (Trans_Decls.Ghdl_Create_Signal_B1,
+           Grt.Signals.Ghdl_Create_Signal_B1'Address);
+      Def (Trans_Decls.Ghdl_Signal_Init_B1,
+           Grt.Signals.Ghdl_Signal_Init_B1'Address);
+      Def (Trans_Decls.Ghdl_Signal_Simple_Assign_B1,
+           Grt.Signals.Ghdl_Signal_Simple_Assign_B1'Address);
+      Def (Trans_Decls.Ghdl_Signal_Start_Assign_B1,
+           Grt.Signals.Ghdl_Signal_Start_Assign_B1'Address);
+      Def (Trans_Decls.Ghdl_Signal_Next_Assign_B1,
+           Grt.Signals.Ghdl_Signal_Next_Assign_B1'Address);
+      Def (Trans_Decls.Ghdl_Signal_Associate_B1,
+           Grt.Signals.Ghdl_Signal_Associate_B1'Address);
+
+      Def (Trans_Decls.Ghdl_Create_Signal_E8,
+           Grt.Signals.Ghdl_Create_Signal_E8'Address);
+      Def (Trans_Decls.Ghdl_Signal_Init_E8,
+           Grt.Signals.Ghdl_Signal_Init_E8'Address);
+      Def (Trans_Decls.Ghdl_Signal_Simple_Assign_E8,
+           Grt.Signals.Ghdl_Signal_Simple_Assign_E8'Address);
+      Def (Trans_Decls.Ghdl_Signal_Start_Assign_E8,
+           Grt.Signals.Ghdl_Signal_Start_Assign_E8'Address);
+      Def (Trans_Decls.Ghdl_Signal_Next_Assign_E8,
+           Grt.Signals.Ghdl_Signal_Next_Assign_E8'Address);
+      Def (Trans_Decls.Ghdl_Signal_Associate_E8,
+           Grt.Signals.Ghdl_Signal_Associate_E8'Address);
+
+      Def (Trans_Decls.Ghdl_Create_Signal_E32,
+           Grt.Signals.Ghdl_Create_Signal_E32'Address);
+      Def (Trans_Decls.Ghdl_Signal_Init_E32,
+           Grt.Signals.Ghdl_Signal_Init_E32'Address);
+      Def (Trans_Decls.Ghdl_Signal_Simple_Assign_E32,
+           Grt.Signals.Ghdl_Signal_Simple_Assign_E32'Address);
+      Def (Trans_Decls.Ghdl_Signal_Start_Assign_E32,
+           Grt.Signals.Ghdl_Signal_Start_Assign_E32'Address);
+      Def (Trans_Decls.Ghdl_Signal_Next_Assign_E32,
+           Grt.Signals.Ghdl_Signal_Next_Assign_E32'Address);
+      Def (Trans_Decls.Ghdl_Signal_Associate_E32,
+           Grt.Signals.Ghdl_Signal_Associate_E32'Address);
+
+      Def (Trans_Decls.Ghdl_Create_Signal_I32,
+           Grt.Signals.Ghdl_Create_Signal_I32'Address);
+      Def (Trans_Decls.Ghdl_Signal_Init_I32,
+           Grt.Signals.Ghdl_Signal_Init_I32'Address);
+      Def (Trans_Decls.Ghdl_Signal_Simple_Assign_I32,
+           Grt.Signals.Ghdl_Signal_Simple_Assign_I32'Address);
+      Def (Trans_Decls.Ghdl_Signal_Start_Assign_I32,
+           Grt.Signals.Ghdl_Signal_Start_Assign_I32'Address);
+      Def (Trans_Decls.Ghdl_Signal_Next_Assign_I32,
+           Grt.Signals.Ghdl_Signal_Next_Assign_I32'Address);
+      Def (Trans_Decls.Ghdl_Signal_Associate_I32,
+           Grt.Signals.Ghdl_Signal_Associate_I32'Address);
+
+      Def (Trans_Decls.Ghdl_Create_Signal_I64,
+           Grt.Signals.Ghdl_Create_Signal_I64'Address);
+      Def (Trans_Decls.Ghdl_Signal_Init_I64,
+           Grt.Signals.Ghdl_Signal_Init_I64'Address);
+      Def (Trans_Decls.Ghdl_Signal_Simple_Assign_I64,
+           Grt.Signals.Ghdl_Signal_Simple_Assign_I64'Address);
+      Def (Trans_Decls.Ghdl_Signal_Start_Assign_I64,
+           Grt.Signals.Ghdl_Signal_Start_Assign_I64'Address);
+      Def (Trans_Decls.Ghdl_Signal_Next_Assign_I64,
+           Grt.Signals.Ghdl_Signal_Next_Assign_I64'Address);
+      Def (Trans_Decls.Ghdl_Signal_Associate_I64,
+           Grt.Signals.Ghdl_Signal_Associate_I64'Address);
+
+      Def (Trans_Decls.Ghdl_Create_Signal_F64,
+           Grt.Signals.Ghdl_Create_Signal_F64'Address);
+      Def (Trans_Decls.Ghdl_Signal_Init_F64,
+           Grt.Signals.Ghdl_Signal_Init_F64'Address);
+      Def (Trans_Decls.Ghdl_Signal_Simple_Assign_F64,
+           Grt.Signals.Ghdl_Signal_Simple_Assign_F64'Address);
+      Def (Trans_Decls.Ghdl_Signal_Start_Assign_F64,
+           Grt.Signals.Ghdl_Signal_Start_Assign_F64'Address);
+      Def (Trans_Decls.Ghdl_Signal_Next_Assign_F64,
+           Grt.Signals.Ghdl_Signal_Next_Assign_F64'Address);
+      Def (Trans_Decls.Ghdl_Signal_Associate_F64,
+           Grt.Signals.Ghdl_Signal_Associate_F64'Address);
+
+      Def (Trans_Decls.Ghdl_Signal_Attribute_Register_Prefix,
+           Grt.Signals.Ghdl_Signal_Attribute_Register_Prefix'Address);
+      Def (Trans_Decls.Ghdl_Create_Stable_Signal,
+           Grt.Signals.Ghdl_Create_Stable_Signal'Address);
+      Def (Trans_Decls.Ghdl_Create_Quiet_Signal,
+           Grt.Signals.Ghdl_Create_Quiet_Signal'Address);
+      Def (Trans_Decls.Ghdl_Create_Transaction_Signal,
+           Grt.Signals.Ghdl_Create_Transaction_Signal'Address);
+      Def (Trans_Decls.Ghdl_Create_Delayed_Signal,
+           Grt.Signals.Ghdl_Create_Delayed_Signal'Address);
+
+      Def (Trans_Decls.Ghdl_Rti_Add_Package,
+           Grt.Rtis.Ghdl_Rti_Add_Package'Address);
+      Def (Trans_Decls.Ghdl_Rti_Add_Top,
+           Grt.Rtis.Ghdl_Rti_Add_Top'Address);
+
+      Def (Trans_Decls.Ghdl_Protected_Enter,
+           Grt.Processes.Ghdl_Protected_Enter'Address);
+      Def (Trans_Decls.Ghdl_Protected_Leave,
+           Grt.Processes.Ghdl_Protected_Leave'Address);
+      Def (Trans_Decls.Ghdl_Protected_Init,
+           Grt.Processes.Ghdl_Protected_Init'Address);
+      Def (Trans_Decls.Ghdl_Protected_Fini,
+           Grt.Processes.Ghdl_Protected_Fini'Address);
+
+      Def (Trans_Decls.Ghdl_Text_File_Elaborate,
+           Grt.Files.Ghdl_Text_File_Elaborate'Address);
+      Def (Trans_Decls.Ghdl_Text_File_Finalize,
+           Grt.Files.Ghdl_Text_File_Finalize'Address);
+      Def (Trans_Decls.Ghdl_Text_File_Open,
+           Grt.Files.Ghdl_Text_File_Open'Address);
+      Def (Trans_Decls.Ghdl_Text_File_Open_Status,
+           Grt.Files.Ghdl_Text_File_Open_Status'Address);
+      Def (Trans_Decls.Ghdl_Text_Write,
+           Grt.Files.Ghdl_Text_Write'Address);
+      Def (Trans_Decls.Ghdl_Text_Read_Length,
+           Grt.Files.Ghdl_Text_Read_Length'Address);
+      Def (Trans_Decls.Ghdl_Text_File_Close,
+           Grt.Files.Ghdl_Text_File_Close'Address);
+
+      Def (Trans_Decls.Ghdl_File_Elaborate,
+           Grt.Files.Ghdl_File_Elaborate'Address);
+      Def (Trans_Decls.Ghdl_File_Finalize,
+           Grt.Files.Ghdl_File_Finalize'Address);
+      Def (Trans_Decls.Ghdl_File_Open,
+           Grt.Files.Ghdl_File_Open'Address);
+      Def (Trans_Decls.Ghdl_File_Open_Status,
+           Grt.Files.Ghdl_File_Open_Status'Address);
+      Def (Trans_Decls.Ghdl_File_Close,
+           Grt.Files.Ghdl_File_Close'Address);
+      Def (Trans_Decls.Ghdl_File_Flush,
+           Grt.Files.Ghdl_File_Flush'Address);
+      Def (Trans_Decls.Ghdl_Write_Scalar,
+           Grt.Files.Ghdl_Write_Scalar'Address);
+      Def (Trans_Decls.Ghdl_Read_Scalar,
+           Grt.Files.Ghdl_Read_Scalar'Address);
+
+      Def (Trans_Decls.Ghdl_File_Endfile,
+           Grt.Files.Ghdl_File_Endfile'Address);
+
+      Def (Trans_Decls.Ghdl_Image_B1,
+           Grt.Images.Ghdl_Image_B1'Address);
+      Def (Trans_Decls.Ghdl_Image_E8,
+           Grt.Images.Ghdl_Image_E8'Address);
+      Def (Trans_Decls.Ghdl_Image_E32,
+           Grt.Images.Ghdl_Image_E32'Address);
+      Def (Trans_Decls.Ghdl_Image_I32,
+           Grt.Images.Ghdl_Image_I32'Address);
+      Def (Trans_Decls.Ghdl_Image_F64,
+           Grt.Images.Ghdl_Image_F64'Address);
+      Def (Trans_Decls.Ghdl_Image_P64,
+           Grt.Images.Ghdl_Image_P64'Address);
+      Def (Trans_Decls.Ghdl_Image_P32,
+           Grt.Images.Ghdl_Image_P32'Address);
+
+      Def (Trans_Decls.Ghdl_Value_B1,
+           Grt.Values.Ghdl_Value_B1'Address);
+      Def (Trans_Decls.Ghdl_Value_E8,
+           Grt.Values.Ghdl_Value_E8'Address);
+      Def (Trans_Decls.Ghdl_Value_E32,
+           Grt.Values.Ghdl_Value_E32'Address);
+      Def (Trans_Decls.Ghdl_Value_I32,
+           Grt.Values.Ghdl_Value_I32'Address);
+      Def (Trans_Decls.Ghdl_Value_F64,
+           Grt.Values.Ghdl_Value_F64'Address);
+      Def (Trans_Decls.Ghdl_Value_P32,
+           Grt.Values.Ghdl_Value_P32'Address);
+      Def (Trans_Decls.Ghdl_Value_P64,
+           Grt.Values.Ghdl_Value_P64'Address);
+
+      Def (Trans_Decls.Ghdl_Get_Path_Name,
+           Grt.Names.Ghdl_Get_Path_Name'Address);
+      Def (Trans_Decls.Ghdl_Get_Instance_Name,
+           Grt.Names.Ghdl_Get_Instance_Name'Address);
+
+      Def (Trans_Decls.Ghdl_Std_Ulogic_Match_Eq,
+           Grt.Std_Logic_1164.Ghdl_Std_Ulogic_Match_Eq'Address);
+      Def (Trans_Decls.Ghdl_Std_Ulogic_Match_Ne,
+           Grt.Std_Logic_1164.Ghdl_Std_Ulogic_Match_Ne'Address);
+      Def (Trans_Decls.Ghdl_Std_Ulogic_Match_Lt,
+           Grt.Std_Logic_1164.Ghdl_Std_Ulogic_Match_Lt'Address);
+      Def (Trans_Decls.Ghdl_Std_Ulogic_Match_Le,
+           Grt.Std_Logic_1164.Ghdl_Std_Ulogic_Match_Le'Address);
+
+      Def (Trans_Decls.Ghdl_Std_Ulogic_Array_Match_Eq,
+           Grt.Std_Logic_1164.Ghdl_Std_Ulogic_Array_Match_Eq'Address);
+      Def (Trans_Decls.Ghdl_Std_Ulogic_Array_Match_Ne,
+           Grt.Std_Logic_1164.Ghdl_Std_Ulogic_Array_Match_Ne'Address);
+
+      Def (Trans_Decls.Ghdl_To_String_I32,
+           Grt.Images.Ghdl_To_String_I32'Address);
+      Def (Trans_Decls.Ghdl_To_String_F64,
+           Grt.Images.Ghdl_To_String_F64'Address);
+      Def (Trans_Decls.Ghdl_To_String_F64_Digits,
+           Grt.Images.Ghdl_To_String_F64_Digits'Address);
+      Def (Trans_Decls.Ghdl_To_String_F64_Format,
+           Grt.Images.Ghdl_To_String_F64_Format'Address);
+      Def (Trans_Decls.Ghdl_To_String_B1,
+           Grt.Images.Ghdl_To_String_B1'Address);
+      Def (Trans_Decls.Ghdl_To_String_E8,
+           Grt.Images.Ghdl_To_String_E8'Address);
+      Def (Trans_Decls.Ghdl_To_String_E32,
+           Grt.Images.Ghdl_To_String_E32'Address);
+      Def (Trans_Decls.Ghdl_To_String_Char,
+           Grt.Images.Ghdl_To_String_Char'Address);
+      Def (Trans_Decls.Ghdl_To_String_P32,
+           Grt.Images.Ghdl_To_String_P32'Address);
+      Def (Trans_Decls.Ghdl_To_String_P64,
+           Grt.Images.Ghdl_To_String_P64'Address);
+      Def (Trans_Decls.Ghdl_Time_To_String_Unit,
+           Grt.Images.Ghdl_Time_To_String_Unit'Address);
+      Def (Trans_Decls.Ghdl_BV_To_Ostring,
+           Grt.Images.Ghdl_BV_To_Ostring'Address);
+      Def (Trans_Decls.Ghdl_BV_To_Hstring,
+           Grt.Images.Ghdl_BV_To_Hstring'Address);
+      Def (Trans_Decls.Ghdl_Array_Char_To_String_B1,
+           Grt.Images.Ghdl_Array_Char_To_String_B1'Address);
+      Def (Trans_Decls.Ghdl_Array_Char_To_String_E8,
+           Grt.Images.Ghdl_Array_Char_To_String_E8'Address);
+      Def (Trans_Decls.Ghdl_Array_Char_To_String_E32,
+           Grt.Images.Ghdl_Array_Char_To_String_E32'Address);
+
+      Ortho_Jit.Link (Err);
+      if Err then
+         raise Compile_Error;
+      end if;
+
+      Grtlink.Std_Standard_Boolean_RTI_Ptr :=
+        Ortho_Jit.Get_Address (Trans_Decls.Std_Standard_Boolean_Rti);
+      Grtlink.Std_Standard_Bit_RTI_Ptr :=
+        Ortho_Jit.Get_Address (Trans_Decls.Std_Standard_Bit_Rti);
+      if Ieee.Std_Logic_1164.Resolved /= Null_Iir then
+         Decl := Translation.Get_Resolv_Ortho_Decl
+           (Ieee.Std_Logic_1164.Resolved);
+         if Decl /= O_Dnode_Null then
+            Grtlink.Ieee_Std_Logic_1164_Resolved_Resolv_Ptr :=
+              Ortho_Jit.Get_Address (Decl);
+         end if;
+      end if;
+
+      Grtlink.Flag_String := Flags.Flag_String;
+
+      Elaborate_Proc :=
+        Conv (Ortho_Jit.Get_Address (Trans_Decls.Ghdl_Elaborate));
+
+      Ortho_Jit.Finish;
+
+      Translation.Finalize;
+      Lists.Initialize;
+      Str_Table.Initialize;
+      Nodes.Initialize;
+      Files_Map.Initialize;
+      Name_Table.Initialize;
+
+      if Flag_Verbose then
+         Ada.Text_IO.Put_Line ("Starting simulation");
+      end if;
+
+      Grt.Main.Run;
+      --V := Ghdl_Main (1, Gnat_Argv);
+   end Run;
+
+
+   --  Command run help.
+   type Command_Run_Help is new Command_Type with null record;
+   function Decode_Command (Cmd : Command_Run_Help; Name : String)
+                           return Boolean;
+   function Get_Short_Help (Cmd : Command_Run_Help) return String;
+   procedure Perform_Action (Cmd : in out Command_Run_Help;
+                             Args : Argument_List);
+
+   function Decode_Command (Cmd : Command_Run_Help; Name : String)
+                           return Boolean
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return Name = "--run-help";
+   end Decode_Command;
+
+   function Get_Short_Help (Cmd : Command_Run_Help) return String
+   is
+      pragma Unreferenced (Cmd);
+   begin
+      return "--run-help         Disp help for RUNOPTS options";
+   end Get_Short_Help;
+
+   procedure Perform_Action (Cmd : in out Command_Run_Help;
+                             Args : Argument_List)
+   is
+      pragma Unreferenced (Cmd);
+      use Ada.Text_IO;
+   begin
+      if Args'Length /= 0 then
+         Error
+           ("warning: command '--run-help' does not accept any argument");
+      end if;
+      Put_Line ("These options can only be placed at [RUNOPTS]");
+      --  Register modules, since they add commands.
+      Grt.Modules.Register_Modules;
+      --  Bypass usual help header.
+      Grt.Options.Argc := 0;
+      Grt.Options.Help;
+   end Perform_Action;
+
+   procedure Register_Commands
+   is
+   begin
+      Ghdlcomp.Hooks := (Compile_Init'Access,
+                         Compile_Elab'Access,
+                         Set_Run_Options'Access,
+                         Run'Access,
+                         Ortho_Jit.Decode_Option'Access,
+                         Ortho_Jit.Disp_Help'Access);
+      Ghdlcomp.Register_Commands;
+      Register_Command (new Command_Run_Help);
+      Trans_Be.Register_Translation_Back_End;
+   end Register_Commands;
+end Ghdlrun;
diff --git a/src/ghdldrv/ghdlrun.ads b/src/ghdldrv/ghdlrun.ads
new file mode 100644
index 000000000..07095bd5d
--- /dev/null
+++ b/src/ghdldrv/ghdlrun.ads
@@ -0,0 +1,20 @@
+--  GHDL driver - JIT commands.
+--  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 Ghdlrun is
+   procedure Register_Commands;
+end Ghdlrun;
diff --git a/src/ghdldrv/ghdlsimul.adb b/src/ghdldrv/ghdlsimul.adb
new file mode 100644
index 000000000..17cece726
--- /dev/null
+++ b/src/ghdldrv/ghdlsimul.adb
@@ -0,0 +1,209 @@
+--  GHDL driver - simulator commands.
+--  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.Text_IO;
+with Ada.Command_Line;
+
+with Ghdllocal; use Ghdllocal;
+with GNAT.OS_Lib; use GNAT.OS_Lib;
+
+with Types;
+with Iirs; use Iirs;
+with Flags;
+with Back_End;
+with Name_Table;
+with Errorout; use Errorout;
+with Std_Package;
+with Libraries;
+with Canon;
+with Configuration;
+with Iirs_Utils;
+with Annotations;
+with Elaboration;
+with Sim_Be;
+with Simulation;
+with Execution;
+
+with Ghdlcomp;
+
+with Grt.Vpi;
+pragma Unreferenced (Grt.Vpi);
+with Grt.Types;
+with Grt.Options;
+with Grtlink;
+
+package body Ghdlsimul is
+
+   --  FIXME: reuse simulation.top_config
+   Top_Conf : Iir;
+
+   procedure Compile_Init (Analyze_Only : Boolean) is
+   begin
+      if Analyze_Only then
+         return;
+      end if;
+
+      -- Initialize.
+      Back_End.Finish_Compilation := Sim_Be.Finish_Compilation'Access;
+      Back_End.Sem_Foreign := null;
+
+      Setup_Libraries (False);
+      Libraries.Load_Std_Library;
+
+      -- Here, time_base can be set.
+      Annotations.Annotate (Std_Package.Std_Standard_Unit);
+
+      Canon.Canon_Flag_Add_Labels := True;
+      Canon.Canon_Flag_Sequentials_Stmts := True;
+      Canon.Canon_Flag_Expressions := True;
+      Canon.Canon_Flag_All_Sensitivity := True;
+   end Compile_Init;
+
+   procedure Compile_Elab
+     (Cmd_Name : String; Args : Argument_List; Opt_Arg : out Natural)
+   is
+      use Name_Table;
+      use Types;
+
+      First_Id : Name_Id;
+      Sec_Id : Name_Id;
+   begin
+      Extract_Elab_Unit (Cmd_Name, Args, Opt_Arg);
+
+      Flags.Flag_Elaborate := True;
+      -- Translation.Chap12.Elaborate (Prim_Name.all, Sec_Name.all, "", True);
+
+      if Errorout.Nbr_Errors > 0 then
+         --  This may happen (bad entity for example).
+         raise Compilation_Error;
+      end if;
+
+      First_Id := Get_Identifier (Prim_Name.all);
+      if Sec_Name = null then
+         Sec_Id := Null_Identifier;
+      else
+         Sec_Id := Get_Identifier (Sec_Name.all);
+      end if;
+      Top_Conf := Configuration.Configure (First_Id, Sec_Id);
+      if Top_Conf = Null_Iir then
+         raise Compilation_Error;
+      end if;
+
+      --  Check (and possibly abandon) if entity can be at the top of the
+      --  hierarchy.
+      declare
+         Conf_Unit : constant Iir := Get_Library_Unit (Top_Conf);
+         Arch : constant Iir :=
+           Get_Block_Specification (Get_Block_Configuration (Conf_Unit));
+         Entity : constant Iir := Iirs_Utils.Get_Entity (Arch);
+      begin
+         Configuration.Check_Entity_Declaration_Top (Entity);
+         if Nbr_Errors > 0 then
+            raise Compilation_Error;
+         end if;
+      end;
+   end Compile_Elab;
+
+   --  Set options.
+   procedure Set_Run_Options (Args : Argument_List)
+   is
+      use Grt.Options;
+      use Types;
+      Arg : String_Access;
+      Status : Decode_Option_Status;
+      Argv0 : String_Acc;
+   begin
+      --  Set progname (used for grt error messages)
+      Argv0 := new String'(Ada.Command_Line.Command_Name & ASCII.Nul);
+      Grt.Options.Progname := Grt.Types.To_Ghdl_C_String (Argv0.all'Address);
+
+      for I in Args'Range loop
+         Arg := Args (I);
+         if Arg.all = "--disp-tree" then
+            Simulation.Disp_Tree := True;
+         elsif Arg.all = "--expect-failure" then
+            Decode_Option (Arg.all, Status);
+            pragma Assert (Status = Decode_Option_Ok);
+         elsif Arg.all = "--trace-elab" then
+            Elaboration.Trace_Elaboration := True;
+         elsif Arg.all = "--trace-drivers" then
+            Elaboration.Trace_Drivers := True;
+         elsif Arg.all = "--trace-annotation" then
+            Annotations.Trace_Annotation := True;
+         elsif Arg.all = "--trace-simu" then
+            Simulation.Trace_Simulation := True;
+         elsif Arg.all = "--trace-stmt" then
+            Execution.Trace_Statements := True;
+         elsif Arg.all = "--stats" then
+            Simulation.Disp_Stats := True;
+         elsif Arg.all = "-i" then
+            Simulation.Flag_Interractive := True;
+         else
+            Decode_Option (Arg.all, Status);
+            case Status is
+               when Decode_Option_Last =>
+                  exit;
+               when Decode_Option_Help =>
+                  --  FIXME: is that correct ?
+                  exit;
+               when Decode_Option_Ok =>
+                  null;
+            end case;
+            --  Ghdlmain.Error ("unknown run options '" & Arg.all & "'");
+            --  raise Option_Error;
+         end if;
+      end loop;
+   end Set_Run_Options;
+
+   procedure Run is
+   begin
+      Grtlink.Flag_String := Flags.Flag_String;
+
+      Simulation.Simulation_Entity (Top_Conf);
+   end Run;
+
+   function Decode_Option (Option : String) return Boolean
+   is
+   begin
+      if Option = "--debug" then
+         Simulation.Flag_Debugger := True;
+      else
+         return False;
+      end if;
+      return True;
+   end Decode_Option;
+
+   procedure Disp_Long_Help
+   is
+      use Ada.Text_IO;
+   begin
+      Put_Line (" --debug        Run with debugger");
+   end Disp_Long_Help;
+
+   procedure Register_Commands
+   is
+   begin
+      Ghdlcomp.Hooks := (Compile_Init'Access,
+                         Compile_Elab'Access,
+                         Set_Run_Options'Access,
+                         Run'Access,
+                         Decode_Option'Access,
+                         Disp_Long_Help'Access);
+      Ghdlcomp.Register_Commands;
+   end Register_Commands;
+end Ghdlsimul;
diff --git a/src/ghdldrv/ghdlsimul.ads b/src/ghdldrv/ghdlsimul.ads
new file mode 100644
index 000000000..264cbf8c6
--- /dev/null
+++ b/src/ghdldrv/ghdlsimul.ads
@@ -0,0 +1,20 @@
+--  GHDL driver - simulator commands.
+--  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 Ghdlsimul is
+   procedure Register_Commands;
+end Ghdlsimul;
diff --git a/src/ghdldrv/grtlink.ads b/src/ghdldrv/grtlink.ads
new file mode 100644
index 000000000..4b3951e78
--- /dev/null
+++ b/src/ghdldrv/grtlink.ads
@@ -0,0 +1,39 @@
+--  GHDL driver - shared variables with grt.
+--  Copyright (C) 2011 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 Grtlink is
+
+   Flag_String : String (1 .. 5);
+   pragma Export (C, Flag_String, "__ghdl_flag_string");
+
+   Std_Standard_Bit_RTI_Ptr : Address := Null_Address;
+
+   Std_Standard_Boolean_RTI_Ptr : Address := Null_Address;
+
+   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");
+
+   Ieee_Std_Logic_1164_Resolved_Resolv_Ptr : Address := Null_Address;
+   pragma Export (C, Ieee_Std_Logic_1164_Resolved_Resolv_Ptr,
+                  "ieee__std_logic_1164__resolved_RESOLV_ptr");
+
+end Grtlink;