From 7ee7edde5087ca219b23fd6a65f6c3804cccaa83 Mon Sep 17 00:00:00 2001
From: Tristan Gingold <tgingold@free.fr>
Date: Tue, 8 Mar 2022 08:06:56 +0100
Subject: synth: add debug_bt

---
 src/synth/elab-debugger__on.adb | 28 ++++++++++++++++++++++++++++
 src/synth/elab-vhdl_context.adb | 17 +++++++++++++++++
 src/synth/elab-vhdl_context.ads | 10 ++++++++++
 src/synth/synth-vhdl_stmts.adb  |  1 +
 4 files changed, 56 insertions(+)

diff --git a/src/synth/elab-debugger__on.adb b/src/synth/elab-debugger__on.adb
index 608edbb07..faab400ca 100644
--- a/src/synth/elab-debugger__on.adb
+++ b/src/synth/elab-debugger__on.adb
@@ -1293,4 +1293,32 @@ package body Elab.Debugger is
          Debug (Reason_Error);
       end if;
    end Debug_Error;
+
+   procedure Disp_A_Frame (Inst: Synth_Instance_Acc) is
+   begin
+      if Inst = Root_Instance then
+         Put_Line ("root instance");
+         return;
+      end if;
+
+      Put (Vhdl.Errors.Disp_Node (Get_Source_Scope (Inst)));
+--      if Inst.Stmt /= Null_Iir then
+--         Put (" at ");
+--         Put (Files_Map.Image (Get_Location (Inst.Stmt)));
+--      end if;
+      New_Line;
+   end Disp_A_Frame;
+
+   procedure Debug_Bt (Instance : Synth_Instance_Acc)
+   is
+      Inst : Synth_Instance_Acc;
+   begin
+      Inst := Instance;
+      while Inst /= null loop
+         Disp_A_Frame (Inst);
+         Inst := Get_Caller_Instance (Inst);
+      end loop;
+   end Debug_Bt;
+   pragma Unreferenced (Debug_Bt);
+
 end Elab.Debugger;
diff --git a/src/synth/elab-vhdl_context.adb b/src/synth/elab-vhdl_context.adb
index 97a849d21..032ab82b0 100644
--- a/src/synth/elab-vhdl_context.adb
+++ b/src/synth/elab-vhdl_context.adb
@@ -53,6 +53,7 @@ package body Elab.Vhdl_Context is
                                  Up_Block => null,
                                  Uninst_Scope => null,
                                  Source_Scope => Null_Node,
+                                 Caller       => null,
                                  Config       => Null_Node,
                                  Foreign      => 0,
                                  Extra_Units  => null,
@@ -100,6 +101,7 @@ package body Elab.Vhdl_Context is
                                       Up_Block => Parent,
                                       Uninst_Scope => null,
                                       Source_Scope => Blk,
+                                      Caller       => null,
                                       Config       => Config,
                                       Foreign      => 0,
                                       Extra_Units  => null,
@@ -140,6 +142,7 @@ package body Elab.Vhdl_Context is
                                       Up_Block => Parent,
                                       Uninst_Scope => null,
                                       Source_Scope => Blk,
+                                      Caller       => null,
                                       Config       => Config,
                                       Foreign      => 0,
                                       Extra_Units  => null,
@@ -533,4 +536,18 @@ package body Elab.Vhdl_Context is
       Obj_Inst := Get_Instance_By_Scope (Syn_Inst, Info.Obj_Scope);
       return Obj_Inst.Objects (Info.Slot).T_Typ;
    end Get_Subtype_Object;
+
+   procedure Set_Caller_Instance (Syn_Inst : Synth_Instance_Acc;
+                                  Caller : Synth_Instance_Acc) is
+   begin
+      pragma Assert (Syn_Inst.Caller = null);
+      Syn_Inst.Caller := Caller;
+   end Set_Caller_Instance;
+
+   function Get_Caller_Instance (Syn_Inst : Synth_Instance_Acc)
+                                return Synth_Instance_Acc is
+   begin
+      return Syn_Inst.Caller;
+   end Get_Caller_Instance;
+
 end Elab.Vhdl_Context;
diff --git a/src/synth/elab-vhdl_context.ads b/src/synth/elab-vhdl_context.ads
index 8924da120..ea4d4cd67 100644
--- a/src/synth/elab-vhdl_context.ads
+++ b/src/synth/elab-vhdl_context.ads
@@ -162,6 +162,12 @@ package Elab.Vhdl_Context is
 
    procedure Set_Uninstantiated_Scope
      (Syn_Inst : Synth_Instance_Acc; Bod : Node);
+
+   --  For debugging purpose: update the caller of an instance.
+   procedure Set_Caller_Instance (Syn_Inst : Synth_Instance_Acc;
+                                  Caller : Synth_Instance_Acc);
+   function Get_Caller_Instance (Syn_Inst : Synth_Instance_Acc)
+                                return Synth_Instance_Acc;
 private
    type Obj_Kind is
      (
@@ -209,6 +215,10 @@ private
       --  Instance of the parent scope.
       Up_Block : Synth_Instance_Acc;
 
+      --  For a subprogram instance, the instance of the caller.
+      --  Used only fo debugging purpose.
+      Caller : Synth_Instance_Acc;
+
       --  Source construct corresponding to this instance.
       Source_Scope : Node;
 
diff --git a/src/synth/synth-vhdl_stmts.adb b/src/synth/synth-vhdl_stmts.adb
index b28c6f0f5..c715ba153 100644
--- a/src/synth/synth-vhdl_stmts.adb
+++ b/src/synth/synth-vhdl_stmts.adb
@@ -2149,6 +2149,7 @@ package body Synth.Vhdl_Stmts is
 
       Up_Inst := Get_Instance_By_Scope (Syn_Inst, Get_Parent_Scope (Imp));
       Sub_Inst := Make_Elab_Instance (Up_Inst, Bod, Config => Null_Node);
+      Set_Caller_Instance (Sub_Inst, Syn_Inst);
       if Ctxt /= null then
          Set_Extra (Sub_Inst, Syn_Inst, New_Internal_Name (Ctxt));
       end if;
-- 
cgit v1.2.3