diff options
Diffstat (limited to 'src/synth/elab-vhdl_debug.adb')
| -rw-r--r-- | src/synth/elab-vhdl_debug.adb | 357 |
1 files changed, 342 insertions, 15 deletions
diff --git a/src/synth/elab-vhdl_debug.adb b/src/synth/elab-vhdl_debug.adb index 79153d4cd..68ba51bf5 100644 --- a/src/synth/elab-vhdl_debug.adb +++ b/src/synth/elab-vhdl_debug.adb @@ -15,19 +15,33 @@ -- -- You should have received a copy of the GNU General Public License -- along with this program. If not, see <gnu.org/licenses>. -with Types; use Types; with Name_Table; use Name_Table; with Simple_IO; use Simple_IO; with Utils_IO; use Utils_IO; +with 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 @@ -116,30 +130,52 @@ package body Elab.Vhdl_Debug is end if; end Disp_Value_Vector; - procedure Disp_Value_Array (Mem : Memtyp; A_Type: Node; Dim: Dim_Type) + procedure Disp_Value_Array (Mem : Memtyp; A_Type: Node) is Stride : Size_Type; + Len : Uns32; begin - if Dim = Mem.Typ.Abounds.Ndim then + if Mem.Typ.Alast then -- Last dimension - Disp_Value_Vector (Mem, A_Type, Mem.Typ.Abounds.D (Dim)); + Disp_Value_Vector (Mem, A_Type, Mem.Typ.Abound); else Stride := Mem.Typ.Arr_El.Sz; - for I in Dim + 1 .. Mem.Typ.Abounds.Ndim loop - Stride := Stride * Size_Type (Mem.Typ.Abounds.D (I).Len); - end loop; + Len := Mem.Typ.Abound.Len; Put ("("); - for I in 1 .. Mem.Typ.Abounds.D (Dim).Len loop + for I in 1 .. Len loop if I /= 1 then Put (", "); end if; - Disp_Value_Array ((Mem.Typ, Mem.Mem + Stride), A_Type, Dim + 1); + Disp_Value_Array ((Mem.Typ, + 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 @@ -153,9 +189,9 @@ package body Elab.Vhdl_Debug is | Type_Logic => Disp_Discrete_Value (Read_Discrete (M), Get_Base_Type (Vtype)); when Type_Vector => - Disp_Value_Vector (M, Vtype, M.Typ.Vbound); + Disp_Value_Vector (M, Vtype, M.Typ.Abound); when Type_Array => - Disp_Value_Array (M, Vtype, 1); + Disp_Value_Array (M, Vtype); when Type_Float => Put ("*float*"); when Type_Slice => @@ -163,7 +199,7 @@ package body Elab.Vhdl_Debug is when Type_File => Put ("*file*"); when Type_Record => - Put ("*record*"); + Disp_Value_Record (M, Vtype); when Type_Access => Put ("*access*"); when Type_Protected => @@ -190,7 +226,7 @@ package body Elab.Vhdl_Debug is when Value_Signal => Put ("signal"); Put (' '); - Put_Uns32 (Vt.Val.S); + Put_Uns32 (Uns32 (Vt.Val.S)); when Value_File => Put ("file"); when Value_Const => @@ -199,6 +235,8 @@ package body Elab.Vhdl_Debug is when Value_Alias => Put ("alias"); Disp_Memtyp (Get_Memtyp (Vt), Vtype); + when Value_Dyn_Alias => + Put ("dyn alias"); when Value_Memory => Disp_Memtyp (Get_Memtyp (Vt), Vtype); end case; @@ -237,7 +275,7 @@ package body Elab.Vhdl_Debug is Put ("float"); when Type_Vector => Put ("vector ("); - Disp_Bound_Type (Typ.Vbound); + Disp_Bound_Type (Typ.Abound); Put (')'); when Type_Unbounded_Vector => Put ("unbounded_vector"); @@ -301,6 +339,15 @@ package body Elab.Vhdl_Debug is | 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; @@ -1000,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; |