ghdl 0.21 is out

29 files changed, 693 insertions, 444 deletions

diff --git a/doc/ghdl.texi b/doc/ghdl.texi
index 5b20e50bd..c868a8c23 100644
--- a/doc/ghdl.texi
+++ b/doc/ghdl.texi
@@ -7,7 +7,7 @@
 @titlepage
 @title GHDL guide
 @subtitle GHDL, a VHDL compiler
-@subtitle For GHDL version 0.20 (Sokcho edition)
+@subtitle For GHDL version 0.21 (Sokcho edition)
 @author Tristan Gingold
 @c The following two commands start the copyright page.
 @page
@@ -846,6 +846,21 @@ declared in the @samp{ieee.VITAL_Timing} package.
 Currently, VITAL checks are only partially implemented.  @xref{VHDL
 restrictions for VITAL}, for more details.
 
+@item --syn-binding
+@cindex @option{--syn-binding} switch
+Use synthetizer rules for component binding.  During elaboration, if a
+component is not bound to an entity using VHDL LRM rules, try to find
+in any known library an entity whose name is the same as the component
+name.
+
+This rule is known as synthetizer rule.
+
+There are two key points: normal VHDL LRM rules are tried first and
+entities are search only in known library.  A known library is a
+library which has been named in your design.
+
+This option is only useful during elaboration.
+
 @item --GHDL1=@var{COMMAND}
 @cindex @option{--GHLD1} switch
 Use @var{COMMAND} as the command name for the compiler.  If @var{COMMAND} is
diff --git a/evaluation.adb b/evaluation.adb
index 3dd7631e8..baff1ae14 100644
--- a/evaluation.adb
+++ b/evaluation.adb
@@ -1254,6 +1254,8 @@ package body Evaluation is
       Exp : Integer;
       D : Integer;
       B : Boolean;
+
+      Res : Iir;
    begin
       --  Handle sign.
       if Val < 0.0 then
@@ -1330,7 +1332,11 @@ package body Evaluation is
          Append (Str (I));
       end loop;
       Finish;
-      return Build_String (Id, Int32 (P), Orig);
+      Res := Build_String (Id, Int32 (P), Orig);
+      --  FIXME: this is not correct since the type is *not* constrained.
+      Set_Type (Res, Create_Unidim_Array_By_Length
+                (Get_Type (Orig), Iir_Int64 (P), Orig));
+      return Res;
    end Eval_Floating_Image;
 
    function Eval_Incdec (Expr : Iir; N : Iir_Int64) return Iir
diff --git a/libraries.adb b/libraries.adb
index c82bc788d..f06bd16e5 100644
--- a/libraries.adb
+++ b/libraries.adb
@@ -1631,4 +1631,28 @@ package body Libraries is
       return Design_Unit;
    end Load_Secondary_Unit;
 
+   function Find_Entity_For_Component (Name: Name_Id) return Iir_Design_Unit
+   is
+      Res : Iir_Design_Unit := Null_Iir;
+      Unit : Iir_Design_Unit;
+   begin
+      Unit := Unit_Hash_Table (Name mod Unit_Hash_Length);
+      while Unit /= Null_Iir loop
+         if Get_Identifier (Unit) = Name
+           and then (Get_Kind (Get_Library_Unit (Unit))
+                     = Iir_Kind_Entity_Declaration)
+         then
+            if Res = Null_Iir then
+               Res := Unit;
+            else
+               --  Many entities.
+               return Null_Iir;
+            end if;
+         end if;
+         Unit := Get_Hash_Chain (Unit);
+      end loop;
+
+      return Res;
+   end Find_Entity_For_Component;
+
 end Libraries;
diff --git a/libraries.ads b/libraries.ads
index cb988d655..e28f412ce 100644
--- a/libraries.ads
+++ b/libraries.ads
@@ -164,4 +164,10 @@ package Libraries is
    --     or an entity_aspect_entity to designate an architectrure.
    --  Return null_iir if the design unit is not found.
    function Find_Design_Unit (Unit : Iir) return Iir_Design_Unit;
+
+   --  Find an entity whose name is NAME in any library.
+   --  If there is no such entity, return NULL_IIR.
+   --  If there are severals entities, return NULL_IIR;
+   function Find_Entity_For_Component (Name: Name_Id) return Iir_Design_Unit;
+
 end Libraries;
diff --git a/libraries/std/textio_body.vhdl b/libraries/std/textio_body.vhdl
index cf81036a9..441e4d79a 100644
--- a/libraries/std/textio_body.vhdl
+++ b/libraries/std/textio_body.vhdl
@@ -463,6 +463,8 @@ package body textio is
         if len > 0 and (str (len) = LF or str (len) = CR) then
           len := len - 1;
         end if;
+      elsif endfile (f) then
+        is_eol := true;
       else
         is_eol := false;
       end if;        
diff --git a/ortho/gcc/lang.opt b/ortho/gcc/lang.opt
index 2f945266b..2d4ed9c3d 100644
--- a/ortho/gcc/lang.opt
+++ b/ortho/gcc/lang.opt
@@ -65,6 +65,10 @@ fexplicit
 vhdl
 Explicit function declarations override implicit one in use
 
+-syn-binding
+vhdl
+Use synthetizer rules for default bindings
+
 l
 vhdl Joined Separate
 -l<filename>	Put list of files for link in <filename>
diff --git a/parse.adb b/parse.adb
index 2b66289e3..f6042911e 100644
--- a/parse.adb
+++ b/parse.adb
@@ -1270,6 +1270,10 @@ package body Parse is
 
          -- scan a literal.
          Scan.Scan;
+         if Current_Token = Tok_Right_Paren then
+            Error_Msg_Parse ("extra ',' ignored");
+            exit;
+         end if;
       end loop;
       Scan.Scan;
       return Enum_Type;
diff --git a/sem_expr.adb b/sem_expr.adb
index d850f76f5..f3e767f9f 100644
--- a/sem_expr.adb
+++ b/sem_expr.adb
@@ -1036,6 +1036,7 @@ package body Sem_Expr is
                   -- Cannot find a single interpretation for a given
                   -- type.
                   Error_Overload (Expr);
+                  Disp_Overload_List (Imp_List, Expr);
                   return Null_Iir;
                end if;
                Res_Type := Create_Iir_List;
@@ -1047,6 +1048,7 @@ package body Sem_Expr is
                if Get_Nbr_Elements (Res_Type) = 1 then
                   -- several implementations but one profile.
                   Error_Overload (Expr);
+                  Disp_Overload_List (Imp_List, Expr);
                   return Null_Iir;
                end if;
                Set_Type (Expr, Create_Overload_List (Res_Type));
@@ -1154,6 +1156,7 @@ package body Sem_Expr is
                then
                   if Res /= Null_Iir then
                      Error_Overload (Expr);
+                     Disp_Overload_List (Get_Overload_List (Inter_List), Expr);
                      return Null_Iir;
                   else
                      Res := Inter;
@@ -1180,6 +1183,7 @@ package body Sem_Expr is
          -- a procedure call.
          if Is_Overload_List (Inter_List) then
             Error_Overload (Expr);
+            Disp_Overload_List (Get_Overload_List (Inter_List), Expr);
             return Null_Iir;
          else
             Res := Inter_List;
@@ -2299,7 +2303,7 @@ package body Sem_Expr is
                      Arr (I));
                else
                   Error_Msg_Sem
