synth: extract elab-vhdl_debug from elab-debugger

3 files changed, 662 insertions, 465 deletions

diff --git a/src/synth/elab-debugger__on.adb b/src/synth/elab-debugger__on.adb
index faab400ca..1dc176a6e 100644
--- a/src/synth/elab-debugger__on.adb
+++ b/src/synth/elab-debugger__on.adb
@@ -285,284 +285,6 @@ package body Elab.Debugger is
       return P - 1;
    end Get_Word;
 
-   procedure Disp_Memtyp (M : Memtyp; Vtype : Node);
-
-   procedure Disp_Discrete_Value (Val : Int64; Btype : Node) is
-   begin
-      case Get_Kind (Btype) is
-         when Iir_Kind_Integer_Type_Definition =>
-            Put_Int64 (Val);
-         when Iir_Kind_Enumeration_Type_Definition =>
-            declare
-               Pos : constant Natural := Natural (Val);
-               Enums : constant Node_Flist :=
-                 Get_Enumeration_Literal_List (Btype);
-               Id : constant Name_Id :=
-                 Get_Identifier (Get_Nth_Element (Enums, Pos));
-            begin
-               Put (Name_Table.Image (Id));
-            end;
-         when others =>
-            Vhdl.Errors.Error_Kind ("disp_discrete_value", Btype);
-      end case;
-   end Disp_Discrete_Value;
-
-   procedure Disp_Value_Vector (Mem : Memtyp; A_Type: Node; Bound : Bound_Type)
-   is
-      El_Type : constant Node := Get_Base_Type (Get_Element_Subtype (A_Type));
-      El_Typ : constant Type_Acc := Get_Array_Element (Mem.Typ);
-      type Last_Enum_Type is (None, Char, Identifier);
-      Last_Enum : Last_Enum_Type;
-      Enum_List : Node_Flist;
-      El_Id : Name_Id;
-      El_Pos : Natural;
-   begin
-      --  Pretty print vectors of enumerated types
-      if Get_Kind (El_Type) = Iir_Kind_Enumeration_Type_Definition then
-         Last_Enum := None;
-         Enum_List := Get_Enumeration_Literal_List (El_Type);
-         for I in 1 .. Bound.Len loop
-            El_Pos := Natural
-              (Read_Discrete
-                 (Memtyp'(El_Typ, Mem.Mem + Size_Type (I - 1) * El_Typ.Sz)));
-            El_Id := Get_Identifier (Get_Nth_Element (Enum_List, El_Pos));
-            if Name_Table.Is_Character (El_Id) then
-               case Last_Enum is
-                  when None =>
-                     Put ("""");
-                  when Identifier =>
-                     Put (" & """);
-                  when Char =>
-                     null;
-               end case;
-               Put (Name_Table.Get_Character (El_Id));
-               Last_Enum := Char;
-            else
-               case Last_Enum is
-                  when None =>
-                     null;
-                  when Identifier =>
-                     Put (" & ");
-                  when Char =>
-                     Put (""" & ");
-               end case;
-               Put (Name_Table.Image (El_Id));
-               Last_Enum := Identifier;
-            end if;
-         end loop;
-         case Last_Enum is
-            when None =>
-               Put ("""""");  --  Simply ""
-            when Identifier =>
-               null;
-            when Char =>
-               Put ("""");
-         end case;
-      else
-         Put ("(");
-         for I in 1 .. Bound.Len loop
-            if I /= 1 then
-               Put (", ");
-            end if;
-            Disp_Memtyp ((El_Typ, Mem.Mem + Size_Type (I - 1) * Mem.Typ.Sz),
-                         El_Type);
-         end loop;
-         Put (")");
-      end if;
-   end Disp_Value_Vector;
-
-   procedure Disp_Value_Array (Mem : Memtyp; A_Type: Node; Dim: Dim_Type)
-   is
-      Stride : Size_Type;
-   begin
-      if Dim = Mem.Typ.Abounds.Ndim then
-         --  Last dimension
-         Disp_Value_Vector (Mem, A_Type, Mem.Typ.Abounds.D (Dim));
-      else
-         Stride := Mem.Typ.Arr_El.Sz;
-         for I in Dim + 1 .. Mem.Typ.Abounds.Ndim loop
-            Stride := Stride * Size_Type (Mem.Typ.Abounds.D (I).Len);
-         end loop;
-
-         Put ("(");
-         for I in 1 .. Mem.Typ.Abounds.D (Dim).Len loop
-            if I /= 1 then
-               Put (", ");
-            end if;
-            Disp_Value_Array ((Mem.Typ, Mem.Mem + Stride), A_Type, Dim + 1);
-         end loop;
-         Put (")");
-      end if;
-   end Disp_Value_Array;
-
-   procedure Disp_Memtyp (M : Memtyp; Vtype : Node) is
-   begin
-      if M.Mem = null then
-         Put ("*NULL*");
-         return;
-      end if;
-
-      case M.Typ.Kind is
-         when Type_Discrete
-           | Type_Bit
-           | Type_Logic =>
-            Disp_Discrete_Value (Read_Discrete (M), Get_Base_Type (Vtype));
-         when Type_Vector =>
-            Disp_Value_Vector (M, Vtype, M.Typ.Vbound);
-         when Type_Array =>
-            Disp_Value_Array (M, Vtype, 1);
-         when Type_Float =>
-            Put ("*float*");
-         when Type_Slice =>
-            Put ("*slice*");
-         when Type_File =>
-            Put ("*file*");
-         when Type_Record =>
-            Put ("*record*");
-         when Type_Access =>
-            Put ("*access*");
-         when Type_Protected =>
-            Put ("*protected*");
-         when Type_Unbounded_Array
-            | Type_Unbounded_Record
-            | Type_Unbounded_Vector =>
-            Put ("*unbounded*");
-      end case;
-   end Disp_Memtyp;
-
-   procedure Disp_Value (Vt : Valtyp; Vtype : Node) is
-   begin
-      if Vt.Val = null then
-         Put ("*NULL*");
-         return;
-      end if;
-
-      case Vt.Val.Kind is
-         when Value_Net =>
-            Put ("net");
-         when Value_Wire =>
-            Put ("wire");
-         when Value_Signal =>
-            Put ("signal");
-         when Value_File =>
-            Put ("file");
-         when Value_Const =>
-            Put ("const: ");
-            Disp_Memtyp (Get_Memtyp (Vt), Vtype);
-         when Value_Alias =>
-            Put ("alias");
-            Disp_Memtyp (Get_Memtyp (Vt), Vtype);
-         when Value_Memory =>
-            Disp_Memtyp (Get_Memtyp (Vt), Vtype);
-      end case;
-   end Disp_Value;
-
-   procedure Disp_Bound_Type (Bound : Bound_Type) is
-   begin
-      Put_Int32 (Bound.Left);
-      Put (' ');
-      case Bound.Dir is
-         when Dir_To =>
-            Put ("to");
-         when Dir_Downto =>
-            Put ("downto");
-      end case;
-      Put (' ');
-      Put_Int32 (Bound.Right);
-   end Disp_Bound_Type;
-
-   procedure Disp_Type (Typ : Type_Acc; Vtype : Node)
-   is
-      pragma Unreferenced (Vtype);
-   begin
-      case Typ.Kind is
-         when Type_Bit =>
-            Put ("bit");
-         when Type_Logic =>
-            Put ("logic");
-         when Type_Discrete =>
-            Put ("discrete");
-         when Type_Float =>
-            Put ("float");
-         when Type_Vector =>
-            Put ("vector (");
-            Disp_Bound_Type (Typ.Vbound);
-            Put (')');
-         when Type_Unbounded_Vector =>
-            Put ("unbounded_vector");
-         when Type_Array =>
-            Put ("array");
-         when Type_Unbounded_Array =>
-            Put ("unbounded_array");
-         when Type_Unbounded_Record =>
-            Put ("unbounded_record");
-         when Type_Record =>
-            Put ("record");
-         when Type_Slice =>
-            Put ("slice");
-         when Type_Access =>
-            Put ("access");
-         when Type_File =>
-            Put ("file");
-         when Type_Protected =>
-            Put ("protected");
-      end case;
-   end Disp_Type;
-
-   procedure Disp_Declaration_Object
-     (Instance : Synth_Instance_Acc; Decl : Iir) is
-   begin
-      case Get_Kind (Decl) is
-         when Iir_Kind_Constant_Declaration
-           | Iir_Kind_Variable_Declaration
-           | Iir_Kind_Interface_Variable_Declaration
-           | Iir_Kind_Interface_Constant_Declaration
-           | Iir_Kind_Interface_File_Declaration
-           | Iir_Kind_Object_Alias_Declaration
-           | Iir_Kind_Interface_Signal_Declaration
-           | Iir_Kind_Signal_Declaration
-           | Iir_Kind_File_Declaration =>
-            declare
-               Val : constant Valtyp := Get_Value (Instance, Decl);
-               Dtype : constant Node := Get_Type (Decl);
-            begin
-               Put (Vhdl.Errors.Disp_Node (Decl));
-               Put (": ");
-               Disp_Type (Val.Typ, Dtype);
-               Put (" = ");
-               Disp_Value (Val, Dtype);
-               New_Line;
-            end;
-         when Iir_Kinds_Signal_Attribute =>
-            --  FIXME: todo ?
-            null;
-         when Iir_Kind_Type_Declaration
-           | Iir_Kind_Anonymous_Type_Declaration
-           | Iir_Kind_Subtype_Declaration =>
-            --  FIXME: disp ranges
-            null;
-         when Iir_Kind_Function_Declaration
-           | Iir_Kind_Function_Body
-           | Iir_Kind_Procedure_Declaration
-           | Iir_Kind_Procedure_Body =>
-            null;
-         when others =>
-            Vhdl.Errors.Error_Kind ("disp_declaration_object", Decl);
-      end case;
-   end Disp_Declaration_Object;
-
-   procedure Disp_Declaration_Objects
-     (Instance : Synth_Instance_Acc; Decl_Chain : Iir)
-   is
-      El : Iir;
-   begin
-      El := Decl_Chain;
-      while El /= Null_Iir loop
-         Disp_Declaration_Object (Instance, El);
-         El := Get_Chain (El);
-      end loop;
-   end Disp_Declaration_Objects;
-
    procedure Info_Params_Proc (Line : String)
    is
       pragma Unreferenced (Line);
@@ -629,193 +351,6 @@ package body Elab.Debugger is
       Debug_Synth_Instance (Current_Instance);
    end Info_Instance_Proc;
 
-   function Walk_Files (Cb : Walk_Cb) return Walk_Status
-   is
-      Lib : Iir_Library_Declaration := Libraries.Get_Libraries_Chain;
-      File : Iir_Design_File;
-   begin
-      while Lib /= Null_Iir loop
-         File := Get_Design_File_Chain (Lib);
-         while File /= Null_Iir loop
-            case Cb.all (File) is
-               when Walk_Continue =>
-                  null;
-               when Walk_Up =>
-                  exit;
-               when Walk_Abort =>
-                  return Walk_Abort;
-            end case;
-            File := Get_Chain (File);
-         end loop;
-         Lib := Get_Chain (Lib);
-      end loop;
-      return Walk_Continue;
-   end Walk_Files;
-
-   Walk_Units_Cb : Walk_Cb;
-
-   function Cb_Walk_Units (Design_File : Iir) return Walk_Status
-   is
-      Unit : Iir_Design_Unit;
-   begin
-      Unit := Get_First_Design_Unit (Design_File);
-      while Unit /= Null_Iir loop
-         case Walk_Units_Cb.all (Get_Library_Unit (Unit)) is
-            when Walk_Continue =>
-               null;
-            when Walk_Abort =>
-               return Walk_Abort;
-            when Walk_Up =>
-               exit;
-         end case;
-         Unit := Get_Chain (Unit);
-      end loop;
-      return Walk_Continue;
-   end Cb_Walk_Units;
-
-   function Walk_Units (Cb : Walk_Cb) return Walk_Status is
-   begin
-      Walk_Units_Cb := Cb;
-      return Walk_Files (Cb_Walk_Units'Access);
-   end Walk_Units;
-
-   Walk_Declarations_Cb : Walk_Cb;
-
-   function Cb_Walk_Declarations (Unit : Iir) return Walk_Status
-   is
-      function Walk_Decl_Chain (Chain : Iir) return Walk_Status
-      is
-         Decl : Iir;
-      begin
-         Decl := Chain;
-         while Decl /= Null_Iir loop
-            case Walk_Declarations_Cb.all (Decl) is
-               when Walk_Abort =>
-                  return Walk_Abort;
-               when Walk_Up =>
-                  return Walk_Continue;
-               when Walk_Continue =>
-                  null;
-            end case;
-            Decl := Get_Chain (Decl);
-         end loop;
-         return Walk_Continue;
-      end Walk_Decl_Chain;
-
-      function Walk_Conc_Chain (Chain : Iir) return Walk_Status;
-
-      function Walk_Generate_Statement_Body (Bod : Iir) return Walk_Status is
-      begin
-         if Walk_Decl_Chain (Get_Declaration_Chain (Bod)) = Walk_Abort then
-            return Walk_Abort;
-         end if;
-         if Walk_Conc_Chain (Get_Concurrent_Statement_Chain (Bod)) = Walk_Abort
-         then
-            return Walk_Abort;
-         end if;
-         return Walk_Continue;
-      end Walk_Generate_Statement_Body;
-
-      function Walk_Conc_Chain (Chain : Iir) return Walk_Status
-      is
-         Stmt : Iir := Chain;
-      begin
-         while Stmt /= Null_Iir loop
-            case Get_Kind (Stmt) is
-               when Iir_Kinds_Process_Statement =>
-                  if Walk_Decl_Chain (Get_Declaration_Chain (Stmt))
-                    = Walk_Abort
-                  then
-                     return Walk_Abort;
-                  end if;
-               when Iir_Kind_For_Generate_Statement =>
-                  if Walk_Declarations_Cb.all
-                    (Get_Parameter_Specification (Stmt)) = Walk_Abort
-                    or else Walk_Generate_Statement_Body
-                    (Get_Generate_Statement_Body (Stmt)) = Walk_Abort
-                  then
-                     return Walk_Abort;
-                  end if;
-               when Iir_Kind_If_Generate_Statement =>
-                  declare
-                     Stmt1 : Iir;
-                  begin
-                     Stmt1 := Stmt;
-                     while Stmt1 /= Null_Iir loop
-                        if Walk_Generate_Statement_Body
-                          (Get_Generate_Statement_Body (Stmt)) = Walk_Abort
-                        then
-                           return Walk_Abort;
-                        end if;
-                        Stmt1 := Get_Generate_Else_Clause (Stmt1);
-                     end loop;
-                  end;
-               when Iir_Kind_Component_Instantiation_Statement
-                 | Iir_Kind_Concurrent_Simple_Signal_Assignment =>
-                  null;
-               when Iir_Kind_Block_Statement =>
-                  --  FIXME: header
-                  if (Walk_Decl_Chain
-                        (Get_Declaration_Chain (Stmt)) = Walk_Abort)
-                    or else
-                    (Walk_Conc_Chain
-                       (Get_Concurrent_Statement_Chain (Stmt)) = Walk_Abort)
-                  then
-                     return Walk_Abort;
-                  end if;
-               when others =>
-                  Vhdl.Errors.Error_Kind ("walk_conc_chain", Stmt);
-            end case;
-            Stmt := Get_Chain (Stmt);
-         end loop;
-         return Walk_Continue;
-      end Walk_Conc_Chain;
-   begin
-      case Get_Kind (Unit) is
-         when Iir_Kind_Entity_Declaration =>
-            if Walk_Decl_Chain (Get_Generic_Chain (Unit)) = Walk_Abort
-              or else Walk_Decl_Chain (Get_Port_Chain (Unit)) = Walk_Abort
-              or else (Walk_Decl_Chain
-                         (Get_Declaration_Chain (Unit)) = Walk_Abort)
-              or else (Walk_Conc_Chain
-                         (Get_Concurrent_Statement_Chain (Unit)) = Walk_Abort)
-            then
-               return Walk_Abort;
-            end if;
-         when Iir_Kind_Architecture_Body =>
-            if (Walk_Decl_Chain
-                  (Get_Declaration_Chain (Unit)) = Walk_Abort)
-              or else (Walk_Conc_Chain
-                         (Get_Concurrent_Statement_Chain (Unit)) = Walk_Abort)
-            then
-               return Walk_Abort;
-            end if;
-         when Iir_Kind_Package_Declaration
-           | Iir_Kind_Package_Body =>
-            if Walk_Decl_Chain (Get_Declaration_Chain (Unit)) = Walk_Abort
-            then
-               return Walk_Abort;
-            end if;
-         when Iir_Kind_Configuration_Declaration =>
-            if Walk_Decl_Chain (Get_Declaration_Chain (Unit)) = Walk_Abort
-            then
-               return Walk_Abort;
-            end if;
-            --  FIXME: block configuration ?
-         when Iir_Kind_Context_Declaration =>
-            null;
-         when others =>
-            Vhdl.Errors.Error_Kind ("Cb_Walk_Declarations", Unit);
-      end case;
-      return Walk_Continue;
-   end Cb_Walk_Declarations;
-
-   function Walk_Declarations (Cb : Walk_Cb) return Walk_Status is
-   begin
-      Walk_Declarations_Cb := Cb;
-      return Walk_Units (Cb_Walk_Declarations'Access);
-   end Walk_Declarations;
-
    --  Next statement in the same frame, but handle compound statements as
    --  one statement.
    procedure Next_Stmt_Proc (Line : String)
diff --git a/src/synth/elab-vhdl_debug.adb b/src/synth/elab-vhdl_debug.adb
new file mode 100644
index 000000000..014c70a76
--- /dev/null
+++ b/src/synth/elab-vhdl_debug.adb
@@ -0,0 +1,629 @@
+--  Debug utilities on elaborated design
+--  Copyright (C) 2019 Tristan Gingold
+--
+--  This file is part of GHDL.
+--
+--  This program 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 of the License, or
+--  (at your option) any later version.
+--
+--  This program 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 this program.  If not, see <gnu.org/licenses>.
+with Types; use Types;
+with Name_Table; use Name_Table;
+with Simple_IO; use Simple_IO;
+with Utils_IO; use Utils_IO;
+with Libraries;
+
+with Elab.Memtype; use Elab.Memtype;
+with Elab.Vhdl_Values; use Elab.Vhdl_Values;
+
+with Vhdl.Utils; use Vhdl.Utils;
+with Vhdl.Errors;
+
+package body Elab.Vhdl_Debug is
+   procedure Disp_Discrete_Value (Val : Int64; Btype : Node) is
+   begin
+      case Get_Kind (Btype) is
+         when Iir_Kind_Integer_Type_Definition =>
+            Put_Int64 (Val);
+         when Iir_Kind_Enumeration_Type_Definition =>
+            declare
+               Pos : constant Natural := Natural (Val);
+               Enums : constant Node_Flist :=
+                 Get_Enumeration_Literal_List (Btype);
+               Id : constant Name_Id :=
+                 Get_Identifier (Get_Nth_Element (Enums, Pos));
+            begin
+               Put (Name_Table.Image (Id));
+            end;
+         when others =>
+            Vhdl.Errors.Error_Kind ("disp_discrete_value", Btype);
+      end case;
+   end Disp_Discrete_Value;
+
+   procedure Disp_Value_Vector (Mem : Memtyp; A_Type: Node; Bound : Bound_Type)
+   is
+      El_Type : constant Node := Get_Base_Type (Get_Element_Subtype (A_Type));
+      El_Typ : constant Type_Acc := Get_Array_Element (Mem.Typ);
+      type Last_Enum_Type is (None, Char, Identifier);
+      Last_Enum : Last_Enum_Type;
+      Enum_List : Node_Flist;
+      El_Id : Name_Id;
+      El_Pos : Natural;
+   begin
+      --  Pretty print vectors of enumerated types
+      if Get_Kind (El_Type) = Iir_Kind_Enumeration_Type_Definition then
+         Last_Enum := None;
+         Enum_List := Get_Enumeration_Literal_List (El_Type);
+         for I in 1 .. Bound.Len loop
+            El_Pos := Natural
+              (Read_Discrete
+                 (Memtyp'(El_Typ, Mem.Mem + Size_Type (I - 1) * El_Typ.Sz)));
+            El_Id := Get_Identifier (Get_Nth_Element (Enum_List, El_Pos));
+            if Name_Table.Is_Character (El_Id) then
+               case Last_Enum is
+                  when None =>
+                     Put ("""");
+                  when Identifier =>
+                     Put (" & """);
+                  when Char =>
+                     null;
+               end case;
+               Put (Name_Table.Get_Character (El_Id));
+               Last_Enum := Char;
+            else
+               case Last_Enum is
+                  when None =>
+                     null;
+                  when Identifier =>
+                     Put (" & ");
+                  when Char =>
+                     Put (""" & ");
+               end case;
+               Put (Name_Table.Image (El_Id));
+               Last_Enum := Identifier;
+            end if;
+         end loop;
+         case Last_Enum is
+            when None =>
+               Put ("""""");  --  Simply ""
+            when Identifier =>
+               null;
+            when Char =>
+               Put ("""");
+         end case;
+      else
+         Put ("(");
+         for I in 1 .. Bound.Len loop
+            if I /= 1 then
+               Put (", ");
+            end if;
+            Disp_Memtyp ((El_Typ, Mem.Mem + Size_Type (I - 1) * Mem.Typ.Sz),
+                         El_Type);
+         end loop;
+         Put (")");
+      end if;
+   end Disp_Value_Vector;
+
+   procedure Disp_Value_Array (Mem : Memtyp; A_Type: Node; Dim: Dim_Type)
+   is
+      Stride : Size_Type;
+   begin
+      if Dim = Mem.Typ.Abounds.Ndim then
+         --  Last dimension
+         Disp_Value_Vector (Mem, A_Type, Mem.Typ.Abounds.D (Dim));
+      else
+         Stride := Mem.Typ.Arr_El.Sz;
+         for I in Dim + 1 .. Mem.Typ.Abounds.Ndim loop
+            Stride := Stride * Size_Type (Mem.Typ.Abounds.D (I).Len);
+         end loop;
+
+         Put ("(");
+         for I in 1 .. Mem.Typ.Abounds.D (Dim).Len loop
+            if I /= 1 then
+               Put (", ");
+            end if;
+            Disp_Value_Array ((Mem.Typ, Mem.Mem + Stride), A_Type, Dim + 1);
+         end loop;
+         Put (")");
+      end if;
+   end Disp_Value_Array;
+
+   procedure Disp_Memtyp (M : Memtyp; Vtype : Node) is
+   begin
+      if M.Mem = null then
+         Put ("*NULL*");
+         return;
+      end if;
+
+      case M.Typ.Kind is
+         when Type_Discrete
+           | Type_Bit
+           | Type_Logic =>
+            Disp_Discrete_Value (Read_Discrete (M), Get_Base_Type (Vtype));
+         when Type_Vector =>
+            Disp_Value_Vector (M, Vtype, M.Typ.Vbound);
+         when Type_Array =>
+            Disp_Value_Array (M, Vtype, 1);
+         when Type_Float =>
+            Put ("*float*");
+         when Type_Slice =>
+            Put ("*slice*");
+         when Type_File =>
+            Put ("*file*");
+         when Type_Record =>
+            Put ("*record*");
+         when Type_Access =>
+            Put ("*access*");
+         when Type_Protected =>
+            Put ("*protected*");
+         when Type_Unbounded_Array
+            | Type_Unbounded_Record
+            | Type_Unbounded_Vector =>
+            Put ("*unbounded*");
+      end case;
+   end Disp_Memtyp;
+
+   procedure Disp_Value (Vt : Valtyp; Vtype : Node) is
+   begin
+      if Vt.Val = null then
+         Put ("*NULL*");
+         return;
+      end if;
+
+      case Vt.Val.Kind is
+         when Value_Net =>
+            Put ("net");
+         when Value_Wire =>
+            Put ("wire");
+         when Value_Signal =>
+            Put ("signal");
+         when Value_File =>
+            Put ("file");
+         when Value_Const =>
+            Put ("const: ");
+            Disp_Memtyp (Get_Memtyp (Vt), Vtype);
+         when Value_Alias =>
+            Put ("alias");
+            Disp_Memtyp (Get_Memtyp (Vt), Vtype);
+         when Value_Memory =>
+            Disp_Memtyp (Get_Memtyp (Vt), Vtype);
+      end case;
+   end Disp_Value;
+
+   procedure Disp_Bound_Type (Bound : Bound_Type) is
+   begin
+      Put_Int32 (Bound.Left);
+      Put (' ');
+      case Bound.Dir is
+         when Dir_To =>
+            Put ("to");
+         when Dir_Downto =>
+            Put ("downto");
+      end case;
+      Put (' ');
+      Put_Int32 (Bound.Right);
+   end Disp_Bound_Type;
+
+   procedure Disp_Type (Typ : Type_Acc; Vtype : Node)
+   is
+      pragma Unreferenced (Vtype);
+   begin
+      case Typ.Kind is
+         when Type_Bit =>
+            Put ("bit");
+         when Type_Logic =>
+            Put ("logic");
+         when Type_Discrete =>
+            Put ("discrete");
+         when Type_Float =>
+            Put ("float");
+         when Type_Vector =>
+            Put ("vector (");
+            Disp_Bound_Type (Typ.Vbound);
+            Put (')');
+         when Type_Unbounded_Vector =>
+            Put ("unbounded_vector");
+         when Type_Array =>
+            Put ("array");
+         when Type_Unbounded_Array =>
+            Put ("unbounded_array");
+         when Type_Unbounded_Record =>
+            Put ("unbounded_record");
+         when Type_Record =>
+            Put ("record");
+         when Type_Slice =>
+            Put ("slice");
+         when Type_Access =>
+            Put ("access");
+         when Type_File =>
+            Put ("file");
+         when Type_Protected =>
+            Put ("protected");
+      end case;
+   end Disp_Type;
+
+   procedure Disp_Declaration_Object
+     (Instance : Synth_Instance_Acc; Decl : Iir) is
+   begin
+      case Get_Kind (Decl) is
+         when Iir_Kind_Constant_Declaration
+           | Iir_Kind_Variable_Declaration
+           | Iir_Kind_Interface_Variable_Declaration
+           | Iir_Kind_Interface_Constant_Declaration
+           | Iir_Kind_Interface_File_Declaration
+           | Iir_Kind_Object_Alias_Declaration
+           | Iir_Kind_Interface_Signal_Declaration
+           | Iir_Kind_Signal_Declaration
+           | Iir_Kind_File_Declaration =>
+            declare
+               Val : constant Valtyp := Get_Value (Instance, Decl);
+               Dtype : constant Node := Get_Type (Decl);
+            begin
+               Put (Vhdl.Errors.Disp_Node (Decl));
+               Put (": ");
+               Disp_Type (Val.Typ, Dtype);
+               Put (" = ");
+               Disp_Value (Val, Dtype);
+               New_Line;
+            end;
+         when Iir_Kinds_Signal_Attribute =>
+            --  FIXME: todo ?
+            null;
+         when Iir_Kind_Type_Declaration
+           | Iir_Kind_Anonymous_Type_Declaration
+           | Iir_Kind_Subtype_Declaration =>
+            --  FIXME: disp ranges
+            null;
+         when Iir_Kind_Function_Declaration
+           | Iir_Kind_Function_Body
+           | Iir_Kind_Procedure_Declaration
+           | Iir_Kind_Procedure_Body =>
+            null;
+         when others =>
+            Vhdl.Errors.Error_Kind ("disp_declaration_object", Decl);
+      end case;
+   end Disp_Declaration_Object;
+
+   procedure Disp_Declaration_Objects
+     (Instance : Synth_Instance_Acc; Decl_Chain : Iir)
+   is
+      El : Iir;
+   begin
+      El := Decl_Chain;
+      while El /= Null_Iir loop
+         Disp_Declaration_Object (Instance, El);
+         El := Get_Chain (El);
+      end loop;
+   end Disp_Declaration_Objects;
+
+   procedure Disp_Hierarchy_Statements
+     (Inst : Synth_Instance_Acc; Stmts : Node; Indent : Natural)
+   is
+      Stmt : Node;
+   begin
+      Stmt := Stmts;
+      while Stmt /= Null_Node loop
+         case Get_Kind (Stmt) is
+            when Iir_Kind_Component_Instantiation_Statement =>
+               declare
+                  Sub : constant Synth_Instance_Acc :=
+                    Get_Sub_Instance (Inst, Stmt);
+                  Sub_Node : constant Node := Get_Source_Scope (Sub);
+                  Comp_Inst : Synth_Instance_Acc;
+               begin
+                  Put_Indent (Indent);
+                  Put (Image (Get_Label (Stmt)));
+                  case Get_Kind (Sub_Node) is
+                     when Iir_Kind_Component_Declaration =>
+                        Put (": component ");
+                        Put (Image (Get_Identifier (Sub_Node)));
+                        Comp_Inst := Get_Component_Instance (Sub);
+                        if Comp_Inst = null then
+                           Put_Line (" [not bound]");
+                        else
+                           New_Line;
+                           Disp_Hierarchy (Comp_Inst, Indent + 1, False);
+                        end if;
+                     when Iir_Kind_Architecture_Body =>
+                        Put (": entity ");
+                        Put (Image (Get_Identifier (Get_Entity (Sub_Node))));
+                        Put ('(');
+                        Put (Image (Get_Identifier (Sub_Node)));
+                        Put (')');
+                        New_Line;
+                        Disp_Hierarchy_Statements
+                          (Sub,
+                           Get_Concurrent_Statement_Chain (Sub_Node),
+                           Indent + 1);
+                     when others =>
+                        raise Internal_Error;
+                  end case;
+               end;
+            when Iir_Kind_If_Generate_Statement =>
+               declare
+                  Sub : constant Synth_Instance_Acc :=
+                    Get_Sub_Instance (Inst, Stmt);
+               begin
+                  if Sub = null then
+                     return;
+                  end if;
+                  Put_Indent (Indent);
+                  Put (Image (Get_Label (Stmt)));
+                  Put (": if-generate");
+                  if Sub = null then
+                     Put_Line (" [false]");
+                  else
+                     Put_Line (" [true]");
+                     Disp_Hierarchy (Sub, Indent + 1, False);
+                  end if;
+               end;
+            when Iir_Kind_For_Generate_Statement =>
+               declare
+                  It : constant Node := Get_Parameter_Specification (Stmt);
+                  It_Rng : Type_Acc;
+                  It_Len : Natural;
+                  Gen_Inst : Synth_Instance_Acc;
+               begin
+                  Put_Indent (Indent);
+                  Put (Image (Get_Label (Stmt)));
+                  Put (": for-generate");
+                  New_Line;
+
+                  It_Rng := Get_Subtype_Object (Inst, Get_Type (It));
+                  It_Len := Natural (Get_Range_Length (It_Rng.Drange));
+                  Gen_Inst := Get_Sub_Instance (Inst, Stmt);
+                  for I in 1 .. It_Len loop
+                     Disp_Hierarchy (Get_Generate_Sub_Instance (Gen_Inst, I),
+                                     Indent + 1, False);
+                  end loop;
+               end;
+            when Iir_Kind_Block_Statement =>
+               declare
+                  Sub : constant Synth_Instance_Acc :=
+                    Get_Sub_Instance (Inst, Stmt);
+               begin
+                  Put_Indent (Indent);
+                  Put (Image (Get_Label (Stmt)));
+                  Put_Line (": block");
+                  Disp_Hierarchy_Statements
+                    (Sub, Get_Concurrent_Statement_Chain (Stmt), Indent + 1);
+               end;
+            when Iir_Kinds_Concurrent_Signal_Assignment
+              | Iir_Kind_Concurrent_Assertion_Statement
+              | Iir_Kind_Concurrent_Procedure_Call_Statement =>
+               null;
+            when Iir_Kinds_Process_Statement =>
+               null;
+            when others =>
+               Vhdl.Errors.Error_Kind ("disp_hierarchy_statements", Stmt);
+         end case;
+         Stmt := Get_Chain (Stmt);
+      end loop;
+   end Disp_Hierarchy_Statements;
+
+   procedure Disp_Hierarchy
+     (Inst : Synth_Instance_Acc; Indent : Natural; With_Objs : Boolean)
+   is
+      N : constant Node := Get_Source_Scope (Inst);
+   begin
+      case Get_Kind (N) is
+         when Iir_Kind_Architecture_Body =>
+            Put_Indent (Indent);
+            Put ("architecture ");
+            Put (Image (Get_Identifier (N)));
+            Put (" of ");
+            Put (Image (Get_Identifier (Get_Entity (N))));
+            New_Line;
+            Disp_Hierarchy_Statements
+              (Inst, Get_Concurrent_Statement_Chain (N), Indent + 1);
+         when Iir_Kind_Component_Declaration =>
+            Put_Indent (Indent);
+            Put ("component ");
+            Put (Image (Get_Identifier (N)));
+            New_Line;
+            Disp_Hierarchy
+              (Get_Component_Instance (Inst), Indent + 1, With_Objs);
+         when Iir_Kind_Generate_Statement_Body =>
+            Disp_Hierarchy_Statements
+              (Inst, Get_Concurrent_Statement_Chain (N), Indent);
+         when others =>
+            Vhdl.Errors.Error_Kind ("disp_hierarchy", N);
+      end case;
+   end Disp_Hierarchy;
+
+   function Walk_Files (Cb : Walk_Cb) return Walk_Status
+   is
+      Lib : Iir_Library_Declaration := Libraries.Get_Libraries_Chain;
+      File : Iir_Design_File;
+   begin
+      while Lib /= Null_Iir loop
+         File := Get_Design_File_Chain (Lib);
+         while File /= Null_Iir loop
+            case Cb.all (File) is
+               when Walk_Continue =>
+                  null;
+               when Walk_Up =>
+                  exit;
+               when Walk_Abort =>
+                  return Walk_Abort;
+            end case;
+            File := Get_Chain (File);
+         end loop;
+         Lib := Get_Chain (Lib);
+      end loop;
+      return Walk_Continue;
+   end Walk_Files;
+
+   Walk_Units_Cb : Walk_Cb;
+
+   function Cb_Walk_Units (Design_File : Iir) return Walk_Status
+   is
+      Unit : Iir_Design_Unit;
+   begin
+      Unit := Get_First_Design_Unit (Design_File);
+      while Unit /= Null_Iir loop
+         case Walk_Units_Cb.all (Get_Library_Unit (Unit)) is
+            when Walk_Continue =>
+               null;
+            when Walk_Abort =>
+               return Walk_Abort;
+            when Walk_Up =>
+               exit;
+         end case;
+         Unit := Get_Chain (Unit);
+      end loop;
+      return Walk_Continue;
+   end Cb_Walk_Units;
+
+   function Walk_Units (Cb : Walk_Cb) return Walk_Status is
+   begin
+      Walk_Units_Cb := Cb;
+      return Walk_Files (Cb_Walk_Units'Access);
+   end Walk_Units;
+
+   Walk_Declarations_Cb : Walk_Cb;
+
+   function Cb_Walk_Declarations (Unit : Iir) return Walk_Status
+   is
+      function Walk_Decl_Chain (Chain : Iir) return Walk_Status
+      is
+         Decl : Iir;
+      begin
+         Decl := Chain;
+         while Decl /= Null_Iir loop
+            case Walk_Declarations_Cb.all (Decl) is
+               when Walk_Abort =>
+                  return Walk_Abort;
+               when Walk_Up =>
+                  return Walk_Continue;
+               when Walk_Continue =>
+                  null;
+            end case;
+            Decl := Get_Chain (Decl);
+         end loop;
+         return Walk_Continue;
+      end Walk_Decl_Chain;
+
+      function Walk_Conc_Chain (Chain : Iir) return Walk_Status;
+
+      function Walk_Generate_Statement_Body (Bod : Iir) return Walk_Status is
+      begin
+         if Walk_Decl_Chain (Get_Declaration_Chain (Bod)) = Walk_Abort then
+            return Walk_Abort;
+         end if;
+         if Walk_Conc_Chain (Get_Concurrent_Statement_Chain (Bod)) = Walk_Abort
+         then
+            return Walk_Abort;
+         end if;
+         return Walk_Continue;
+      end Walk_Generate_Statement_Body;
+
+      function Walk_Conc_Chain (Chain : Iir) return Walk_Status
+      is
+         Stmt : Iir := Chain;
+      begin
+         while Stmt /= Null_Iir loop
+            case Get_Kind (Stmt) is
+               when Iir_Kinds_Process_Statement =>
+                  if Walk_Decl_Chain (Get_Declaration_Chain (Stmt))
+                    = Walk_Abort
+                  then
+                     return Walk_Abort;
+                  end if;
+               when Iir_Kind_For_Generate_Statement =>
+                  if Walk_Declarations_Cb.all
+                    (Get_Parameter_Specification (Stmt)) = Walk_Abort
+                    or else Walk_Generate_Statement_Body
+                    (Get_Generate_Statement_Body (Stmt)) = Walk_Abort
+                  then
+                     return Walk_Abort;
+                  end if;
+               when Iir_Kind_If_Generate_Statement =>
+                  declare
+                     Stmt1 : Iir;
+                  begin
+                     Stmt1 := Stmt;
+                     while Stmt1 /= Null_Iir loop
+                        if Walk_Generate_Statement_Body
+                          (Get_Generate_Statement_Body (Stmt)) = Walk_Abort
+                        then
+                           return Walk_Abort;
+                        end if;
+                        Stmt1 := Get_Generate_Else_Clause (Stmt1);
+                     end loop;
+                  end;
+               when Iir_Kind_Component_Instantiation_Statement
+                 | Iir_Kind_Concurrent_Simple_Signal_Assignment =>
+                  null;
+               when Iir_Kind_Block_Statement =>
+                  --  FIXME: header
+                  if (Walk_Decl_Chain
+                        (Get_Declaration_Chain (Stmt)) = Walk_Abort)
+                    or else
+                    (Walk_Conc_Chain
+                       (Get_Concurrent_Statement_Chain (Stmt)) = Walk_Abort)
+                  then
+                     return Walk_Abort;
+                  end if;
+               when others =>
+                  Vhdl.Errors.Error_Kind ("walk_conc_chain", Stmt);
+            end case;
+            Stmt := Get_Chain (Stmt);
+         end loop;
+         return Walk_Continue;
+      end Walk_Conc_Chain;
+   begin
+      case Get_Kind (Unit) is
+         when Iir_Kind_Entity_Declaration =>
+            if Walk_Decl_Chain (Get_Generic_Chain (Unit)) = Walk_Abort
+              or else Walk_Decl_Chain (Get_Port_Chain (Unit)) = Walk_Abort
+              or else (Walk_Decl_Chain
+                         (Get_Declaration_Chain (Unit)) = Walk_Abort)
+              or else (Walk_Conc_Chain
+                         (Get_Concurrent_Statement_Chain (Unit)) = Walk_Abort)
+            then
+               return Walk_Abort;
+            end if;
+         when Iir_Kind_Architecture_Body =>
+            if (Walk_Decl_Chain
+                  (Get_Declaration_Chain (Unit)) = Walk_Abort)
+              or else (Walk_Conc_Chain
+                         (Get_Concurrent_Statement_Chain (Unit)) = Walk_Abort)
+            then
+               return Walk_Abort;
+            end if;
+         when Iir_Kind_Package_Declaration
+           | Iir_Kind_Package_Body =>
+            if Walk_Decl_Chain (Get_Declaration_Chain (Unit)) = Walk_Abort
+            then
+               return Walk_Abort;
+            end if;
+         when Iir_Kind_Configuration_Declaration =>
+            if Walk_Decl_Chain (Get_Declaration_Chain (Unit)) = Walk_Abort
+            then
+               return Walk_Abort;
+            end if;
+            --  FIXME: block configuration ?
+         when Iir_Kind_Context_Declaration =>
+            null;
+         when others =>
+            Vhdl.Errors.Error_Kind ("Cb_Walk_Declarations", Unit);
+      end case;
+      return Walk_Continue;
+   end Cb_Walk_Declarations;
+
+   function Walk_Declarations (Cb : Walk_Cb) return Walk_Status is
+   begin
+      Walk_Declarations_Cb := Cb;
+      return Walk_Units (Cb_Walk_Declarations'Access);
+   end Walk_Declarations;
+
+end Elab.Vhdl_Debug;
diff --git a/src/synth/elab-vhdl_debug.ads b/src/synth/elab-vhdl_debug.ads
new file mode 100644
index 000000000..50b50cd56
--- /dev/null
+++ b/src/synth/elab-vhdl_debug.ads
@@ -0,0 +1,33 @@
+--  Debug utilities on elaborated design
+--  Copyright (C) 2019 Tristan Gingold
+--
+--  This file is part of GHDL.
+--
+--  This program 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 of the License, or
+--  (at your option) any later version.
+--
+--  This program 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 this program.  If not, see <gnu.org/licenses>.
+with Vhdl.Nodes; use Vhdl.Nodes;
+with Vhdl.Nodes_Walk; use Vhdl.Nodes_Walk;
+
+with Elab.Vhdl_Objtypes; use Elab.Vhdl_Objtypes;
+with Elab.Vhdl_Context; use Elab.Vhdl_Context;
+
+package Elab.Vhdl_Debug is
+   procedure Disp_Memtyp (M : Memtyp; Vtype : Node);
+   function Walk_Declarations (Cb : Walk_Cb) return Walk_Status;
+
+   procedure Disp_Declaration_Objects
+     (Instance : Synth_Instance_Acc; Decl_Chain : Iir);
+
+   procedure Disp_Hierarchy
+     (Inst : Synth_Instance_Acc; Indent : Natural; With_Objs : Boolean);
+end Elab.Vhdl_Debug;