aboutsummaryrefslogtreecommitdiffstats
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/synth/elab-debugger.adb7
-rw-r--r--src/synth/elab-debugger.ads2
-rw-r--r--src/synth/elab-vhdl_debug.adb297
-rw-r--r--src/synth/elab-vhdl_debug.ads2
4 files changed, 306 insertions, 2 deletions
diff --git a/src/synth/elab-debugger.adb b/src/synth/elab-debugger.adb
index 9d888cc95..dad63f6b0 100644
--- a/src/synth/elab-debugger.adb
+++ b/src/synth/elab-debugger.adb
@@ -44,6 +44,11 @@ package body Elab.Debugger is
Reason_Error
);
+ function Debug_Current_Instance return Synth_Instance_Acc is
+ begin
+ return Current_Instance;
+ end Debug_Current_Instance;
+
package Breakpoints is new Tables
(Table_Index_Type => Natural,
Table_Component_Type => Node,
@@ -657,7 +662,7 @@ package body Elab.Debugger is
(Kind => Menu_Command,
Name => new String'("?"),
Help => new String'("print help"),
- Next => Menu_Break'Access, -- Menu_Help1'Access,
+ Next => Menu_Break'Access,
Proc => Help_Proc'Access);
Menu_Top : aliased Menu_Entry :=
diff --git a/src/synth/elab-debugger.ads b/src/synth/elab-debugger.ads
index 02b37c2d0..cc456dfc1 100644
--- a/src/synth/elab-debugger.ads
+++ b/src/synth/elab-debugger.ads
@@ -47,6 +47,8 @@ package Elab.Debugger is
-- * index out of bounds.
procedure Debug_Error (Inst : Synth_Instance_Acc; Expr : Node);
+ function Debug_Current_Instance return Synth_Instance_Acc;
+
type Menu_Procedure is access procedure (Line : String);
type Cst_String_Acc is access constant String;
diff --git a/src/synth/elab-vhdl_debug.adb b/src/synth/elab-vhdl_debug.adb
index f15b63156..68ba51bf5 100644
--- a/src/synth/elab-vhdl_debug.adb
+++ b/src/synth/elab-vhdl_debug.adb
@@ -18,15 +18,30 @@
with Name_Table; use Name_Table;
with Simple_IO; use Simple_IO;
with Utils_IO; use Utils_IO;
+with Files_Map;
+with Areapools;
with Libraries;
+with Std_Names;
+with Errorout;
-with Elab.Debugger;
+with Elab.Debugger; use Elab.Debugger;
with Elab.Memtype; use Elab.Memtype;
with Elab.Vhdl_Values; use Elab.Vhdl_Values;
with Elab.Vhdl_Values.Debug; use Elab.Vhdl_Values.Debug;
+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.Annotations;
+with Vhdl.Std_Package;
+with Vhdl.Prints;
package body Elab.Vhdl_Debug is
procedure Disp_Discrete_Value (Val : Int64; Btype : Node) is
@@ -1032,4 +1047,284 @@ package body Elab.Vhdl_Debug is
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 =>
+ 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 (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_Context_Clauses (Unit);
+ -- Add_Name (Unit, Get_Identifier (N), False);
+ Add_Entity_Declarations (N);
+ end;
+ when Iir_Kind_Architecture_Body =>
+ Open_Declarative_Region;
+ Add_Context_Clauses (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
+ Add_Name (Package_Unit);
+ Add_Context_Clauses (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 =>
+ 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_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 ("enter_scope(2)", 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 =>
+ Close_Declarative_Region;
+ when others =>
+ Vhdl.Errors.Error_Kind ("Decl_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 Areapools;
+ 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_Value : Boolean := False;
+ Opt_Name : 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) = "/v" then
+ Opt_Value := 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;
+
+ pragma Unreferenced (Opt_Value);
+
+ 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;
+
+ Vhdl.Annotations.Annotate_Expand_Table;
+ Vhdl.Canon.Canon_Expression (Expr);
+
+ Mark (Marker, Expr_Pool);
+
+ 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
+ Res := Synth.Vhdl_Expr.Synth_Expression (Cur_Inst, Expr);
+ end if;
+ 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;
+
+ -- Free value
+ Release (Marker, Expr_Pool);
+ end Print_Proc;
+
+ procedure Append_Commands is
+ begin
+ Append_Menu_Command
+ (Name => new String'("p*rint"),
+ Help => new String'("execute expression"),
+ Proc => Print_Proc'Access);
+ end Append_Commands;
+
end Elab.Vhdl_Debug;
diff --git a/src/synth/elab-vhdl_debug.ads b/src/synth/elab-vhdl_debug.ads
index bef5d9258..0690c9c2e 100644
--- a/src/synth/elab-vhdl_debug.ads
+++ b/src/synth/elab-vhdl_debug.ads
@@ -47,4 +47,6 @@ package Elab.Vhdl_Debug is
-- If COMPONENTS is true, also display components
procedure Disp_Instance_Path (Inst : Synth_Instance_Acc;
Components : Boolean := False);
+
+ procedure Append_Commands;
end Elab.Vhdl_Debug;
generated by cgit v1.2.3 (git 2.25.1) at 2025-04-05 21:27:31 +0000