-                    ("duplicate choices for" & Disp_Discrete (Bt, E_Pos)
+                    ("duplicate choices for " & Disp_Discrete (Bt, E_Pos)
                      & " to " & Disp_Discrete (Bt, Pos), Arr (I));
                end if;
             end if;
@@ -3762,6 +3766,7 @@ package body Sem_Expr is
 
       if Res /= Null_Iir and then Is_Overloaded (Res) then
          Error_Overload (Expr);
+         Disp_Overload_List (Get_Overload_List (Res), Expr);
          return Null_Iir;
       end if;
       return Res;
@@ -3798,12 +3803,14 @@ package body Sem_Expr is
                Res := El;
             else
                Error_Overload (Expr1);
+               Disp_Overload_List (List, Expr1);
                return Null_Iir;
             end if;
          end if;
       end loop;
       if Res = Null_Iir then
          Error_Overload (Expr1);
+         Disp_Overload_List (List, Expr1);
          return Null_Iir;
       end if;
       return Sem_Expression_Ov (Expr1, Res);
diff --git a/sem_specs.adb b/sem_specs.adb
index 9365e6bf3..179108103 100644
--- a/sem_specs.adb
+++ b/sem_specs.adb
@@ -1563,6 +1563,15 @@ package body Sem_Specs is
          end if;
       end if;
 
+      --  --syn-binding
+      --  Search for any entity.
+      if Flags.Flag_Syn_Binding then
+         Decl := Libraries.Find_Entity_For_Component (Name);
+         if Decl /= Null_Iir then
+            return Decl;
+         end if;
+      end if;
+
       return Null_Iir;
    end Get_Visible_Entity_Declaration;
 
@@ -1607,7 +1616,9 @@ package body Sem_Specs is
       --     The target library is the library logical name of the library
       --     containing the design unit in which the component C is
       --     declared.
-      if Flags.Vhdl_Std >= Vhdl_02 then
+      if Flags.Vhdl_Std >= Vhdl_02
+        or else Flags.Vhdl_Std = Vhdl_93c
+      then
          Decl := Comp;
          while Get_Kind (Decl) /= Iir_Kind_Library_Declaration loop
             Decl := Get_Parent (Decl);
diff --git a/sem_stmts.adb b/sem_stmts.adb
index 14fabde95..ca3afdfe1 100644
--- a/sem_stmts.adb
+++ b/sem_stmts.adb
@@ -756,7 +756,7 @@ package body Sem_Stmts is
       if Expr /= Null_Iir then
          Expr := Sem_Expression (Expr, String_Type_Definition);
          Check_Read (Expr);
-         --  Expr := Eval_Expr_If_Static (Expr);
+         Expr := Eval_Expr_If_Static (Expr);
          Set_Report_Expression (Stmt, Expr);
       end if;
 
diff --git a/translate/gcc/Makefile.in b/translate/gcc/Makefile.in
index 863e43039..9f47e58a9 100644
--- a/translate/gcc/Makefile.in
+++ b/translate/gcc/Makefile.in
@@ -233,7 +233,7 @@ install-ghdllib: ghdllib grt.lst $(STD93_SRCS) $(STD87_SRCS) \
 	$(MKDIR) $(DESTDIR)$(VHDL_LIB_DIR)/lib
 	$(INSTALL_DATA) libgrt.a $(DESTDIR)$(VHDL_LIB_DIR)/lib/libgrt.a
 	$(INSTALL_DATA) grt.lst $(DESTDIR)$(VHDL_LIB_DIR)/lib/grt.lst
-	$(INSTALL_DATA) grt.ver $(DESTDIR)$(VHDL_LIB_DIR)/lib/grt.ver
+	$(INSTALL_DATA) $(GRTSRCDIR)/grt.ver $(DESTDIR)$(VHDL_LIB_DIR)/lib/grt.ver
 # Install VHDL sources.
 	$(MKDIR) $(DESTDIR)$(VHDL_LIB_DIR)/src
 	$(MKDIR) $(DESTDIR)$(VHDL_LIB_DIR)/src/std
diff --git a/translate/gcc/dist-common.sh b/translate/gcc/dist-common.sh
index 442e81dbb..e74ba9281 100644
--- a/translate/gcc/dist-common.sh
+++ b/translate/gcc/dist-common.sh
@@ -160,6 +160,8 @@ grt-disp.adb
 grt-disp.ads
 grt-disp_rti.adb
 grt-disp_rti.ads
+grt-disp_tree.adb
+grt-disp_tree.ads
 grt-disp_signals.adb
 grt-disp_signals.ads
 grt-errors.adb
@@ -176,6 +178,8 @@ grt-lib.adb
 grt-lib.ads
 grt-main.adb
 grt-main.ads
+grt-modules.ads
+grt-modules.adb
 grt-names.adb
 grt-names.ads
 grt-options.adb
diff --git a/translate/ghdldrv/Makefile b/translate/ghdldrv/Makefile
index 2549362cd..41e19a439 100644
--- a/translate/ghdldrv/Makefile
+++ b/translate/ghdldrv/Makefile
@@ -35,6 +35,7 @@ target=i686-pc-linux-gnu
 GRTSRCDIR=../grt
 include $(GRTSRCDIR)/Makefile.inc
 
+ghdl_mcode: GRT_FLAGS+=-DWITH_GNAT_RUN_TIME
 ghdl_mcode: default_pathes.ads $(GRT_ADD_OBJS) mmap_binding.o force 
 	gnatmake -aI../../ortho/mcode $(GNATFLAGS) ghdl_mcode $(GNAT_BARGS) -largs mmap_binding.o $(GNAT_LARGS) $(GRT_ADD_OBJS) $(subst @,$(GRTSRCDIR),$(GRT_EXTRA_LIB))
 
diff --git a/translate/ghdldrv/ghdlrun.adb b/translate/ghdldrv/ghdlrun.adb
index 55be418fe..5adaeba5d 100644
--- a/translate/ghdldrv/ghdlrun.adb
+++ b/translate/ghdldrv/ghdlrun.adb
@@ -57,6 +57,7 @@ with Files_Map;
 with Name_Table;
 
 with Grt.Main;
+with Grt.Modules;
 with Grt.Lib;
 with Grt.Processes;
 with Grt.Rtis;
@@ -643,7 +644,7 @@ package body Ghdlrun is
       end if;
       Put_Line ("These options can only be placed at [RUNOPTS]");
       --  Register modules, since they add commands.
-      Grt.Main.Register_Modules;
+      Grt.Modules.Register_Modules;
       --  Bypass usual help header.
       Grt.Options.Argc := 0;
       Grt.Options.Help;
diff --git a/translate/grt/config/pthread.c b/translate/grt/config/pthread.c
index f611bb615..f0cee39b1 100644
--- a/translate/grt/config/pthread.c
+++ b/translate/grt/config/pthread.c
@@ -42,9 +42,9 @@ typedef struct
 } Stack_Type_t, *Stack_Type;
 
 Stack_Type_t      main_stack_context;
-extern Stack_Type grt_stack_main_stack;
+extern void grt_set_main_stack (Stack_Type_t *stack);
 
-//------------------------------------------------------------------------------
+//----------------------------------------------------------------------------
 void grt_stack_init(void)
 // Initialize the stacks package.
 // This may adjust stack sizes.
@@ -58,10 +58,10 @@ void grt_stack_init(void)
 	// lock the mutex, as we are currently running
 	pthread_mutex_lock(&(main_stack_context.mutex));
 	
-	grt_stack_main_stack= &main_stack_context;
+	grt_set_main_stack (&main_stack_context);
 }
 
-//------------------------------------------------------------------------------
+//----------------------------------------------------------------------------
 static void* grt_stack_loop(void* pv_myStack)
 {
 	Stack_Type myStack= (Stack_Type)pv_myStack;
@@ -84,7 +84,7 @@ static void* grt_stack_loop(void* pv_myStack)
 	return 0;
 }
 
-//------------------------------------------------------------------------------
+//----------------------------------------------------------------------------
 Stack_Type grt_stack_create(void* Func, void* Arg) 
 // Create a new stack, which on first execution will call FUNC with
 // an argument ARG.
@@ -115,7 +115,7 @@ Stack_Type grt_stack_create(void* Func, void* Arg)
 	return newStack;
 }
 
-//------------------------------------------------------------------------------
+//----------------------------------------------------------------------------
 void grt_stack_switch(Stack_Type To, Stack_Type From)
 // Resume stack TO and save the current context to the stack pointed by
 // CUR.
@@ -134,14 +134,16 @@ void grt_stack_switch(Stack_Type To, Stack_Type From)
 	pthread_mutex_lock(&(From->mutex));
 }
 
-//------------------------------------------------------------------------------
+//----------------------------------------------------------------------------
 void grt_stack_delete(Stack_Type Stack)
 // Delete stack STACK, which must not be currently executed.
 // => procedure Stack_Delete (Stack : Stack_Type);
 {	INFO("grt_stack_delete\n");
 }
 
