ghdlsimul: add and improve debugger

6 files changed, 471 insertions, 26 deletions

diff --git a/src/ghdldrv/ghdlsimul.adb b/src/ghdldrv/ghdlsimul.adb
index aaf355aca..62242be3c 100644
--- a/src/ghdldrv/ghdlsimul.adb
+++ b/src/ghdldrv/ghdlsimul.adb
@@ -44,11 +44,14 @@ with Grtlink;
 with Elab.Vhdl_Context;
 with Elab.Vhdl_Debug;
 with Elab.Vhdl_Insts;
+with Elab.Debugger;
 with Synth.Flags;
 with Simul.Vhdl_Elab;
 with Simul.Vhdl_Simul;
 
 package body Ghdlsimul is
+   Flag_Interractive : Boolean := False;
+
    procedure Compile_Init (Analyze_Only : Boolean) is
    begin
       Common_Compile_Init (Analyze_Only);
@@ -98,8 +101,12 @@ package body Ghdlsimul is
       Simul.Vhdl_Elab.Gather_Processes (Inst);
       Simul.Vhdl_Elab.Elab_Processes;
 
+      if Flag_Interractive then
+         Elab.Debugger.Debug_Elab (Inst);
+      end if;
+
       if False then
-         Elab.Vhdl_Debug.Disp_Hierarchy (Inst, True);
+         Elab.Vhdl_Debug.Disp_Hierarchy (Inst, False, True);
       end if;
    end Compile_Elab;
 
@@ -185,6 +192,8 @@ package body Ghdlsimul is
          Synth.Flags.Flag_Debug_Enable := True;
       elsif Option = "-t" then
          Synth.Flags.Flag_Trace_Statements := True;
+      elsif Option = "-i" then
+         Flag_Interractive := True;
       else
          return False;
       end if;
diff --git a/src/synth/elab-debugger.adb b/src/synth/elab-debugger.adb
index 9121cc3a9..33629f278 100644
--- a/src/synth/elab-debugger.adb
+++ b/src/synth/elab-debugger.adb
@@ -24,6 +24,11 @@ package body Elab.Debugger is
       null;
    end Debug_Init;
 
+   procedure Debug_Elab (Top : Synth_Instance_Acc) is
+   begin
+      null;
+   end Debug_Elab;
+
    procedure Debug_Break (Inst : Synth_Instance_Acc; Stmt : Node) is
    begin
       raise Internal_Error;
diff --git a/src/synth/elab-debugger.ads b/src/synth/elab-debugger.ads
index 2b6a79b32..e37ce017f 100644
--- a/src/synth/elab-debugger.ads
+++ b/src/synth/elab-debugger.ads
@@ -27,6 +27,10 @@ package Elab.Debugger is
    Flag_Need_Debug : Boolean := False;
 
    procedure Debug_Init (Top : Node);
+
+   --  Debug after elaboration.  TOP is the top-level unit.
+   procedure Debug_Elab (Top : Synth_Instance_Acc);
+
    procedure Debug_Break (Inst : Synth_Instance_Acc; Stmt : Node);
 
    procedure Debug_Leave (Inst : Synth_Instance_Acc);
diff --git a/src/synth/elab-debugger__on.adb b/src/synth/elab-debugger__on.adb
index e4b021e6a..004ec8423 100644
--- a/src/synth/elab-debugger__on.adb
+++ b/src/synth/elab-debugger__on.adb
@@ -244,6 +244,7 @@ package body Elab.Debugger is
 
    type Menu_Entry (Kind : Menu_Kind) is record
       Name : Cst_String_Acc;
+      Help : Cst_String_Acc;
       Next : Menu_Entry_Acc;
 
       case Kind is
@@ -269,6 +270,11 @@ package body Elab.Debugger is
       return P;
    end Skip_Blanks;
 
