path: root/src/synth/elab-vhdl_debug.adb

--  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 Name_Table; use Name_Table;
with Simple_IO; use Simple_IO;
with Utils_IO; use Utils_IO;
with Files_Map;
with Libraries;
with Std_Names;
with Errorout;

with Elab.Debugger; use Elab.Debugger;
with Elab.Memtype; use Elab.Memtype;
with Elab.Vhdl_Annotations;
with Elab.Vhdl_Values; use Elab.Vhdl_Values;
with Elab.Vhdl_Values.Debug; use Elab.Vhdl_Values.Debug;
with Elab.Vhdl_Heap;

with Synth.Vhdl_Expr;

with Vhdl.Utils; use Vhdl.Utils;
with Vhdl.Errors;
with Vhdl.Tokens;
with Vhdl.Scanner;
with Vhdl.Parse;
with Vhdl.Sem_Scopes;
with Vhdl.Sem_Expr;
with Vhdl.Canon;
with Vhdl.Std_Package;
with Vhdl.Prints;

package body Elab.Vhdl_Debug is
   procedure Put_Stmt_Trace (Stmt : Iir)
   is
      Name : Name_Id;
      Line : Natural;
      Col : Natural;
   begin
      Files_Map.Location_To_Position (Get_Location (Stmt), Name, Line, Col);
      Simple_IO.Put_Line ("Execute statement at "
                            & Name_Table.Image (Name)
                            & Natural'Image (Line));
   end Put_Stmt_Trace;

   procedure Disp_Integer_Value (Val : Int64; Btype : Node)
   is
      pragma Unreferenced (Btype);
   begin
      Put_Int64 (Val);
   end Disp_Integer_Value;

   procedure Disp_Enumeration_Value (Val : Int64; Btype : Node)
   is
      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 Disp_Enumeration_Value;

   procedure Disp_Physical_Value (Val : Int64; Btype : Node)
   is
      Id : constant Name_Id := Get_Identifier (Get_Primary_Unit (Btype));
   begin
      Put_Int64 (Val);
      Put (' ');
      Put (Name_Table.Image (Id));
   end Disp_Physical_Value;

   procedure Disp_Float_Value (Val : Fp64; Btype : Node)
   is
      pragma Unreferenced (Btype);
   begin
      Put_Fp64 (Val);
   end Disp_Float_Value;

   procedure Disp_Discrete_Value (Val : Int64; Btype : Node) is
   begin
      case Get_Kind (Btype) is
         when Iir_Kind_Integer_Type_Definition
           | Iir_Kind_Integer_Subtype_Definition =>
            Disp_Integer_Value (Val, Btype);
         when Iir_Kind_Enumeration_Type_Definition
           | Iir_Kind_Enumeration_Subtype_Definition =>
            Disp_Enumeration_Value (Val, Btype);
         when Iir_Kind_Physical_Type_Definition =>
            Disp_Physical_Value (Val, Btype);
         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) * El_Typ.Sz),
                         El_Type);
         end loop;
         Put (")");
      end if;
   end Disp_Value_Vector;

   procedure Disp_Value_Array (Mem : Memtyp; A_Type: Node)
   is
      Stride : Size_Type;
      Len : Uns32;
   begin
      if Mem.Typ.Alast then
         --  Last dimension
         Disp_Value_Vector (Mem, A_Type, Mem.Typ.Abound);
      else
         Stride := Mem.Typ.Arr_El.Sz;
         Len := Mem.Typ.Abound.Len;

         Put ("(");
         for I in 1 ..  Len loop
            if I /= 1 then
               Put (", ");
            end if;
            Disp_Value_Array ((Mem.Typ.Arr_El,
                               Mem.Mem + Size_Type (Len - I) * Stride),
                              A_Type);
         end loop;
         Put (")");
      end if;
   end Disp_Value_Array;

   procedure Disp_Value_Record (M : Memtyp; Vtype: Node)
   is
      El_List : Iir_Flist;
      El : Node;
   begin
      Put ("(");
      El_List := Get_Elements_Declaration_List (Vtype);
      for I in M.Typ.Rec.E'Range loop
         El := Get_Nth_Element (El_List, Natural (I - 1));
         if I /= 1 then
            Put (", ");
         end if;
         Put (Image (Get_Identifier (El)));
         Put (": ");
         Disp_Memtyp ((M.Typ.Rec.E (I).Typ,
                       M.Mem + M.Typ.Rec.E (I).Offs.Mem_Off),
                      Get_Type (El));
      end loop;
      Put (")");
   end Disp_Value_Record;

   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.Abound);
         when Type_Array =>
            Disp_Value_Array (M, Vtype);
         when Type_Float =>
            Put_Fp64 (Read_Fp64 (M));
         when Type_Slice =>
            Put ("*slice*");
         when Type_File =>
            Put ("*file*");
         when Type_Record =>
            Disp_Value_Record (M, Vtype);
         when Type_Access =>
            declare
               Idx : constant Heap_Index := Read_Access (M);
            begin
               if Idx = Null_Heap_Index then
                  Put ("null");
               else
                  Put ("@");
                  Put_Uns32 (Uns32 (Idx));
               end if;
            end;
         when Type_Protected =>
            Put ("*protected*");
         when Type_Unbounded_Array
            | Type_Array_Unbounded
            | 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");
            Put (' ');
            Put_Uns32 (Uns32 (Vt.Val.S));
         when Value_File =>
            Put ("file");
         when Value_Quantity =>
            Put ("quantity");
         when Value_Terminal =>
            Put ("terminal");
         when Value_Const =>
            Put ("const: ");
            Disp_Memtyp (Get_Memtyp (Vt), Vtype);
         when Value_Alias =>
            Put ("alias");
            Disp_Memtyp (Get_Memtyp (Vt), Vtype);
         when Value_Dyn_Alias =>
            Put ("dyn alias");
         when Value_Sig_Val =>
            Put ("sig val");
         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 (' ');
      Put_Dir (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 (' ');
      Put_Dir (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);
   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.Abound);
            Put (')');
         when Type_Unbounded_Vector =>
            Put ("unbounded_vector");
         when Type_Array =>
            Put ("array");
         when Type_Array_Unbounded =>
            Put ("array_unbounded");
         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; Indent : Natural) 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_Indent (Indent);
               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
           | Iir_Kind_Attribute_Declaration
           | Iir_Kind_Attribute_Specification =>
            --  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
           | Iir_Kind_Component_Declaration =>
            null;
         when Iir_Kind_Suspend_State_Declaration =>
            declare
               Val : constant Valtyp := Get_Value (Instance, Decl);
            begin
               Put_Indent (Indent);
               Put ("STATE: ");
               Put_Int32 (Int32 (Read_I32 (Val.Val.Mem)));
               New_Line;
            end;
         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; Indent : Natural := 0)
   is
      El : Iir;
   begin
      El := Decl_Chain;
      while El /= Null_Iir loop
         Disp_Declaration_Object (Instance, El, Indent);
         El := Get_Chain (El);
      end loop;
   end Disp_Declaration_Objects;

   package Hierarchy_Pkg is
      type Config_Type is record
         With_Objs : Boolean;
         Recurse : Boolean;
         Indent : Natural;
      end record;

      procedure Disp_Hierarchy (Inst : Synth_Instance_Acc; Cfg : Config_Type);

      procedure Disp_Hierarchy_Statements
        (Inst : Synth_Instance_Acc; Stmts : Node; Cfg : Config_Type);
   end Hierarchy_Pkg;

   package body Hierarchy_Pkg is
      function Inc_Indent (Cfg : Config_Type) return Config_Type
      is
         Res : Config_Type;
      begin
         Res := Cfg;
         Res.Indent := Res.Indent + 1;
         return Res;
      end Inc_Indent;

      procedure Disp_Hierarchy_Statement
        (Inst : Synth_Instance_Acc; Stmt : Node; Cfg : Config_Type) is
      begin
         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 (Cfg.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;
                        end if;
                        if Cfg.With_Objs then
                           Disp_Declaration_Objects
                             (Sub, Get_Generic_Chain (Sub_Node),
                              Cfg.Indent);
                           Disp_Declaration_Objects
                             (Sub, Get_Port_Chain (Sub_Node),
                              Cfg.Indent);
                        end if;
                        if Cfg.Recurse and then Comp_Inst /= null then
                           Disp_Hierarchy (Comp_Inst, Inc_Indent (Cfg));
                        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;
                        if Cfg.Recurse then
                           Disp_Hierarchy (Sub, Inc_Indent (Cfg));
                        end if;
                     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 (Cfg.Indent);
                  Put (Image (Get_Label (Stmt)));
                  Put (": if-generate");
                  if Sub = null then
                     Put_Line (" [false]");
                  else
                     Put_Line (" [true]");
                     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;
               begin
                  Put_Indent (Cfg.Indent);
                  Put (Image (Get_Label (Stmt)));
                  Put (": for-generate");
                  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
                  Sub : constant Synth_Instance_Acc :=
                    Get_Sub_Instance (Inst, Stmt);
               begin
                  Put_Indent (Cfg.Indent);
                  Put (Image (Get_Label (Stmt)));
                  Put_Line (": block");
                  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
              | Iir_Kind_Concurrent_Procedure_Call_Statement
              | Iir_Kind_Simple_Simultaneous_Statement =>
               null;
            when Iir_Kind_Psl_Default_Clock
              | Iir_Kind_Psl_Assert_Directive
              | Iir_Kind_Psl_Endpoint_Declaration =>
               null;
            when Iir_Kinds_Process_Statement =>
               --  Note: processes are not elaborated.
               if Cfg.With_Objs then
                  Put_Indent (Cfg.Indent);
                  Put (Image (Get_Label (Stmt)));
                  Put_Line (": process");
               end if;
            when others =>
               Vhdl.Errors.Error_Kind ("disp_hierarchy_statement", Stmt);
         end case;
      end Disp_Hierarchy_Statement;

      procedure Disp_Hierarchy_Statements
        (Inst : Synth_Instance_Acc; Stmts : Node; Cfg : Config_Type)
      is
         Stmt : Node;
      begin
         Stmt := Stmts;
         while Stmt /= Null_Node loop
            Disp_Hierarchy_Statement (Inst, Stmt, Cfg);
            Stmt := Get_Chain (Stmt);
         end loop;
      end Disp_Hierarchy_Statements;

      procedure Disp_Hierarchy
        (Inst : Synth_Instance_Acc; Cfg : Config_Type)
      is
         N : constant Node := Get_Source_Scope (Inst);
      begin
         case Get_Kind (N) is
            when Iir_Kind_Architecture_Body =>
               declare
                  Ent : constant Node := Get_Entity (N);
               begin
                  Put_Indent (Cfg.Indent);
                  Put ("architecture ");
                  Put (Image (Get_Identifier (N)));
                  Put (" of ");
                  Put (Image (Get_Identifier (Ent)));
                  New_Line;
                  if Cfg.With_Objs then
                     Put_Indent (Cfg.Indent);
                     Put_Line ("[entity]");
                     Disp_Declaration_Objects
                       (Inst, Get_Generic_Chain (Ent), Cfg.Indent);
                     Disp_Declaration_Objects
                       (Inst, Get_Port_Chain (Ent), Cfg.Indent);
                     Put_Indent (Cfg.Indent);
                     Put_Line ("[architecture]");
                     Disp_Declaration_Objects
                       (Inst, Get_Declaration_Chain (Ent), Cfg.Indent);
                     Disp_Declaration_Objects
                       (Inst, Get_Declaration_Chain (N), Cfg.Indent);
                  end if;
                  Disp_Hierarchy_Statements
                    (Inst, Get_Concurrent_Statement_Chain (N),
                     Inc_Indent (Cfg));
               end;
            when Iir_Kind_Component_Declaration =>
               Put_Indent (Cfg.Indent);
               Put ("component ");
               Put (Image (Get_Identifier (N)));
               New_Line;
               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 =>
               Vhdl.Errors.Error_Kind ("disp_hierarchy", N);
         end case;
      end Disp_Hierarchy;
   end Hierarchy_Pkg;

   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;

   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;

   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;
      Index32 : Uns32;
      Index : Int64;
      Valid : Boolean;
      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).
         Elab.Debugger.To_Num
           (Name (End_Id + 2 .. Name'Last - 1), Index32, Valid);
         Index := Int64 (Index32);
         if not Valid then
            return null;
         end if;
      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_For_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 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;
                                  Components : Boolean)
                                 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 =>
            if Components then
               return Inst;
            else
               return Parent;
            end if;
         when Iir_Kind_For_Generate_Statement =>
            --  Skip the instance used as array.
            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, False);
   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 (Inst : Synth_Instance_Acc;
                                 Components : Boolean := False)
   is
      Pre_Parent_Inst : constant Synth_Instance_Acc :=
        Skip_Instance_Parent (Inst, Components);
      Parent_Inst : Synth_Instance_Acc;
      Parent_Scope : Node;
      Scope : Node;
      Stmt : Node;
   begin
      if Pre_Parent_Inst = null then
         --  The top unit
         Put ('/');
         Parent_Scope := Get_Source_Scope (Inst);
         if Get_Kind (Parent_Scope) = Iir_Kind_Package_Declaration then
            Scope := Parent_Scope;
         else
            Scope := Get_Entity (Parent_Scope);
         end if;
         Put (Image (Get_Identifier (Scope)));
         return;
      end if;

      Parent_Inst := Get_Instance_Parent (Pre_Parent_Inst);
      Parent_Scope := Get_Source_Scope (Parent_Inst);
      Disp_Instance_Path (Parent_Inst, Components);
      Put ('/');

      Scope := Get_Source_Scope (Inst);
      if Get_Kind (Scope) in Iir_Kinds_Process_Statement then
         --  The name to display is the name of the process.
         Stmt := Scope;
      elsif Get_Kind (Parent_Scope) = Iir_Kind_Component_Declaration then
         --  Display the name of then entity.
         Stmt := Get_Entity (Scope);
      else
         --  The scope is an architecture or a generate.
         --  Find the corresponding statements in the parent to get the label.
         Stmt := Find_Concurrent_Statement_By_Instance
           (Parent_Inst, Get_Concurrent_Statement_Chain (Parent_Scope),
            Pre_Parent_Inst);
      end if;
      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;

   type Handle_Scope_Type is access procedure (N : Iir);

   procedure Foreach_Scopes (N : Iir; Handler : Handle_Scope_Type) is
   begin
      case Get_Kind (N) is
         when Iir_Kind_Process_Statement
           | Iir_Kind_Sensitized_Process_Statement
           | Iir_Kind_Protected_Type_Body =>
            Foreach_Scopes (Get_Parent (N), Handler);
            Handler.all (N);
         when Iir_Kind_Architecture_Body =>
            Foreach_Scopes (Get_Entity (N), Handler);
            Handler.all (N);

         when Iir_Kind_Entity_Declaration =>
            --  Top of scopes.
            Handler.all (N);

         when Iir_Kind_Function_Body
           | Iir_Kind_Procedure_Body =>
            Foreach_Scopes (Get_Parent (N), Handler);
            Handler.all (N);
         when Iir_Kind_Package_Body =>
            Handler.all (N);

         when Iir_Kind_Variable_Assignment_Statement
           | Iir_Kind_Simple_Signal_Assignment_Statement
           | Iir_Kind_Null_Statement
           | Iir_Kind_Assertion_Statement
           | Iir_Kind_Report_Statement
           | Iir_Kind_Wait_Statement
           | Iir_Kind_Return_Statement
           | Iir_Kind_Next_Statement
           | Iir_Kind_Exit_Statement
           | Iir_Kind_Procedure_Call_Statement
           | Iir_Kind_If_Statement
           | Iir_Kind_While_Loop_Statement
           | Iir_Kind_Case_Statement =>
            Foreach_Scopes (Get_Parent (N), Handler);

         when Iir_Kind_For_Loop_Statement
           | Iir_Kind_Block_Statement
           | Iir_Kind_If_Generate_Statement
           | Iir_Kind_For_Generate_Statement
           | Iir_Kind_Generate_Statement_Body =>
            Foreach_Scopes (Get_Parent (N), Handler);
            Handler.all (N);

         when others =>
            Vhdl.Errors.Error_Kind ("foreach_scopes", N);
      end case;
   end Foreach_Scopes;

   procedure Add_Decls_For_Design_Unit (Unit : Iir)
   is
      use Vhdl.Sem_Scopes;
      File : constant Node := Get_Design_File (Unit);
   begin
      --  The std library.
      Add_Name (Libraries.Std_Library);
      --  The work library.
      Add_Name (Get_Library (File), Std_Names.Name_Work, False);
      --  Unit context clauses.
      Add_Context_Clauses (Unit);
   end Add_Decls_For_Design_Unit;

   procedure Add_Decls_For (N : Iir)
   is
      use Vhdl.Sem_Scopes;
   begin
      case Get_Kind (N) is
         when Iir_Kind_Entity_Declaration =>
            declare
               Unit : constant Iir := Get_Design_Unit (N);
            begin
               Add_Decls_For_Design_Unit (Unit);
               --  Add_Name (Unit, Get_Identifier (N), False);
               Add_Entity_Declarations (N);
            end;
         when Iir_Kind_Architecture_Body =>
            Open_Declarative_Region;
            Add_Decls_For_Design_Unit (Get_Design_Unit (N));
            Add_Declarations (Get_Declaration_Chain (N), False);
            Add_Declarations_Of_Concurrent_Statement (N);
         when Iir_Kind_Package_Body =>
            declare
               Package_Decl : constant Iir := Get_Package (N);
               Package_Unit : constant Iir := Get_Design_Unit (Package_Decl);
            begin
               if Get_Kind (Package_Unit) = Iir_Kind_Design_Unit then
                  --  Only for top-level packages.
                  Add_Decls_For_Design_Unit (Package_Unit);
               end if;
               Add_Name (Package_Unit);
               Open_Declarative_Region;
               Add_Declarations (Get_Declaration_Chain (Package_Decl), False);
               Add_Declarations (Get_Declaration_Chain (N), False);
            end;
         when Iir_Kind_Procedure_Body
           | Iir_Kind_Function_Body =>
            declare
               Spec : constant Iir := Get_Subprogram_Specification (N);
            begin
               Open_Declarative_Region;
               Add_Declarations
                 (Get_Interface_Declaration_Chain (Spec), False);
               Add_Declarations
                 (Get_Declaration_Chain (N), False);
            end;
         when Iir_Kind_Process_Statement
           | Iir_Kind_Sensitized_Process_Statement
           | Iir_Kind_Protected_Type_Body =>
            Open_Declarative_Region;
            Add_Declarations (Get_Declaration_Chain (N), False);
         when Iir_Kind_For_Loop_Statement
           | Iir_Kind_For_Generate_Statement =>
            Open_Declarative_Region;
            Add_Name (Get_Parameter_Specification (N));
         when Iir_Kind_If_Generate_Statement =>
            Open_Declarative_Region;
         when Iir_Kind_Block_Statement =>
            declare
               Header : constant Iir := Get_Block_Header (N);
            begin
               Open_Declarative_Region;
               if Header /= Null_Iir then
                  Add_Declarations (Get_Generic_Chain (Header), False);
                  Add_Declarations (Get_Port_Chain (Header), False);
               end if;
               Add_Declarations (Get_Declaration_Chain (N), False);
               Add_Declarations_Of_Concurrent_Statement (N);
            end;
         when Iir_Kind_Generate_Statement_Body =>
            Open_Declarative_Region;
            Add_Declarations (Get_Declaration_Chain (N), False);
            Add_Declarations_Of_Concurrent_Statement (N);
         when others =>
            Vhdl.Errors.Error_Kind ("add_decls_for", N);
      end case;
   end Add_Decls_For;

   procedure Enter_Scope (Node : Iir)
   is
      use Vhdl.Sem_Scopes;
   begin
      Push_Interpretations;
      Open_Declarative_Region;

      --  Add STD
      Add_Name (Libraries.Std_Library, Std_Names.Name_Std, False);
      Use_All_Names (Vhdl.Std_Package.Standard_Package);

      Foreach_Scopes (Node, Add_Decls_For'Access);
   end Enter_Scope;

   procedure Del_Decls_For (N : Iir)
   is
      use Vhdl.Sem_Scopes;
   begin
      case Get_Kind (N) is
         when Iir_Kind_Entity_Declaration =>
            null;
         when Iir_Kind_Architecture_Body =>
            Close_Declarative_Region;
         when Iir_Kind_Process_Statement
           | Iir_Kind_Sensitized_Process_Statement
           | Iir_Kind_Package_Body
           | Iir_Kind_Procedure_Body
           | Iir_Kind_Function_Body
           | Iir_Kind_For_Loop_Statement
           | Iir_Kind_Block_Statement
           | Iir_Kind_If_Generate_Statement
           | Iir_Kind_For_Generate_Statement
           | Iir_Kind_Generate_Statement_Body
           | Iir_Kind_Protected_Type_Body =>
            Close_Declarative_Region;
         when others =>
            Vhdl.Errors.Error_Kind ("Del_Decls_For", N);
      end case;
   end Del_Decls_For;

   procedure Leave_Scope (Node : Iir)
   is
      use Vhdl.Sem_Scopes;
   begin
      Foreach_Scopes (Node, Del_Decls_For'Access);

      Close_Declarative_Region;
      Pop_Interpretations;
   end Leave_Scope;

   Buffer_Index : Natural := 1;

   procedure Print_Proc (Line : String)
   is
      use Vhdl.Tokens;
      use Errorout;
      Cur_Inst : constant Synth_Instance_Acc := Debug_Current_Instance;
      Prev_Nbr_Errors : constant Natural := Nbr_Errors;
      Index_Str : String := Natural'Image (Buffer_Index);
      File : Source_File_Entry;
      Expr : Iir;
      Res : Valtyp;
      P : Natural;
      Opt_Name : Boolean := False;
      Opt_Type : Boolean := False;
      Marker : Mark_Type;
      Cur_Scope : Node;
   begin
      --  Decode options: /v
      P := Line'First;
      loop
         P := Skip_Blanks (Line (P .. Line'Last));
         if P + 2 < Line'Last and then Line (P .. P + 1) = "/t" then
            Opt_Type := True;
            P := P + 2;
         elsif P + 2 < Line'Last and then Line (P .. P + 1) = "/n" then
            Opt_Name := True;
            P := P + 2;
         else
            exit;
         end if;
      end loop;

      Buffer_Index := Buffer_Index + 1;
      Index_Str (Index_Str'First) := '*';
      File := Files_Map.Create_Source_File_From_String
        (Name_Table.Get_Identifier ("*debug" & Index_Str & '*'),
         Line (P .. Line'Last));
      Vhdl.Scanner.Set_File (File);
      Vhdl.Scanner.Scan;
      Expr := Vhdl.Parse.Parse_Expression;
      if Vhdl.Scanner.Current_Token /= Tok_Eof then
         Put_Line ("garbage at end of expression ignored");
      end if;
      Vhdl.Scanner.Close_File;
      if Nbr_Errors /= Prev_Nbr_Errors then
         Put_Line ("error while parsing expression, evaluation aborted");
         Nbr_Errors := Prev_Nbr_Errors;
         return;
      end if;

      Cur_Scope := Elab.Vhdl_Context.Get_Source_Scope (Cur_Inst);
      Enter_Scope (Cur_Scope);
      Expr := Vhdl.Sem_Expr.Sem_Expression_Universal (Expr);
      Leave_Scope (Cur_Scope);

      if Expr = Null_Iir
        or else Nbr_Errors /= Prev_Nbr_Errors
      then
         Put_Line ("error while analyzing expression, evaluation aborted");
         Nbr_Errors := Prev_Nbr_Errors;
         return;
      end if;

      Vhdl.Prints.Disp_Expression (Expr);
      New_Line;

      Elab.Vhdl_Annotations.Annotate_Expand_Table;
      Vhdl.Canon.Canon_Expression (Expr);

      Mark_Expr_Pool (Marker);

      if Opt_Name then
         case Get_Kind (Expr) is
            when Iir_Kind_Simple_Name =>
               null;
            when others =>
               Put_Line ("expression is not a name");
               Opt_Name := False;
         end case;
      end if;
      if Opt_Name then
         --  Res := Execute_Name (Dbg_Cur_Frame, Expr, True);
         raise Internal_Error;
      else
         --  TODO: check EXPR is an expression.
         --  TODO: protected object.
         Res := Synth.Vhdl_Expr.Synth_Expression (Cur_Inst, Expr);
      end if;
      if Res /= No_Valtyp then
         if Res.Val.Kind = Value_Memory then
            Disp_Memtyp (Get_Memtyp (Res), Get_Type (Expr));
         else
            Elab.Vhdl_Values.Debug.Debug_Valtyp (Res);
         end if;
         New_Line;
         if Opt_Type then
            Debug_Typ (Res.Typ);
         end if;
      end if;

      --  Free value
      Release_Expr_Pool (Marker);
   end Print_Proc;

   procedure Print_Heap_Proc (Line : String)
   is
      F : Natural;
      Idx : Uns32;
      Valid : Boolean;
      Mt : Memtyp;
   begin
      F := Skip_Blanks (Line, Line'First);
      To_Num (Line (F .. Line'Last), Idx, Valid);
      if not Valid then
         Put_Line ("invalid heap index");
         return;
      end if;
      Mt := Elab.Vhdl_Heap.Synth_Dereference (Heap_Index (Idx));
      Debug_Memtyp (Mt);
   end Print_Heap_Proc;

   procedure Append_Commands is
   begin
      Append_Menu_Command
        (Name => new String'("p*rint"),
         Help => new String'("execute expression"),
         Proc => Print_Proc'Access);
      Append_Menu_Command
        (Name => new String'("ph*eap"),
         Help => new String'("print heap index"),
         Proc => Print_Heap_Proc'Access);
   end Append_Commands;

end Elab.Vhdl_Debug;