-//------------------------------------------------------------------------------
+//----------------------------------------------------------------------------
+
+#ifndef WITH_GNAT_RUN_TIME
 void __gnat_raise_storage_error(void)
 {
    abort ();
@@ -151,7 +153,8 @@ void __gnat_raise_program_error(void)
 {
    abort ();
 }
+#endif /* WITH_GNAT_RUN_TIME */
 
-//------------------------------------------------------------------------------
+//----------------------------------------------------------------------------
 // end of file
 
diff --git a/translate/grt/config/win32.c b/translate/grt/config/win32.c
index 6c55f7b8a..80ea2703a 100644
--- a/translate/grt/config/win32.c
+++ b/translate/grt/config/win32.c
@@ -148,7 +148,8 @@ void grt_stack_delete(Stack_Type Stack)
 {	INFO("grt_stack_delete\n");
 }
 
-//------------------------------------------------------------------------------
+//----------------------------------------------------------------------------
+#ifndef WITH_GNAT_RUN_TIME
 void __gnat_raise_storage_error(void)
 {
    abort ();
@@ -158,7 +159,8 @@ void __gnat_raise_program_error(void)
 {
    abort ();
 }
+#endif
 
-//------------------------------------------------------------------------------
+//----------------------------------------------------------------------------
 // end of file
 
diff --git a/translate/grt/grt-disp_rti.adb b/translate/grt/grt-disp_rti.adb
index 28ad75db5..e9ac3e60d 100644
--- a/translate/grt/grt-disp_rti.adb
+++ b/translate/grt/grt-disp_rti.adb
@@ -15,14 +15,10 @@
 --  along with GCC; see the file COPYING.  If not, write to the Free
 --  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
 --  02111-1307, USA.
-with System; use System;
-with Grt.Rtis; use Grt.Rtis;
-with Grt.Stdio; use Grt.Stdio;
 with Grt.Astdio; use Grt.Astdio;
-with Grt.Types; use Grt.Types;
 with Grt.Errors; use Grt.Errors;
 with Grt.Rtis_Addr; use Grt.Rtis_Addr;
-with Grt.Options; use Grt.Options;
+with Grt.Hooks; use Grt.Hooks;
 
 package body Grt.Disp_Rti is
    procedure Disp_Kind (Kind : Ghdl_Rtik);
@@ -119,12 +115,6 @@ package body Grt.Disp_Rti is
 --       end case;
 --    end Get_Scalar_Type_Kind;
 
-   procedure Disp_Value (Stream : FILEs;
-                         Rti : Ghdl_Rti_Access;
-                         Ctxt : Rti_Context;
-                         Obj : in out Address;
-                         Is_Sig : Boolean);
-
    procedure Disp_Array_Value_1 (Stream : FILEs;
                                  El_Rti : Ghdl_Rti_Access;
                                  Ctxt : Rti_Context;
@@ -989,10 +979,16 @@ package body Grt.Disp_Rti is
       end case;
    end Disp_Rti;
 
+   Disp_Rti_Flag : Boolean := False;
+
    procedure Disp_All
    is
       Ctxt : Rti_Context;
    begin
+      if not Disp_Rti_Flag then
+         return;
+      end if;
+
       Put ("DISP_RTI.Disp_All: ");
       Disp_Kind (Ghdl_Rti_Top_Ptr.Common.Kind);
       New_Line;
@@ -1006,364 +1002,34 @@ package body Grt.Disp_Rti is
       --Disp_Hierarchy;
    end Disp_All;
 
-   --  Get next interesting child.
-   procedure Get_Tree_Child (Parent : Ghdl_Rtin_Block_Acc;
-                             Index : in out Ghdl_Index_Type;
-                             Child : out Ghdl_Rti_Access)
-   is
-   begin
-      --  Exit if no more children.
-      while Index < Parent.Nbr_Child loop
-         Child := Parent.Children (Index);
-         Index := Index + 1;
-         case Child.Kind is
-            when Ghdl_Rtik_Package
-              | Ghdl_Rtik_Entity
-              | Ghdl_Rtik_Architecture
-              | Ghdl_Rtik_Block
-              | Ghdl_Rtik_For_Generate
-              | Ghdl_Rtik_If_Generate
-              | Ghdl_Rtik_Instance =>
-               return;
-            when Ghdl_Rtik_Signal
-              | Ghdl_Rtik_Port
-              | Ghdl_Rtik_Guard =>
-               if Disp_Tree >= Disp_Tree_Port then
-                  return;
-               end if;
-            when Ghdl_Rtik_Process =>
-               if Disp_Tree >= Disp_Tree_Proc then
-                  return;
-               end if;
-            when others =>
-               null;
-         end case;
-      end loop;
-      Child := null;
-   end Get_Tree_Child;
-
-   procedure Disp_Tree_Child (Rti : Ghdl_Rti_Access; Ctxt : Rti_Context)
+   function Disp_Rti_Option (Opt : String) return Boolean
    is
    begin
-      case Rti.Kind is
-         when Ghdl_Rtik_Entity
-           | Ghdl_Rtik_Process
-           | Ghdl_Rtik_Architecture
-           | Ghdl_Rtik_Block
-           | Ghdl_Rtik_If_Generate =>
-            declare
-               Blk : Ghdl_Rtin_Block_Acc := To_Ghdl_Rtin_Block_Acc (Rti);
-            begin
-               Disp_Name (Blk.Name);
-            end;
-         when Ghdl_Rtik_Package_Body
-           | Ghdl_Rtik_Package =>
-            declare
-               Blk : Ghdl_Rtin_Block_Acc;
-               Lib : Ghdl_Rtin_Type_Scalar_Acc;
-            begin
-               Blk := To_Ghdl_Rtin_Block_Acc (Rti);
-               if Rti.Kind = Ghdl_Rtik_Package_Body then
-                  Blk := To_Ghdl_Rtin_Block_Acc (Blk.Parent);
-               end if;
-               Lib := To_Ghdl_Rtin_Type_Scalar_Acc (Blk.Parent);
-               Disp_Name (Lib.Name);
-               Put ('.');
-               Disp_Name (Blk.Name);
-            end;
-         when Ghdl_Rtik_For_Generate =>
-            declare
-               Blk : Ghdl_Rtin_Block_Acc := To_Ghdl_Rtin_Block_Acc (Rti);
-               Iter : Ghdl_Rtin_Object_Acc;
-               Addr : Address;
-            begin
-               Disp_Name (Blk.Name);
-               Iter := To_Ghdl_Rtin_Object_Acc (Blk.Children (0));
-               Addr := Loc_To_Addr (Iter.Common.Depth, Iter.Loc, Ctxt);
-               Put ('(');
-               Disp_Value (stdout, Iter.Obj_Type, Ctxt, Addr, False);
-               Put (')');
-            end;
-         when Ghdl_Rtik_Signal
-           | Ghdl_Rtik_Port
-           | Ghdl_Rtik_Guard
-           | Ghdl_Rtik_Iterator =>
-            Disp_Name (To_Ghdl_Rtin_Object_Acc (Rti).Name);
-         when Ghdl_Rtik_Instance =>
-            Disp_Name (To_Ghdl_Rtin_Instance_Acc (Rti).Name);
-         when others =>
-            null;
-      end case;
-
-      case Rti.Kind is
-         when Ghdl_Rtik_Package
-           | Ghdl_Rtik_Package_Body =>
-            Put (" [package]");
-         when Ghdl_Rtik_Entity =>
-            Put (" [entity]");
-         when Ghdl_Rtik_Architecture =>
-            Put (" [arch]");
-         when Ghdl_Rtik_Process =>
-            Put (" [process]");
-         when Ghdl_Rtik_Block =>
-            Put (" [block]");
-         when Ghdl_Rtik_For_Generate =>
-            Put (" [for-generate]");
-         when Ghdl_Rtik_If_Generate =>
-            Put (" [if-generate ");
-            if Ctxt.Base = Null_Address then
-               Put ("false]");
-            else
-               Put ("true]");
-            end if;
-         when Ghdl_Rtik_Signal =>
-            Put (" [signal]");
-         when Ghdl_Rtik_Port =>
-            Put (" [port ");
-            case Rti.Mode and Ghdl_Rti_Signal_Mode_Mask is
-               when Ghdl_Rti_Signal_Mode_In =>
-                  Put ("in");
-               when Ghdl_Rti_Signal_Mode_Out =>
-                  Put ("out");
-               when Ghdl_Rti_Signal_Mode_Inout =>
-                  Put ("inout");
-               when Ghdl_Rti_Signal_Mode_Buffer =>
-                  Put ("buffer");
-               when Ghdl_Rti_Signal_Mode_Linkage =>
-                  Put ("linkage");
-               when others =>
-                  Put ("?");
-            end case;
-            Put ("]");
-         when Ghdl_Rtik_Guard =>
-            Put (" [guard]");
-         when Ghdl_Rtik_Iterator =>
-            Put (" [iterator]");
-         when Ghdl_Rtik_Instance =>
-            Put (" [instance]");
-         when others =>
-            null;
-      end case;
-   end Disp_Tree_Child;
-
-   procedure Disp_Tree_Block
-     (Blk : Ghdl_Rtin_Block_Acc; Ctxt : Rti_Context; Pfx : String);
+      if Opt = "--dump-rti" then
+         Disp_Rti_Flag := True;
+         return True;
+      else
+         return False;
+      end if;
+   end Disp_Rti_Option;
 
-   procedure Disp_Tree_Block1
-     (Blk : Ghdl_Rtin_Block_Acc; Ctxt : Rti_Context; Pfx : String)
+   procedure Disp_Rti_Help
    is
-      Child : Ghdl_Rti_Access;
-      Child2 : Ghdl_Rti_Access;
-      Index : Ghdl_Index_Type;
-
-      procedure Disp_Header (Nctxt : Rti_Context;
-                             Force_Cont : Boolean := False)
-      is
-      begin
-         Put (Pfx);
-
-         if Blk.Common.Kind /= Ghdl_Rtik_Entity
-           and Child2 = null
-           and Force_Cont = False
-         then
-            Put ("`-");
-         else
-            Put ("+-");
-         end if;
-
-         Disp_Tree_Child (Child, Nctxt);
-         New_Line;
-      end Disp_Header;
-
-      procedure Disp_Sub_Block
-        (Sub_Blk : Ghdl_Rtin_Block_Acc; Nctxt : Rti_Context)
-      is
-         Npfx : String (1 .. Pfx'Length + 2);
-      begin
-         Npfx (1 .. Pfx'Length) := Pfx;
-         Npfx (Pfx'Length + 2) := ' ';
-         if Child2 = null then
-            Npfx (Pfx'Length + 1) := ' ';
-         else
-            Npfx (Pfx'Length + 1) := '|';
-         end if;
-         Disp_Tree_Block (Sub_Blk, Nctxt, Npfx);
-      end Disp_Sub_Block;
-
+      procedure P (Str : String) renames Put_Line;
    begin
-      Index := 0;
-      Get_Tree_Child (Blk, Index, Child);
-      while Child /= null loop
-         Get_Tree_Child (Blk, Index, Child2);
+      P (" --dump-rti        dump Run Time Information");
+   end Disp_Rti_Help;
 
-         case Child.Kind is
-            when Ghdl_Rtik_Process
-              | Ghdl_Rtik_Block =>
-               declare
-                  Nblk : Ghdl_Rtin_Block_Acc := To_Ghdl_Rtin_Block_Acc (Child);
-                  Nctxt : Rti_Context;
-               begin
-                  Nctxt := (Base => Ctxt.Base + Nblk.Loc.Off,
-                            Block => Child);
-                  Disp_Header (Nctxt, False);
-                  Disp_Sub_Block (Nblk, Nctxt);
-               end;
-            when Ghdl_Rtik_For_Generate =>
-               declare
-                  Nblk : Ghdl_Rtin_Block_Acc := To_Ghdl_Rtin_Block_Acc (Child);
-                  Nctxt : Rti_Context;
-                  Length : Ghdl_Index_Type;
-                  Old_Child2 : Ghdl_Rti_Access;
-               begin
-                  Nctxt := (Base => To_Addr_Acc (Ctxt.Base + Nblk.Loc.Off).all,
-                            Block => Child);
-                  Length := Get_For_Generate_Length (Nblk, Ctxt);
-                  Disp_Header (Nctxt, Length > 1);
-                  Old_Child2 := Child2;
-                  if Length > 1 then
-                     Child2 := Child;
-                  end if;
-                  for I in 1 .. Length loop
-                     Disp_Sub_Block (Nblk, Nctxt);
-                     if I /= Length then
-                        Nctxt.Base := Nctxt.Base + Nblk.Size;
-                        if I = Length - 1 then
-                           Child2 := Old_Child2;
-                        end if;
-                        Disp_Header (Nctxt);
-                     end if;
-                  end loop;
-                  Child2 := Old_Child2;
-               end;
-            when Ghdl_Rtik_If_Generate =>
-               declare
-                  Nblk : Ghdl_Rtin_Block_Acc := To_Ghdl_Rtin_Block_Acc (Child);
-                  Nctxt : Rti_Context;
-               begin
-                  Nctxt := (Base => To_Addr_Acc (Ctxt.Base + Nblk.Loc.Off).all,
-                            Block => Child);
-                  Disp_Header (Nctxt);
-                  if Nctxt.Base /= Null_Address then
-                     Disp_Sub_Block (Nblk, Nctxt);
-                  end if;
-               end;
-            when Ghdl_Rtik_Instance =>
-               declare
-                  Inst : Ghdl_Rtin_Instance_Acc;
-                  Sub_Ctxt : Rti_Context;
-                  Sub_Blk : Ghdl_Rtin_Block_Acc;
-                  Npfx : String (1 .. Pfx'Length + 4);
-                  Comp : Ghdl_Rtin_Component_Acc;
-                  Ch : Ghdl_Rti_Access;
-               begin
-                  Disp_Header (Ctxt);
-                  Inst := To_Ghdl_Rtin_Instance_Acc (Child);
-                  Get_Instance_Context (Inst, Ctxt, Sub_Ctxt);
-                  Sub_Blk := To_Ghdl_Rtin_Block_Acc (Sub_Ctxt.Block);
-                  if Inst.Instance.Kind = Ghdl_Rtik_Component
-                    and then Disp_Tree >= Disp_Tree_Port
-                  then
-                     --  Disp generics and ports of the component.
-                     Comp := To_Ghdl_Rtin_Component_Acc (Inst.Instance);
-                     for I in 1 .. Comp.Nbr_Child loop
-                        Ch := Comp.Children (I - 1);
-                        if Ch.Kind = Ghdl_Rtik_Port then
-                           --  Disp only port (and not generics).
-                           Put (Pfx);
-                           if Child2 = null then
-                              Put ("  ");
-                           else
-                              Put ("| ");
-                           end if;
-                           if I = Comp.Nbr_Child and then Sub_Blk = null then
-                              Put ("`-");
-                           else
-                              Put ("+-");
-                           end if;
-                           Disp_Tree_Child (Ch, Sub_Ctxt);
-                           New_Line;
-                        end if;
-                     end loop;
-                  end if;
-                  if Sub_Blk /= null then
-                     Npfx (1 .. Pfx'Length) := Pfx;
-                     if Child2 = null then
-                        Npfx (Pfx'Length + 1) := ' ';
-                     else
-                        Npfx (Pfx'Length + 1) := '|';
-                     end if;
-                     Npfx (Pfx'Length + 2) := ' ';
-                     Npfx (Pfx'Length + 3) := '`';
-                     Npfx (Pfx'Length + 4) := '-';
-                     Put (Npfx);
-                     Disp_Tree_Child (Sub_Blk.Parent, Sub_Ctxt);
-                     New_Line;
-                     Npfx (Pfx'Length + 3) := ' ';
-                     Npfx (Pfx'Length + 4) := ' ';
-                     Disp_Tree_Block (Sub_Blk, Sub_Ctxt, Npfx);
-                  end if;
-               end;
-            when others =>
-               Disp_Header (Ctxt);
-         end case;
-
-         Child := Child2;
-      end loop;
-   end Disp_Tree_Block1;
+   Disp_Rti_Hooks : aliased constant Hooks_Type :=
+     (Option => Disp_Rti_Option'Access,
+      Help => Disp_Rti_Help'Access,
+      Init => null,
+      Start => Disp_All'Access,
+      Finish => null);
 
-   procedure Disp_Tree_Block
-     (Blk : Ghdl_Rtin_Block_Acc; Ctxt : Rti_Context; Pfx : String)
-   is
+   procedure Register is
    begin
-      case Blk.Common.Kind is
-         when Ghdl_Rtik_Architecture =>
-            declare
-               Npfx : String (1 .. Pfx'Length + 2);
-               Nctxt : Rti_Context;
-            begin
-               --  The entity.
-               Nctxt := (Base => Ctxt.Base,
-                         Block => Blk.Parent);
-               Disp_Tree_Block1
-                 (To_Ghdl_Rtin_Block_Acc (Blk.Parent), Nctxt, Pfx);
-               --  Then the architecture.
-               Put (Pfx);
-               Put ("`-");
-               Disp_Tree_Child (To_Ghdl_Rti_Access (Blk), Ctxt);
-               New_Line;
-               Npfx (1 .. Pfx'Length) := Pfx;
-               Npfx (Pfx'Length + 1) := ' ';
-               Npfx (Pfx'Length + 2) := ' ';
-               Disp_Tree_Block1 (Blk, Ctxt, Npfx);
-            end;
-         when Ghdl_Rtik_Package_Body =>
-            Disp_Tree_Block1
-              (To_Ghdl_Rtin_Block_Acc (Blk.Parent), Ctxt, Pfx);
-         when others =>
-            Disp_Tree_Block1 (Blk, Ctxt, Pfx);
-      end case;
-   end Disp_Tree_Block;
-
-   procedure Disp_Hierarchy
-   is
-      Ctxt : Rti_Context;
-      Parent : Ghdl_Rtin_Block_Acc;
-      Child : Ghdl_Rti_Access;
-   begin
-      Ctxt := Get_Top_Context;
-      Parent := To_Ghdl_Rtin_Block_Acc (Ctxt.Block);
-
-      Disp_Tree_Child (Parent.Parent, Ctxt);
-      New_Line;
-      Disp_Tree_Block (Parent, Ctxt, "");
+      Register_Hooks (Disp_Rti_Hooks'Access);
+   end Register;
 
-      for I in 1 .. Ghdl_Rti_Top_Ptr.Nbr_Child loop
-         Child := Ghdl_Rti_Top_Ptr.Children (I - 1);
-         Ctxt := (Base => Null_Address,
-                  Block => Child);
-         Disp_Tree_Child (Child, Ctxt);
-         New_Line;
-         Disp_Tree_Block (To_Ghdl_Rtin_Block_Acc (Child), Ctxt, "");
-      end loop;
-   end Disp_Hierarchy;
 end Grt.Disp_Rti;
diff --git a/translate/grt/grt-disp_rti.ads b/translate/grt/grt-disp_rti.ads
index 890c5e1ff..fc13e22ff 100644
--- a/translate/grt/grt-disp_rti.ads
+++ b/translate/grt/grt-disp_rti.ads
@@ -15,8 +15,22 @@
 --  along with GCC; see the file COPYING.  If not, write to the Free
 --  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
 --  02111-1307, USA.
+with System; use System;
+with Grt.Types; use Grt.Types;
+with Grt.Stdio; use Grt.Stdio;
+with Grt.Rtis; use Grt.Rtis;
+with Grt.Rtis_Addr; use Grt.Rtis_Addr;
+
 package Grt.Disp_Rti is
-   procedure Disp_All;
+   --  Disp NAME.  If NAME is null, then disp <anonymous>.
+   procedure Disp_Name (Name : Ghdl_C_String);
+
+   --  Disp a value.
+   procedure Disp_Value (Stream : FILEs;
+                         Rti : Ghdl_Rti_Access;
+                         Ctxt : Rti_Context;
+                         Obj : in out Address;
+                         Is_Sig : Boolean);
 
-   procedure Disp_Hierarchy;
+   procedure Register;
 end Grt.Disp_Rti;
diff --git a/translate/grt/grt-disp_tree.adb b/translate/grt/grt-disp_tree.adb
new file mode 100644
index 000000000..e4f55f3d1
--- /dev/null
+++ b/translate/grt/grt-disp_tree.adb
@@ -0,0 +1,448 @@
+--  GHDL Run Time (GRT) - Tree displayer.
+--  Copyright (C) 2002, 2003, 2004, 2005 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with System; use System;
+with Grt.Disp_Rti; use Grt.Disp_Rti;
+with Grt.Rtis; use Grt.Rtis;
+with Grt.Stdio; use Grt.Stdio;
+with Grt.Astdio; use Grt.Astdio;
+with Grt.Types; use Grt.Types;
+with Grt.Errors; use Grt.Errors;
+with Grt.Rtis_Addr; use Grt.Rtis_Addr;
+with Grt.Hooks; use Grt.Hooks;
+
+package body Grt.Disp_Tree is
+   --  Set by --disp-tree, to display the design hierarchy.
+   type Disp_Tree_Kind is
+     (
+      Disp_Tree_None,  --  Do not disp tree.
+      Disp_Tree_Inst,  --  Disp entities, arch, package, blocks, components.
+      Disp_Tree_Proc,  --  As above plus processes
+      Disp_Tree_Port   --  As above plus ports and signals.
+     );
+   Disp_Tree_Flag : Disp_Tree_Kind := Disp_Tree_None;
+
+
+   --  Get next interesting child.
+   procedure Get_Tree_Child (Parent : Ghdl_Rtin_Block_Acc;
+                             Index : in out Ghdl_Index_Type;
+                             Child : out Ghdl_Rti_Access)
+   is
+   begin
+      --  Exit if no more children.
+      while Index < Parent.Nbr_Child loop
+         Child := Parent.Children (Index);
+         Index := Index + 1;
+         case Child.Kind is
+            when Ghdl_Rtik_Package
+              | Ghdl_Rtik_Entity
+              | Ghdl_Rtik_Architecture
+              | Ghdl_Rtik_Block
+              | Ghdl_Rtik_For_Generate
+              | Ghdl_Rtik_If_Generate
+              | Ghdl_Rtik_Instance =>
+               return;
+            when Ghdl_Rtik_Signal
+              | Ghdl_Rtik_Port
+              | Ghdl_Rtik_Guard =>
+               if Disp_Tree_Flag >= Disp_Tree_Port then
+                  return;
+               end if;
+            when Ghdl_Rtik_Process =>
+               if Disp_Tree_Flag >= Disp_Tree_Proc then
+                  return;
+               end if;
+            when others =>
+               null;
+         end case;
+      end loop;
+      Child := null;
+   end Get_Tree_Child;
+
+   procedure Disp_Tree_Child (Rti : Ghdl_Rti_Access; Ctxt : Rti_Context)
+   is
+   begin
+      case Rti.Kind is
+         when Ghdl_Rtik_Entity
+           | Ghdl_Rtik_Process
+           | Ghdl_Rtik_Architecture
+           | Ghdl_Rtik_Block
+           | Ghdl_Rtik_If_Generate =>
+            declare
+               Blk : Ghdl_Rtin_Block_Acc := To_Ghdl_Rtin_Block_Acc (Rti);
+            begin
+               Disp_Name (Blk.Name);
+            end;
+         when Ghdl_Rtik_Package_Body
+           | Ghdl_Rtik_Package =>
+            declare
+               Blk : Ghdl_Rtin_Block_Acc;
+               Lib : Ghdl_Rtin_Type_Scalar_Acc;
+            begin
+               Blk := To_Ghdl_Rtin_Block_Acc (Rti);
+               if Rti.Kind = Ghdl_Rtik_Package_Body then
+                  Blk := To_Ghdl_Rtin_Block_Acc (Blk.Parent);
+               end if;
+               Lib := To_Ghdl_Rtin_Type_Scalar_Acc (Blk.Parent);
+               Disp_Name (Lib.Name);
+               Put ('.');
+               Disp_Name (Blk.Name);
+            end;
+         when Ghdl_Rtik_For_Generate =>
+            declare
+               Blk : Ghdl_Rtin_Block_Acc := To_Ghdl_Rtin_Block_Acc (Rti);
+               Iter : Ghdl_Rtin_Object_Acc;
+               Addr : Address;
+            begin
+               Disp_Name (Blk.Name);
+               Iter := To_Ghdl_Rtin_Object_Acc (Blk.Children (0));
+               Addr := Loc_To_Addr (Iter.Common.Depth, Iter.Loc, Ctxt);
+               Put ('(');
+               Disp_Value (stdout, Iter.Obj_Type, Ctxt, Addr, False);
+               Put (')');
+            end;
+         when Ghdl_Rtik_Signal
+           | Ghdl_Rtik_Port
+           | Ghdl_Rtik_Guard
+           | Ghdl_Rtik_Iterator =>
+            Disp_Name (To_Ghdl_Rtin_Object_Acc (Rti).Name);
+         when Ghdl_Rtik_Instance =>
+            Disp_Name (To_Ghdl_Rtin_Instance_Acc (Rti).Name);
+         when others =>
+            null;
+      end case;
+
+      case Rti.Kind is
+         when Ghdl_Rtik_Package
+           | Ghdl_Rtik_Package_Body =>
+            Put (" [package]");
+         when Ghdl_Rtik_Entity =>
+            Put (" [entity]");
+         when Ghdl_Rtik_Architecture =>
+            Put (" [arch]");
+         when Ghdl_Rtik_Process =>
+            Put (" [process]");
+         when Ghdl_Rtik_Block =>
+            Put (" [block]");
+         when Ghdl_Rtik_For_Generate =>
+            Put (" [for-generate]");
+         when Ghdl_Rtik_If_Generate =>
+            Put (" [if-generate ");
+            if Ctxt.Base = Null_Address then
+               Put ("false]");
+            else
+               Put ("true]");
+            end if;
+         when Ghdl_Rtik_Signal =>
+            Put (" [signal]");
+         when Ghdl_Rtik_Port =>
+            Put (" [port ");
+            case Rti.Mode and Ghdl_Rti_Signal_Mode_Mask is
+               when Ghdl_Rti_Signal_Mode_In =>
+                  Put ("in");
+               when Ghdl_Rti_Signal_Mode_Out =>
+                  Put ("out");
+               when Ghdl_Rti_Signal_Mode_Inout =>
+                  Put ("inout");
+               when Ghdl_Rti_Signal_Mode_Buffer =>
+                  Put ("buffer");
+               when Ghdl_Rti_Signal_Mode_Linkage =>
+                  Put ("linkage");
+               when others =>
+                  Put ("?");
+            end case;
+            Put ("]");
+         when Ghdl_Rtik_Guard =>
+            Put (" [guard]");
+         when Ghdl_Rtik_Iterator =>
+            Put (" [iterator]");
+         when Ghdl_Rtik_Instance =>
+            Put (" [instance]");
+         when others =>
+            null;
+      end case;
+   end Disp_Tree_Child;
+
+   procedure Disp_Tree_Block
+     (Blk : Ghdl_Rtin_Block_Acc; Ctxt : Rti_Context; Pfx : String);
+
+   procedure Disp_Tree_Block1
+     (Blk : Ghdl_Rtin_Block_Acc; Ctxt : Rti_Context; Pfx : String)
+   is
+      Child : Ghdl_Rti_Access;
+      Child2 : Ghdl_Rti_Access;
+      Index : Ghdl_Index_Type;
+
+      procedure Disp_Header (Nctxt : Rti_Context;
+                             Force_Cont : Boolean := False)
+      is
+      begin
+         Put (Pfx);
+
+         if Blk.Common.Kind /= Ghdl_Rtik_Entity
+           and Child2 = null
+           and Force_Cont = False
+         then
+            Put ("`-");
+         else
+            Put ("+-");
+         end if;
+
+         Disp_Tree_Child (Child, Nctxt);
+         New_Line;
+      end Disp_Header;
+
+      procedure Disp_Sub_Block
+        (Sub_Blk : Ghdl_Rtin_Block_Acc; Nctxt : Rti_Context)
+      is
+         Npfx : String (1 .. Pfx'Length + 2);
+      begin
+         Npfx (1 .. Pfx'Length) := Pfx;
+         Npfx (Pfx'Length + 2) := ' ';
+         if Child2 = null then
+            Npfx (Pfx'Length + 1) := ' ';
+         else
+            Npfx (Pfx'Length + 1) := '|';
+         end if;
+         Disp_Tree_Block (Sub_Blk, Nctxt, Npfx);
+      end Disp_Sub_Block;
+
+   begin
+      Index := 0;
+      Get_Tree_Child (Blk, Index, Child);
+      while Child /= null loop
+         Get_Tree_Child (Blk, Index, Child2);
+
+         case Child.Kind is
+            when Ghdl_Rtik_Process
+              | Ghdl_Rtik_Block =>
+               declare
+                  Nblk : Ghdl_Rtin_Block_Acc := To_Ghdl_Rtin_Block_Acc (Child);
+                  Nctxt : Rti_Context;
+               begin
+                  Nctxt := (Base => Ctxt.Base + Nblk.Loc.Off,
+                            Block => Child);
+                  Disp_Header (Nctxt, False);
+                  Disp_Sub_Block (Nblk, Nctxt);
+               end;
+            when Ghdl_Rtik_For_Generate =>
+               declare
+                  Nblk : Ghdl_Rtin_Block_Acc := To_Ghdl_Rtin_Block_Acc (Child);
+                  Nctxt : Rti_Context;
+                  Length : Ghdl_Index_Type;
+                  Old_Child2 : Ghdl_Rti_Access;
+               begin
+                  Nctxt := (Base => To_Addr_Acc (Ctxt.Base + Nblk.Loc.Off).all,
+                            Block => Child);
+                  Length := Get_For_Generate_Length (Nblk, Ctxt);
+                  Disp_Header (Nctxt, Length > 1);
+                  Old_Child2 := Child2;
+                  if Length > 1 then
+                     Child2 := Child;
+                  end if;
+                  for I in 1 .. Length loop
+                     Disp_Sub_Block (Nblk, Nctxt);
+                     if I /= Length then
+                        Nctxt.Base := Nctxt.Base + Nblk.Size;
+                        if I = Length - 1 then
+                           Child2 := Old_Child2;
+                        end if;
+                        Disp_Header (Nctxt);
+                     end if;
+                  end loop;
+                  Child2 := Old_Child2;
+               end;
+            when Ghdl_Rtik_If_Generate =>
+               declare
+                  Nblk : Ghdl_Rtin_Block_Acc := To_Ghdl_Rtin_Block_Acc (Child);
+                  Nctxt : Rti_Context;
+               begin
+                  Nctxt := (Base => To_Addr_Acc (Ctxt.Base + Nblk.Loc.Off).all,
+                            Block => Child);
+                  Disp_Header (Nctxt);
+                  if Nctxt.Base /= Null_Address then
+                     Disp_Sub_Block (Nblk, Nctxt);
+                  end if;
+               end;
+            when Ghdl_Rtik_Instance =>
+               declare
+                  Inst : Ghdl_Rtin_Instance_Acc;
+                  Sub_Ctxt : Rti_Context;
+                  Sub_Blk : Ghdl_Rtin_Block_Acc;
+                  Npfx : String (1 .. Pfx'Length + 4);
+                  Comp : Ghdl_Rtin_Component_Acc;
+                  Ch : Ghdl_Rti_Access;
+               begin
+                  Disp_Header (Ctxt);
+                  Inst := To_Ghdl_Rtin_Instance_Acc (Child);
+                  Get_Instance_Context (Inst, Ctxt, Sub_Ctxt);
+                  Sub_Blk := To_Ghdl_Rtin_Block_Acc (Sub_Ctxt.Block);
+                  if Inst.Instance.Kind = Ghdl_Rtik_Component
+                    and then Disp_Tree_Flag >= Disp_Tree_Port
+                  then
+                     --  Disp generics and ports of the component.
+                     Comp := To_Ghdl_Rtin_Component_Acc (Inst.Instance);
+                     for I in 1 .. Comp.Nbr_Child loop
+                        Ch := Comp.Children (I - 1);
+                        if Ch.Kind = Ghdl_Rtik_Port then
+                           --  Disp only port (and not generics).
+                           Put (Pfx);
+                           if Child2 = null then
+                              Put ("  ");
+                           else
+                              Put ("| ");
+                           end if;
+                           if I = Comp.Nbr_Child and then Sub_Blk = null then
+                              Put ("`-");
+                           else
+                              Put ("+-");
+                           end if;
+                           Disp_Tree_Child (Ch, Sub_Ctxt);
+                           New_Line;
+                        end if;
+                     end loop;
+                  end if;
+                  if Sub_Blk /= null then
+                     Npfx (1 .. Pfx'Length) := Pfx;
+                     if Child2 = null then
+                        Npfx (Pfx'Length + 1) := ' ';
+                     else
+                        Npfx (Pfx'Length + 1) := '|';
+                     end if;
+                     Npfx (Pfx'Length + 2) := ' ';
+                     Npfx (Pfx'Length + 3) := '`';
+                     Npfx (Pfx'Length + 4) := '-';
+                     Put (Npfx);
+                     Disp_Tree_Child (Sub_Blk.Parent, Sub_Ctxt);
+                     New_Line;
+                     Npfx (Pfx'Length + 3) := ' ';
+                     Npfx (Pfx'Length + 4) := ' ';
+                     Disp_Tree_Block (Sub_Blk, Sub_Ctxt, Npfx);
+                  end if;
+               end;
+            when others =>
+               Disp_Header (Ctxt);
+         end case;
+
+         Child := Child2;
+      end loop;
+   end Disp_Tree_Block1;
+
+   procedure Disp_Tree_Block
+     (Blk : Ghdl_Rtin_Block_Acc; Ctxt : Rti_Context; Pfx : String)
+   is
+   begin
+      case Blk.Common.Kind is
+         when Ghdl_Rtik_Architecture =>
+            declare
+               Npfx : String (1 .. Pfx'Length + 2);
+               Nctxt : Rti_Context;
+            begin
+               --  The entity.
+               Nctxt := (Base => Ctxt.Base,
+                         Block => Blk.Parent);
+               Disp_Tree_Block1
+                 (To_Ghdl_Rtin_Block_Acc (Blk.Parent), Nctxt, Pfx);
+               --  Then the architecture.
+               Put (Pfx);
+               Put ("`-");
+               Disp_Tree_Child (To_Ghdl_Rti_Access (Blk), Ctxt);
+               New_Line;
+               Npfx (1 .. Pfx'Length) := Pfx;
+               Npfx (Pfx'Length + 1) := ' ';
+               Npfx (Pfx'Length + 2) := ' ';
+               Disp_Tree_Block1 (Blk, Ctxt, Npfx);
+            end;
+         when Ghdl_Rtik_Package_Body =>
+            Disp_Tree_Block1
+              (To_Ghdl_Rtin_Block_Acc (Blk.Parent), Ctxt, Pfx);
+         when others =>
+            Disp_Tree_Block1 (Blk, Ctxt, Pfx);
+      end case;
+   end Disp_Tree_Block;
+
+   procedure Disp_Hierarchy
+   is
+      Ctxt : Rti_Context;
+      Parent : Ghdl_Rtin_Block_Acc;
+      Child : Ghdl_Rti_Access;
+   begin
+      if Disp_Tree_Flag = Disp_Tree_None then
+         return;
+      end if;
+
+      Ctxt := Get_Top_Context;
+      Parent := To_Ghdl_Rtin_Block_Acc (Ctxt.Block);
+
+      Disp_Tree_Child (Parent.Parent, Ctxt);
+      New_Line;
+      Disp_Tree_Block (Parent, Ctxt, "");
+
+      for I in 1 .. Ghdl_Rti_Top_Ptr.Nbr_Child loop
+         Child := Ghdl_Rti_Top_Ptr.Children (I - 1);
+         Ctxt := (Base => Null_Address,
+                  Block => Child);
+         Disp_Tree_Child (Child, Ctxt);
+         New_Line;
+         Disp_Tree_Block (To_Ghdl_Rtin_Block_Acc (Child), Ctxt, "");
+      end loop;
+   end Disp_Hierarchy;
+
+   function Disp_Tree_Option (Opt : String) return Boolean
+   is
+   begin
+      if Opt'Length >= 11 and then Opt (1 .. 11) = "--disp-tree" then
+         if Opt'Length = 11 then
+            Disp_Tree_Flag := Disp_Tree_Port;
+         elsif Opt (12 .. Opt'Last) = "=port" then
+            Disp_Tree_Flag := Disp_Tree_Port;
+         elsif Opt (12 .. Opt'Last) = "=proc" then
+            Disp_Tree_Flag := Disp_Tree_Proc;
+         elsif Opt (12 .. Opt'Last) = "=inst" then
+            Disp_Tree_Flag := Disp_Tree_Inst;
+         elsif Opt (12 .. Opt'Last) = "=none" then
+            Disp_Tree_Flag := Disp_Tree_None;
+         else
+            Error ("bad argument for --disp-tree option, try --help");
+         end if;
+         return True;
+      else
+         return False;
+      end if;
+   end Disp_Tree_Option;
+
+   procedure Disp_Tree_Help
+   is
+      procedure P (Str : String) renames Put_Line;
+   begin
+      P (" --disp-tree[=KIND] disp the design hierarchy after elaboration");
+      P ("       KIND is inst, proc, port (default)");
+   end Disp_Tree_Help;
+
+   Disp_Tree_Hooks : aliased constant Hooks_Type :=
+     (Option => Disp_Tree_Option'Access,
+      Help => Disp_Tree_Help'Access,
+      Init => null,
+      Start => Disp_Hierarchy'Access,
+      Finish => null);
+
+   procedure Register is
+   begin
+      Register_Hooks (Disp_Tree_Hooks'Access);
+   end Register;
+
+end Grt.Disp_Tree;
diff --git a/translate/grt/grt-disp_tree.ads b/translate/grt/grt-disp_tree.ads
new file mode 100644
index 000000000..574626eb9
--- /dev/null
+++ b/translate/grt/grt-disp_tree.ads
@@ -0,0 +1,20 @@
+--  GHDL Run Time (GRT) - RTI dumper.
+--  Copyright (C) 2002, 2003, 2004, 2005 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+package Grt.Disp_Tree is
+   procedure Register;
+end Grt.Disp_Tree;
diff --git a/translate/grt/grt-main.adb b/translate/grt/grt-main.adb
index 28bd8b045..86a388cd6 100644
--- a/translate/grt/grt-main.adb
+++ b/translate/grt/grt-main.adb
@@ -18,21 +18,18 @@
 with System.Storage_Elements; --  Work around GNAT bug.
 with Grt.Types; use Grt.Types;
 with Grt.Errors;
-with Grt.Vcd;
-with Grt.Vcdz;
-with Grt.Vpi;
-with Grt.Waves;
 with Grt.Stacks;
 with Grt.Processes;
 with Grt.Signals;
 with Grt.Options; use Grt.Options;
-with Grt.Disp_Rti;
 with Grt.Stats;
 with Grt.Hooks;
 with Grt.Disp_Signals;
 with Grt.Disp;
+with Grt.Modules;
 
 --  The following packages are not referenced in this package.
+--  These are subprograms called only from GHDL generated code.
 --  They are with'ed in order to be present in the binary.
 pragma Warnings (Off);
 with Grt.Files;
@@ -42,7 +39,6 @@ with Grt.Shadow_Ieee;
 with Grt.Images;
 with Grt.Values;
 with Grt.Names;
-with Grt.Vital_Annotate;
 pragma Warnings (On);
 
 package body Grt.Main is
@@ -81,23 +77,15 @@ package body Grt.Main is
       end if;
    end Check_Flag_String;
 
-   procedure Register_Modules is
-   begin
-      --  List of modules to be registered.
-      Grt.Vcd.Register;
-      Grt.Vcdz.Register;
-      Grt.Waves.Register;
-      Grt.Vpi.Register;
-      Grt.Vital_Annotate.Register;
-   end Register_Modules;
-
    procedure Run
    is
       use Grt.Errors;
       Stop : Boolean;
       Status : Integer;
    begin
-      Register_Modules;
+      --  Register modules.
+      --  They may insert hooks.
+      Grt.Modules.Register_Modules;
 
       --  If the time resolution is to be set by the user, select a default
       --  resolution.  Options may override it.
@@ -105,8 +93,10 @@ package body Grt.Main is
          Set_Time_Resolution ('n');
       end if;
 
+      --  Decode options.
       Grt.Options.Decode (Stop);
 
+      --  Check coherency between GRT and GHDL generated code.
       Check_Flag_String;
 
       --  Early stop (for options such as --help).
@@ -138,15 +128,9 @@ package body Grt.Main is
          Stats.Start_Order;
       end if;
 
-      if Disp_Tree /= Disp_Tree_None then
-         Grt.Disp_Rti.Disp_Hierarchy;
-      end if;
+      Grt.Hooks.Call_Start_Hooks;
 
       if not Flag_No_Run then
-         if Grt.Options.Flag_Dump_Rti then
-            Grt.Disp_Rti.Disp_All;
-         end if;
-
          Grt.Signals.Order_All_Signals;
 
          if Grt.Options.Disp_Signals_Map then
diff --git a/translate/grt/grt-main.ads b/translate/grt/grt-main.ads
index c62fe0067..15c669e8f 100644
--- a/translate/grt/grt-main.ads
+++ b/translate/grt/grt-main.ads
@@ -17,11 +17,6 @@
 --  02111-1307, USA.
 
 package Grt.Main is
-   --  Register modules.
-   --  This is automatically called by RUN.
-   --  Do not call this procedure.
-   procedure Register_Modules;
-
    --  Elaborate and simulate the design.
    procedure Run;
 end Grt.Main;
diff --git a/translate/grt/grt-modules.adb b/translate/grt/grt-modules.adb
new file mode 100644
index 000000000..6fe8eea32
--- /dev/null
+++ b/translate/grt/grt-modules.adb
@@ -0,0 +1,39 @@
+--  GHDL Run Time (GRT) -  Modules.
+--  Copyright (C) 2005 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with System.Storage_Elements; --  Work around GNAT bug.
+with Grt.Vcd;
+with Grt.Vcdz;
+with Grt.Vpi;
+with Grt.Waves;
+with Grt.Vital_Annotate;
+with Grt.Disp_Tree;
+with Grt.Disp_Rti;
+
+package body Grt.Modules is
+   procedure Register_Modules is
+   begin
+      --  List of modules to be registered.
+      Grt.Disp_Tree.Register;
+      Grt.Vcd.Register;
+      Grt.Vcdz.Register;
+      Grt.Waves.Register;
+      Grt.Vpi.Register;
+      Grt.Vital_Annotate.Register;
+      Grt.Disp_Rti.Register;
+   end Register_Modules;
+end Grt.Modules;
diff --git a/translate/grt/grt-modules.ads b/translate/grt/grt-modules.ads
new file mode 100644
index 000000000..2148597cf
--- /dev/null
+++ b/translate/grt/grt-modules.ads
@@ -0,0 +1,22 @@
+--  GHDL Run Time (GRT) -  Modules.
+--  Copyright (C) 2005 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with GCC; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+
+package Grt.Modules is
+   --  Register optional modules.
+   procedure Register_Modules;
+end Grt.Modules;
diff --git a/translate/grt/grt-options.adb b/translate/grt/grt-options.adb
index 15b56d469..140f088b9 100644
--- a/translate/grt/grt-options.adb
+++ b/translate/grt/grt-options.adb
@@ -169,7 +169,6 @@ package body Grt.Options is
       P (" --disp-sig-types  disp signal types");
       P (" --disp-signals-map    disp map bw declared sigs and internal sigs");
       P (" --disp-signals-table  disp internal signals");
-      P (" --dump-rti        dump Run Time Information");
       P (" --checks          do internal checks after each process run");
       P (" --activity=LEVEL  watch activity of LEVEL signals");
       P ("       LEVEL is all, min (default) or none (unsafe)");
@@ -260,20 +259,6 @@ package body Grt.Options is
             elsif Argument = "--help" or else Argument = "-h" then
                Help;
                Stop := True;
-            elsif Len >= 11 and then Argument (1 .. 11) = "--disp-tree" then
-               if Len = 11 then
-                  Disp_Tree := Disp_Tree_Port;
-               elsif Argument (12 .. Len) = "=port" then
-                  Disp_Tree := Disp_Tree_Port;
-               elsif Argument (12 .. Len) = "=proc" then
-                  Disp_Tree := Disp_Tree_Proc;
-               elsif Argument (12 .. Len) = "=inst" then
-                  Disp_Tree := Disp_Tree_Inst;
-               elsif Argument (12 .. Len) = "=none" then
-                  Disp_Tree := Disp_Tree_None;
-               else
-                  Error ("bad argument for --disp-tree option, try --help");
-               end if;
             elsif Argument = "--disp-time" then
                Disp_Time := True;
             elsif Argument = "--trace-signals" then
@@ -294,8 +279,6 @@ package body Grt.Options is
                Disp_Signals_Map := True;
             elsif Argument = "--disp-signals-table" then
                Disp_Signals_Table := True;
-            elsif Argument = "--dump-rti" then
-               Flag_Dump_Rti := True;
             elsif Argument = "--stats" then
                Flag_Stats := True;
             elsif Argument = "--no-run" then
diff --git a/translate/grt/grt-options.ads b/translate/grt/grt-options.ads
index 756fe5dd6..7e2c17b10 100644
--- a/translate/grt/grt-options.ads
+++ b/translate/grt/grt-options.ads
@@ -56,16 +56,6 @@ package Grt.Options is
    --  If STOP is true, there nothing must happen (set by --help).
    procedure Decode (Stop : out Boolean);
 
-   --  Set by --disp-tree, to display the design hierarchy.
-   type Disp_Tree_Kind is
-     (
-      Disp_Tree_None,  --  Do not disp tree.
-      Disp_Tree_Inst,  --  Disp entities, arch, package, blocks, components.
-      Disp_Tree_Proc,  --  As above plus processes
-      Disp_Tree_Port   --  As above plus ports and signals.
-     );
-   Disp_Tree : Disp_Tree_Kind := Disp_Tree_None;
-
    --  Set by --disp-time (and --trace-signals, --trace-processes) to display
    --  time and deltas.
    Disp_Time : Boolean := False;
@@ -108,9 +98,6 @@ package Grt.Options is
    --  The maximum stack size for non-sensitized processes.
    Stack_Max_Size : Natural := 128 * 1024;
 
-   --  If set, dump rtis.
-   Flag_Dump_Rti : Boolean := False;
-
    --  Set by --no-run
    --  If set, do not simulate, only elaborate.
    Flag_No_Run : Boolean := False;
diff --git a/translate/grt/grt-processes.adb b/translate/grt/grt-processes.adb
index 1bb0be854..54eb28bf5 100644
--- a/translate/grt/grt-processes.adb
+++ b/translate/grt/grt-processes.adb
@@ -806,7 +806,6 @@ package body Grt.Processes is
         new Process_Id_Array (1 .. Nbr_Non_Postponed_Processes);
       Postponed_Resume_Process_Table :=
         new Process_Id_Array (1 .. Nbr_Postponed_Processes);
-      Grt.Hooks.Call_Start_Hooks;
 
       Status := Run_Through_Longjump (Initialization_Phase'Access);
       if Status /= Run_Resumed then
diff --git a/translate/grt/grt-rtis_utils.adb b/translate/grt/grt-rtis_utils.adb
index 62cd407e8..9754adac8 100644
--- a/translate/grt/grt-rtis_utils.adb
+++ b/translate/grt/grt-rtis_utils.adb
@@ -94,7 +94,9 @@ package body Grt.Rtis_Utils is
                         Obj := To_Ghdl_Rtin_Instance_Acc (Child);
 
                         Get_Instance_Context (Obj, Ctxt, Nctxt);
-                        Res := Traverse_Instance (Nctxt);
+                        if Nctxt /= Null_Context then
+                           Res := Traverse_Instance (Nctxt);
+                        end if;
                      end;
                   end if;
                when Ghdl_Rtik_Package
diff --git a/version.ads b/version.ads
index dd9894353..852bffec7 100644
--- a/version.ads
+++ b/version.ads
@@ -1,4 +1,4 @@
 package Version is
    Ghdl_Version : constant String :=
-      "GHDL 0.21dev (20051016) [Sokcho edition]";
+      "GHDL 0.21 (20051218) [Sokcho edition]";
 end Version;