+   function Skip_Blanks (S : String; F : Positive) return Positive is
+   begin
+      return Skip_Blanks (S (F .. S'Last));
+   end Skip_Blanks;
+
    --  Return the position of the last character of the word (the last
    --  non-blank character).
    function Get_Word (S : String) return Positive
@@ -281,6 +287,11 @@ package body Elab.Debugger is
       return P - 1;
    end Get_Word;
 
+   function Get_Word (S : String; F : Positive) return Positive is
+   begin
+      return Get_Word (S (F .. S'Last));
+   end Get_Word;
+
    procedure Info_Params_Proc (Line : String)
    is
       pragma Unreferenced (Line);
@@ -480,80 +491,172 @@ package body Elab.Debugger is
       Disp_Current_Lines;
    end List_Proc;
 
+   procedure List_Hierarchy (Line : String)
+   is
+      With_Objs : Boolean;
+      Recurse : Boolean;
+      F, L : Natural;
+   begin
+      With_Objs := False;
+      Recurse := False;
+      F := Line'First;
+      loop
+         F := Skip_Blanks (Line, F);
+         exit when F > Line'Last;
+         L := Get_Word (Line, F);
+         if Line (F .. L) = "-v" then
+            With_Objs := True;
+         elsif Line (F .. L) = "-R" then
+            Recurse := True;
+         else
+            Put_Line ("unknown option: " & Line (F .. L));
+            return;
+         end if;
+         F := L + 1;
+      end loop;
+
+      Disp_Hierarchy (Current_Instance, Recurse, With_Objs);
+   end List_Hierarchy;
+
+   procedure Change_Hierarchy (Line : String)
+   is
+      F : Natural;
+      Res : Synth_Instance_Acc;
+   begin
+      F := Skip_Blanks (Line);
+      if Line (F .. Line'Last) = ".." then
+         Res := Get_Instance_Path_Parent (Current_Instance);
+         if Res = null then
+            Put_Line ("already at top");
+            return;
+         end if;
+      else
+         Res := Get_Sub_Instance_By_Name (Current_Instance,
+                                          Line (F .. Line'Last));
+         if Res = null then
+            Put_Line ("no such sub-instance");
+            return;
+         end if;
+      end if;
+      Current_Instance := Res;
+   end Change_Hierarchy;
+
+   procedure Print_Hierarchy_Path (Line : String)
+   is
+      pragma Unreferenced (Line);
+   begin
+      Disp_Instance_Path (Current_Instance);
+      New_Line;
+   end Print_Hierarchy_Path;
+
    Menu_Info_Instance : aliased Menu_Entry :=
      (Kind => Menu_Command,
       Name => new String'("inst*ance"),
+      Help => new String'("display instance info"),
       Next => null, -- Menu_Info_Tree'Access,
       Proc => Info_Instance_Proc'Access);
 
    Menu_Info_Locals : aliased Menu_Entry :=
      (Kind => Menu_Command,
       Name => new String'("locals"),
+      Help => new String'("display local objects"),
       Next => Menu_Info_Instance'Access,
       Proc => Info_Locals_Proc'Access);
 
    Menu_Info_Params : aliased Menu_Entry :=
      (Kind => Menu_Command,
       Name => new String'("param*eters"),
+      Help => new String'("display parameters"),
       Next => Menu_Info_Locals'Access, -- Menu_Info_Tree'Access,
       Proc => Info_Params_Proc'Access);
 
    Menu_Info : aliased Menu_Entry :=
      (Kind => Menu_Submenu,
       Name => new String'("i*nfo"),
+      Help => null,
       Next => null, -- Menu_Ps'Access,
       First | Last => Menu_Info_Params'Access); --  Menu_Info_Proc'Access);
 
+   Menu_Pwh : aliased Menu_Entry :=
+     (Kind => Menu_Command,
+      Name => new String'("pwh"),
+      Help => new String'("display current hierarchy path"),
+      Next => Menu_Info'Access,
+      Proc => Print_Hierarchy_Path'Access);
+
+   Menu_Ch : aliased Menu_Entry :=
+     (Kind => Menu_Command,
+      Name => new String'("ch"),
+      Help => new String'("change hierarchy path"),
+      Next => Menu_Pwh'Access,
+      Proc => Change_Hierarchy'Access);
+
+   Menu_Lh : aliased Menu_Entry :=
+     (Kind => Menu_Command,
+      Name => new String'("lh"),
+      Help => new String'("list hierarchy"),
+      Next => Menu_Ch'Access,
+      Proc => List_Hierarchy'Access);
+
    Menu_List : aliased Menu_Entry :=
      (Kind => Menu_Command,
       Name => new String'("l*list"),
-      Next => Menu_Info'Access, -- null,
+      Help => new String'("list source around current line"),
+      Next => Menu_Lh'Access,
       Proc => List_Proc'Access);
 
    Menu_Cont : aliased Menu_Entry :=
      (Kind => Menu_Command,
       Name => new String'("c*ont"),
+      Help => new String'("continue simulation"),
       Next => Menu_List'Access, --Menu_Print'Access,
       Proc => Cont_Proc'Access);
 
    Menu_Nstmt : aliased Menu_Entry :=
      (Kind => Menu_Command,
       Name => new String'("ns*tmt"),
+      Help => new String'("execute statement (next statement)"),
       Next => Menu_Cont'Access, -- Menu_Up'Access,
       Proc => Next_Stmt_Proc'Access);
 
    Menu_Fstmt : aliased Menu_Entry :=
      (Kind => Menu_Command,
       Name => new String'("fs*tmt"),
+      Help => new String'("execute until end of subprogram"),
       Next => Menu_Nstmt'Access,
       Proc => Finish_Stmt_Proc'Access);
 
    Menu_Next : aliased Menu_Entry :=
      (Kind => Menu_Command,
       Name => new String'("n*ext"),
+      Help => new String'("execute to next statement"),
       Next => Menu_Fstmt'Access,
       Proc => Next_Proc'Access);
 
    Menu_Step : aliased Menu_Entry :=
      (Kind => Menu_Command,
       Name => new String'("s*tep"),
+      Help => new String'("execute one statement"),
       Next => Menu_Next'Access,
       Proc => Step_Proc'Access);
 
    Menu_Break : aliased Menu_Entry :=
      (Kind => Menu_Command,
       Name => new String'("b*reak"),
+      Help => new String'("set a breakpoint (or list then)"),
       Next => Menu_Step'Access,
       Proc => Break_Proc'Access);
 
    Menu_Help2 : aliased Menu_Entry :=
      (Kind => Menu_Command,
       Name => new String'("?"),
+      Help => new String'("print help"),
       Next => Menu_Break'Access, --  Menu_Help1'Access,
       Proc => Help_Proc'Access);
 
    Menu_Top : aliased Menu_Entry :=
      (Kind => Menu_Submenu,
+      Help => null,
       Name => null,
       Next => null,
       First | Last => Menu_Help2'Access);
@@ -789,6 +892,19 @@ package body Elab.Debugger is
       Debug (Reason_Init);
    end Debug_Init;
 
+   procedure Debug_Elab (Top : Synth_Instance_Acc) is
+   begin
+      Current_Instance := Top;
+      Current_Loc := Get_Source_Scope (Top);
+      Flag_Enabled := True;
+
+      --  To avoid warnings.
+      Exec_Statement := Null_Node;
+      Exec_Instance := null;
+
+      Debug (Reason_Init);
+   end Debug_Elab;
+
    procedure Debug_Break (Inst : Synth_Instance_Acc; Stmt : Node) is
    begin
       Current_Instance := Inst;
diff --git a/src/synth/elab-vhdl_debug.adb b/src/synth/elab-vhdl_debug.adb
index bdab9674f..e7cc2fc1e 100644
--- a/src/synth/elab-vhdl_debug.adb
+++ b/src/synth/elab-vhdl_debug.adb
@@ -31,9 +31,11 @@ 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 =>
+         when Iir_Kind_Integer_Type_Definition
+           | Iir_Kind_Integer_Subtype_Definition =>
             Put_Int64 (Val);
-         when Iir_Kind_Enumeration_Type_Definition =>
+         when Iir_Kind_Enumeration_Type_Definition
+           | Iir_Kind_Enumeration_Subtype_Definition =>
             declare
                Pos : constant Natural := Natural (Val);
                Enums : constant Node_Flist :=
@@ -200,20 +202,34 @@ package body Elab.Vhdl_Debug is
       end case;
    end Disp_Value;
 
-   procedure Disp_Bound_Type (Bound : Bound_Type) is
+   procedure Disp_Direction (Dir : Direction_Type) is
    begin
-      Put_Int32 (Bound.Left);
-      Put (' ');
-      case Bound.Dir is
+      case Dir is
          when Dir_To =>
             Put ("to");
          when Dir_Downto =>
             Put ("downto");
       end case;
+   end Disp_Direction;
+
+   procedure Disp_Bound_Type (Bound : Bound_Type) is
+   begin
+      Put_Int32 (Bound.Left);
+      Put (' ');
+      Disp_Direction (Bound.Dir);
       Put (' ');
       Put_Int32 (Bound.Right);
    end Disp_Bound_Type;
 
+   procedure Disp_Discrete_Range (Rng : Discrete_Range_Type; Vtype : Node) is
+   begin
+      Disp_Discrete_Value (Rng.Left, Vtype);
+      Put (' ');
+      Disp_Direction (Rng.Dir);
+      Put (' ');
+      Disp_Discrete_Value (Rng.Right, Vtype);
+   end Disp_Discrete_Range;
+
    procedure Disp_Type (Typ : Type_Acc; Vtype : Node)
    is
       pragma Unreferenced (Vtype);
@@ -313,6 +329,7 @@ package body Elab.Vhdl_Debug is
    package Hierarchy_Pkg is
       type Config_Type is record
          With_Objs : Boolean;
+         Recurse : Boolean;
          Indent : Natural;
       end record;
 
@@ -363,7 +380,7 @@ package body Elab.Vhdl_Debug is
                              (Sub, Get_Port_Chain (Sub_Node),
                               Cfg.Indent);
                         end if;
-                        if Comp_Inst /= null then
+                        if Cfg.Recurse and then Comp_Inst /= null then
                            Disp_Hierarchy (Comp_Inst, Inc_Indent (Cfg));
                         end if;
                      when Iir_Kind_Architecture_Body =>
@@ -374,7 +391,9 @@ package body Elab.Vhdl_Debug is
                         Put (Image (Get_Identifier (Sub_Node)));
                         Put (')');
                         New_Line;
-                        Disp_Hierarchy (Sub, Inc_Indent (Cfg));
+                        if Cfg.Recurse then
+                           Disp_Hierarchy (Sub, Inc_Indent (Cfg));
+                        end if;
                      when others =>
                         raise Internal_Error;
                   end case;
@@ -394,12 +413,15 @@ package body Elab.Vhdl_Debug is
                      Put_Line (" [false]");
                   else
                      Put_Line (" [true]");
-                     Disp_Hierarchy (Sub, Inc_Indent (Cfg));
+                     if Cfg.Recurse then
+                        Disp_Hierarchy (Sub, Inc_Indent (Cfg));
+                     end if;
                   end if;
                end;
             when Iir_Kind_For_Generate_Statement =>
                declare
                   It : constant Node := Get_Parameter_Specification (Stmt);
+                  It_Type : constant Node := Get_Type (It);
                   It_Rng : Type_Acc;
                   It_Len : Natural;
                   Gen_Inst : Synth_Instance_Acc;
@@ -407,16 +429,20 @@ package body Elab.Vhdl_Debug is
                   Put_Indent (Cfg.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),
-                        Inc_Indent (Cfg));
-                  end loop;
+                  Put (" (");
+                  It_Rng := Get_Subtype_Object (Inst, It_Type);
+                  Disp_Discrete_Range (It_Rng.Drange, It_Type);
+                  Put_Line (")");
+
+                  if Cfg.Recurse then
+                     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),
+                           Inc_Indent (Cfg));
+                     end loop;
+                  end if;
                end;
             when Iir_Kind_Block_Statement =>
                declare
@@ -426,9 +452,11 @@ package body Elab.Vhdl_Debug is
                   Put_Indent (Cfg.Indent);
                   Put (Image (Get_Label (Stmt)));
                   Put_Line (": block");
-                  Disp_Hierarchy_Statements
-                    (Sub, Get_Concurrent_Statement_Chain (Stmt),
-                     Inc_Indent (Cfg));
+                  if Cfg.Recurse then
+                     Disp_Hierarchy_Statements
+                       (Sub, Get_Concurrent_Statement_Chain (Stmt),
+                        Inc_Indent (Cfg));
+                  end if;
                end;
             when Iir_Kinds_Concurrent_Signal_Assignment
               | Iir_Kind_Concurrent_Assertion_Statement
@@ -500,6 +528,17 @@ package body Elab.Vhdl_Debug is
                Disp_Hierarchy
                  (Get_Component_Instance (Inst), Inc_Indent (Cfg));
             when Iir_Kind_Generate_Statement_Body =>
+               Put_Indent (Cfg.Indent);
+               Put ("generate statement body");
+               --  TODO: disp label or index ?
+               New_Line;
+               Disp_Hierarchy_Statements
+                 (Inst, Get_Concurrent_Statement_Chain (N), Cfg);
+            when Iir_Kind_Block_Statement =>
+               Put_Indent (Cfg.Indent);
+               Put ("block statement ");
+               Put (Image (Get_Identifier (N)));
+               New_Line;
                Disp_Hierarchy_Statements
                  (Inst, Get_Concurrent_Statement_Chain (N), Cfg);
             when others =>
@@ -508,12 +547,15 @@ package body Elab.Vhdl_Debug is
       end Disp_Hierarchy;
    end Hierarchy_Pkg;
 
-   procedure Disp_Hierarchy (Inst : Synth_Instance_Acc; With_Objs : Boolean)
+   procedure Disp_Hierarchy (Inst : Synth_Instance_Acc;
+                             Recurse : Boolean;
+                             With_Objs : Boolean)
    is
       use Hierarchy_Pkg;
       Cfg : Config_Type;
    begin
       Cfg := (With_Objs => With_Objs,
+              Recurse => Recurse,
               Indent => 0);
       Hierarchy_Pkg.Disp_Hierarchy (Inst, Cfg);
    end Disp_Hierarchy;
@@ -705,4 +747,261 @@ package body Elab.Vhdl_Debug is
       return Walk_Units (Cb_Walk_Declarations'Access);
    end Walk_Declarations;
 
+   function Find_Concurrent_Statement_By_Name (Stmts : Node; Id : Name_Id)
+                                              return Node
+   is
+      Stmt : Node;
+   begin
+      Stmt := Stmts;
+      while Stmt /= Null_Node loop
+         if Get_Label (Stmt) = Id then
+            return Stmt;
+         end if;
+         Stmt := Get_Chain (Stmt);
+      end loop;
+      return Null_Node;
+   end Find_Concurrent_Statement_By_Name;
+
+   function Get_Sub_Instance_By_Name (Inst : Synth_Instance_Acc; Name : String)
+                                     return Synth_Instance_Acc
+   is
+      Scope : constant Node := Get_Source_Scope (Inst);
+      Has_Index : Boolean;
+      End_Id : Natural;
+      Index : Int64;
+      Stmt : Node;
+      Id : Name_Id;
+   begin
+      End_Id := Name'Last;
+      Has_Index := Name (End_Id) = ')';
+      Index := 0;
+      if Has_Index then
+         --  There is a loop-generate index.
+         --  Search for '('.
+         for I in Name'Range loop
+            if Name (I) = '(' then
+               End_Id := I - 1;
+               exit;
+            end if;
+         end loop;
+         if End_Id = Name'Last or End_Id = Name'First then
+            return null;
+         end if;
+         --  Decode index (assume int).
+         for P in End_Id + 2 .. Name'Last - 1 loop
+            if Name (P) in '0' .. '9' then
+               Index := Index * 10
+                 + Character'Pos (Name (P)) - Character'Pos ('0');
+            else
+               return null;
+            end if;
+         end loop;
+      end if;
+
+      Id := Get_Identifier_No_Create (Name (Name'First .. End_Id));
+      if Id = Null_Identifier then
+         --  All the identifiers are known, so this name cannot exist.
+         return null;
+      end if;
+      case Get_Kind (Scope) is
+         when Iir_Kind_Architecture_Body
+           | Iir_Kind_Generate_Statement_Body
+           | Iir_Kind_Block_Statement =>
+            Stmt := Find_Concurrent_Statement_By_Name
+              (Get_Concurrent_Statement_Chain (Scope), Id);
+         when others =>
+            Vhdl.Errors.Error_Kind ("get_sub_instance(1)", Scope);
+      end case;
+
+      if Stmt = Null_Node then
+         return null;
+      end if;
+
+      case Get_Kind (Stmt) is
+         when Iir_Kind_Component_Instantiation_Statement =>
+            if Has_Index then
+               return null;
+            end if;
+            declare
+               Sub_Inst : constant Synth_Instance_Acc :=
+                 Get_Sub_Instance (Inst, Stmt);
+               Sub_Node : constant Node := Get_Source_Scope (Sub_Inst);
+            begin
+               case Get_Kind (Sub_Node) is
+                  when Iir_Kind_Component_Declaration =>
+                     return Get_Component_Instance (Sub_Inst);
+                  when Iir_Kind_Architecture_Body =>
+                     return Sub_Inst;
+                  when others =>
+                     raise Internal_Error;
+               end case;
+            end;
+         when Iir_Kind_If_Generate_Statement
+           | Iir_Kind_Block_Statement =>
+            if Has_Index then
+               return null;
+            end if;
+            return Get_Sub_Instance (Inst, Stmt);
+         when Iir_Kind_For_Generate_Statement =>
+            if not Has_Index then
+               return null;
+            end if;
+            declare
+               Iterator : constant Node :=
+                 Get_Parameter_Specification (Stmt);
+               It_Rng : constant Type_Acc :=
+                 Get_Subtype_Object (Inst, Get_Type (Iterator));
+               Gen_Inst : constant Synth_Instance_Acc :=
+                 Get_Sub_Instance (Inst, Stmt);
+               Off : Int64;
+            begin
+               case It_Rng.Drange.Dir is
+                  when Dir_To =>
+                     if Index < It_Rng.Drange.Left
+                       or else Index > It_Rng.Drange.Right
+                     then
+                        return null;
+                     end if;
+                     Off := Index - It_Rng.Drange.Left + 1;
+                  when Dir_Downto =>
+                     if Index > It_Rng.Drange.Left
+                       or else Index < It_Rng.Drange.Right
+                     then
+                        return null;
+                     end if;
+                     Off := Index - It_Rng.Drange.Right + 1;
+               end case;
+               return Get_Generate_Sub_Instance (Gen_Inst, Positive (Off));
+            end;
+         when Iir_Kinds_Concurrent_Signal_Assignment
+           | Iir_Kind_Concurrent_Assertion_Statement
+           | Iir_Kind_Concurrent_Procedure_Call_Statement =>
+            return null;
+         when others =>
+            Vhdl.Errors.Error_Kind ("get_sub_instance(2)", Stmt);
+      end case;
+   end Get_Sub_Instance_By_Name;
+
+   function Find_Concurrent_Statement_By_Instance
+     (Inst : Synth_Instance_Acc;
+      Stmts : Node;
+      Sub_Inst : Synth_Instance_Acc) return Node
+   is
+      Stmt : Node;
+   begin
+      Stmt := Stmts;
+      while Stmt /= Null_Node loop
+         case Get_Kind (Stmt) is
+            when Iir_Kind_Component_Instantiation_Statement
+              | Iir_Kind_If_Generate_Statement
+              | Iir_Kind_Block_Statement =>
+               declare
+                  Sub : constant Synth_Instance_Acc :=
+                    Get_Sub_Instance (Inst, Stmt);
+               begin
+                  if Sub = Sub_Inst then
+                     return Stmt;
+                  end if;
+               end;
+            when Iir_Kind_For_Generate_Statement =>
+               declare
+                  Sub : constant Synth_Instance_Acc :=
+                    Get_Sub_Instance (Inst, Stmt);
+               begin
+                  if Sub = Sub_Inst then -- Get_Instance_Parent (Sub_Inst) then
+                     return Stmt;
+                  end if;
+               end;
+            when others =>
+               null;
+         end case;
+         Stmt := Get_Chain (Stmt);
+      end loop;
+      raise Internal_Error;
+   end Find_Concurrent_Statement_By_Instance;
+
+   function Skip_Instance_Parent (Inst : Synth_Instance_Acc)
+                                 return Synth_Instance_Acc
+   is
+      Parent : constant Synth_Instance_Acc := Get_Instance_Parent (Inst);
+      Parent_Scope : constant Node := Get_Source_Scope (Parent);
+   begin
+      if Parent_Scope = Null_Node then
+         --  The root.
+         return null;
+      end if;
+
+      case Get_Kind (Parent_Scope) is
+         when Iir_Kind_Architecture_Body
+           | Iir_Kind_Block_Statement =>
+            return Inst;
+         when Iir_Kind_Component_Declaration =>
+            return Parent;
+         when Iir_Kind_For_Generate_Statement =>
+            return Parent;
+         when Iir_Kind_Generate_Statement_Body =>
+            --  For an if-generate, the parent is really the parent.
+            return Inst;
+         when others =>
+            Vhdl.Errors.Error_Kind ("skip_instance_parent", Parent_Scope);
+      end case;
+   end Skip_Instance_Parent;
+
+   function Get_Instance_Path_Parent (Inst : Synth_Instance_Acc)
+                                     return Synth_Instance_Acc
+   is
+      Pre_Parent : constant Synth_Instance_Acc := Skip_Instance_Parent (Inst);
+   begin
+      if Pre_Parent = null then
+         --  The root.
+         return null;
+      end if;
+      return Get_Instance_Parent (Pre_Parent);
+   end Get_Instance_Path_Parent;
+
+   procedure Disp_Instance_Path_1 (Inst : Synth_Instance_Acc)
+   is
+      Pre_Parent_Inst : constant Synth_Instance_Acc :=
+        Skip_Instance_Parent (Inst);
+      Parent_Inst : Synth_Instance_Acc;
+      Parent_Scope : Node;
+      Stmt : Node;
+   begin
+      if Pre_Parent_Inst = null then
+         return;
+      end if;
+
+      Parent_Inst := Get_Instance_Parent (Pre_Parent_Inst);
+      Parent_Scope := Get_Source_Scope (Parent_Inst);
+      Disp_Instance_Path (Parent_Inst);
+      Put ('/');
+
+      Stmt := Find_Concurrent_Statement_By_Instance
+        (Parent_Inst, Get_Concurrent_Statement_Chain (Parent_Scope),
+         Pre_Parent_Inst);
+      Put (Image (Get_Identifier (Stmt)));
+      if Get_Kind (Stmt) = Iir_Kind_For_Generate_Statement then
+         declare
+            It : constant Node := Get_Parameter_Specification (Stmt);
+            It_Type : constant Node := Get_Type (It);
+            Val : constant Valtyp := Get_Value (Inst, It);
+         begin
+            Put ("(");
+            Disp_Discrete_Value (Read_Discrete (Val), It_Type);
+            Put (")");
+         end;
+      end if;
+   end Disp_Instance_Path_1;
+
+   procedure Disp_Instance_Path (Inst : Synth_Instance_Acc)
+   is
+      Parent : constant Synth_Instance_Acc := Get_Instance_Parent (Inst);
+   begin
+      if Parent = null then
+         --  The root.
+         Put ('/');
+      else
+         Disp_Instance_Path_1 (Inst);
+      end if;
+   end Disp_Instance_Path;
 end Elab.Vhdl_Debug;
diff --git a/src/synth/elab-vhdl_debug.ads b/src/synth/elab-vhdl_debug.ads
index d7dc8cc84..e6ad47070 100644
--- a/src/synth/elab-vhdl_debug.ads
+++ b/src/synth/elab-vhdl_debug.ads
@@ -28,5 +28,17 @@ package Elab.Vhdl_Debug is
    procedure Disp_Declaration_Objects
      (Instance : Synth_Instance_Acc; Decl_Chain : Iir; Indent : Natural := 0);
 
-   procedure Disp_Hierarchy (Inst : Synth_Instance_Acc; With_Objs : Boolean);
+   procedure Disp_Hierarchy (Inst : Synth_Instance_Acc;
+                             Recurse : Boolean;
+                             With_Objs : Boolean);
+
+   --  Get sub-instance NAME of INST.  Return null if not found.
+   function Get_Sub_Instance_By_Name (Inst : Synth_Instance_Acc; Name : String)
+                                     return Synth_Instance_Acc;
+
+   function Get_Instance_Path_Parent (Inst : Synth_Instance_Acc)
+                                     return Synth_Instance_Acc;
+
+   --  Disp full path name of INST.
+   procedure Disp_Instance_Path (Inst : Synth_Instance_Acc);
 end Elab.Vhdl_Debug;