diff options
author | Tristan Gingold <tgingold@free.fr> | 2020-04-06 17:34:20 +0200 |
---|---|---|
committer | Tristan Gingold <tgingold@free.fr> | 2020-04-06 20:10:56 +0200 |
commit | d9a1ffd4ab537f62a8b42b17cf1d4fac536b4f3c (patch) | |
tree | a0a09f21c68551fa6907dcb113ca17bb87802ad0 /src/synth | |
parent | 9d73f95619bc4ad6f8c27e3b2048ec69f8f4a767 (diff) | |
download | ghdl-d9a1ffd4ab537f62a8b42b17cf1d4fac536b4f3c.tar.gz ghdl-d9a1ffd4ab537f62a8b42b17cf1d4fac536b4f3c.tar.bz2 ghdl-d9a1ffd4ab537f62a8b42b17cf1d4fac536b4f3c.zip |
synth-debugger: update, handle frame leave.
Diffstat (limited to 'src/synth')
-rw-r--r-- | src/synth/synth-debugger.adb | 7 | ||||
-rw-r--r-- | src/synth/synth-debugger.ads | 8 | ||||
-rw-r--r-- | src/synth/synth-debugger__on.adb | 139 | ||||
-rw-r--r-- | src/synth/synth-insts.adb | 2 | ||||
-rw-r--r-- | src/synth/synth-stmts.adb | 4 |
5 files changed, 110 insertions, 50 deletions
diff --git a/src/synth/synth-debugger.adb b/src/synth/synth-debugger.adb index e5746ba75..d3b27d367 100644 --- a/src/synth/synth-debugger.adb +++ b/src/synth/synth-debugger.adb @@ -21,7 +21,7 @@ with Types; use Types; package body Synth.Debugger is - procedure Debug_Init is + procedure Debug_Init (Top : Node) is begin null; end Debug_Init; @@ -31,6 +31,11 @@ package body Synth.Debugger is raise Internal_Error; end Debug_Break; + procedure Debug_Leave (Inst : Synth_Instance_Acc) is + begin + raise Internal_Error; + end Debug_Leave; + procedure Debug_Error (Inst : Synth_Instance_Acc; Expr : Node) is begin null; diff --git a/src/synth/synth-debugger.ads b/src/synth/synth-debugger.ads index 13313c617..9784def6c 100644 --- a/src/synth/synth-debugger.ads +++ b/src/synth/synth-debugger.ads @@ -23,12 +23,16 @@ with Vhdl.Nodes; use Vhdl.Nodes; with Synth.Context; use Synth.Context; package Synth.Debugger is - -- If true, call Debug() before executing the next sequential statement. + -- If true, debugging is enabled: + -- * call Debug_Break() before executing the next sequential statement + -- * call Debug_Leave when a frame is destroyed. Flag_Need_Debug : Boolean := False; - procedure Debug_Init; + procedure Debug_Init (Top : Node); procedure Debug_Break (Inst : Synth_Instance_Acc; Stmt : Node); + procedure Debug_Leave (Inst : Synth_Instance_Acc); + -- To be called in case of execution error, like: -- * index out of bounds. procedure Debug_Error (Inst : Synth_Instance_Acc; Expr : Node); diff --git a/src/synth/synth-debugger__on.adb b/src/synth/synth-debugger__on.adb index aace41baf..9bf7205b5 100644 --- a/src/synth/synth-debugger__on.adb +++ b/src/synth/synth-debugger__on.adb @@ -283,7 +283,7 @@ package body Synth.Debugger is return P - 1; end Get_Word; - procedure Disp_Value (Val : Value_Acc; Vtype : Node); + procedure Disp_Memtyp (M : Memtyp; Vtype : Node); procedure Disp_Discrete_Value (Val : Int64; Btype : Node) is begin @@ -305,12 +305,10 @@ package body Synth.Debugger is end case; end Disp_Discrete_Value; - procedure Disp_Value_Vector (Value: Value_Acc; - A_Type: Node; - Bound : Bound_Type; - Off : in out Iir_Index32) + 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; @@ -322,8 +320,9 @@ package body Synth.Debugger is Last_Enum := None; Enum_List := Get_Enumeration_Literal_List (El_Type); for I in 1 .. Bound.Len loop - El_Pos := Natural (Value.Arr.V (Off).Scal); - Off := Off + 1; + El_Pos := Natural + (Read_Discrete (Mem.Mem + Size_Type (I - 1) * El_Typ.Sz, + El_Typ)); El_Id := Get_Identifier (Get_Nth_Element (Enum_List, El_Pos)); if Name_Table.Is_Character (El_Id) then case Last_Enum is @@ -363,62 +362,86 @@ package body Synth.Debugger is if I /= 1 then Put (", "); end if; - Disp_Value (Value.Arr.V (Off), El_Type); - Off := Off + 1; + Disp_Memtyp ((El_Typ, Mem.Mem + Size_Type (I - 1) * Mem.Typ.Sz), + El_Type); end loop; Put (")"); end if; end Disp_Value_Vector; - procedure Disp_Value_Array (Value: Value_Acc; - A_Type: Node; - Dim: Iir_Index32; - Off : in out Iir_Index32) is + procedure Disp_Value_Array (Mem : Memtyp; A_Type: Node; Dim: Dim_Type) + is + Stride : Size_Type; begin - if Dim = Value.Typ.Abounds.Len then + if Dim = Mem.Typ.Abounds.Ndim then -- Last dimension - Disp_Value_Vector (Value, A_Type, Value.Typ.Abounds.D (Dim), Off); + Disp_Value_Vector (Mem, A_Type, Mem.Typ.Abounds.D (Dim)); 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; + Put ("("); - for I in 1 .. Value.Typ.Abounds.D (Dim).Len loop + for I in 1 .. Mem.Typ.Abounds.D (Dim).Len loop if I /= 1 then Put (", "); end if; - Disp_Value_Array (Value, A_Type, Dim + 1, Off); + Disp_Value_Array ((Mem.Typ, Mem.Mem + Stride), A_Type, Dim + 1); end loop; Put (")"); end if; end Disp_Value_Array; - procedure Disp_Value (Val : Value_Acc; Vtype : Node) is + 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.Mem, M.Typ), + Get_Base_Type (Vtype)); + when Type_Vector => + Disp_Value_Vector (M, Vtype, M.Typ.Vbound); + when Type_Array => + Disp_Value_Array (M, Vtype, 1); + when Type_Float => + Put ("*float*"); + when Type_Slice => + Put ("*slice*"); + when Type_File => + Put ("*file*"); + when Type_Record => + Put ("*record*"); + when Type_Access => + Put ("*access*"); + when Type_Unbounded_Array + | Type_Unbounded_Vector => + Put ("*unbounded*"); + end case; + end Disp_Memtyp; + + procedure Disp_Value (Vt : Valtyp; Vtype : Node) is begin - if Val = null then + if Vt.Val = null then Put ("*NULL*"); return; end if; - case Val.Kind is + case Vt.Val.Kind is when Value_Net => Put ("net"); when Value_Wire => Put ("wire"); - when Value_Discrete => - Disp_Discrete_Value (Val.Scal, Get_Base_Type (Vtype)); - when Value_Float => - Put ("float"); when Value_Array => Put ("array"); when Value_Const_Array => - declare - Off : Iir_Index32; - begin - Off := 1; - if Val.Typ.Kind = Type_Vector then - Disp_Value_Vector (Val, Vtype, Val.Typ.Vbound, Off); - else - Disp_Value_Array (Val, Vtype, 1, Off); - end if; - end; + Put ("const_array"); when Value_Record => Put ("record"); when Value_Const_Record => @@ -427,15 +450,14 @@ package body Synth.Debugger is Put ("access"); when Value_File => Put ("file"); - when Value_Instance => - Put ("instance"); when Value_Const => Put ("const: "); - Disp_Value (Val.C_Val, Vtype); + Disp_Memtyp (Get_Memtyp (Vt), Vtype); when Value_Alias => Put ("alias"); - when Value_Subtype => - Put ("subtype"); + Disp_Memtyp (Get_Memtyp (Vt), Vtype); + when Value_Memory => + Disp_Memtyp (Get_Memtyp (Vt), Vtype); end case; end Disp_Value; @@ -498,9 +520,10 @@ package body Synth.Debugger is | Iir_Kind_Interface_File_Declaration | Iir_Kind_Object_Alias_Declaration | Iir_Kind_Interface_Signal_Declaration - | Iir_Kind_Signal_Declaration => + | Iir_Kind_Signal_Declaration + | Iir_Kind_File_Declaration => declare - Val : constant Value_Acc := Get_Value (Instance, Decl); + Val : constant Valtyp := Get_Value (Instance, Decl); Dtype : constant Node := Get_Type (Decl); begin Put (Vhdl.Errors.Disp_Node (Decl)); @@ -518,6 +541,11 @@ package body Synth.Debugger is | 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 => + null; when others => Vhdl.Errors.Error_Kind ("disp_declaration_object", Decl); end case; @@ -1135,9 +1163,9 @@ package body Synth.Debugger is null; end case; --- if Dbg_Cur_Frame /= null then - Set_List_Current (Get_Location (Current_Loc)); --- end if; + if Current_Loc /= Null_Node then + Set_List_Current (Get_Location (Current_Loc)); + end if; Command_Status := Status_Default; @@ -1204,10 +1232,10 @@ package body Synth.Debugger is -- Put ("resuming"); end Debug; - procedure Debug_Init is + procedure Debug_Init (Top : Node) is begin Current_Instance := null; - Current_Loc := Null_Node; + Current_Loc := Top; -- To avoid warnings. Exec_Statement := Null_Node; @@ -1224,6 +1252,25 @@ package body Synth.Debugger is Debug (Reason_Break); end Debug_Break; + procedure Debug_Leave (Inst : Synth_Instance_Acc) is + begin + if Exec_Instance = Inst then + -- Will be destroyed. + Exec_Instance := null; + + case Exec_State is + when Exec_Run => + null; + when Exec_Single_Step => + null; + when Exec_Next + | Exec_Next_Stmt => + -- Leave the frame, will stop just after. + Exec_State := Exec_Single_Step; + end case; + end if; + end Debug_Leave; + procedure Debug_Error (Inst : Synth_Instance_Acc; Expr : Node) is begin if Flags.Flag_Debug_Enable then diff --git a/src/synth/synth-insts.adb b/src/synth/synth-insts.adb index 85693b11f..cd0e664e7 100644 --- a/src/synth/synth-insts.adb +++ b/src/synth/synth-insts.adb @@ -1252,7 +1252,7 @@ package body Synth.Insts is Insts_Interning.Init; if Flags.Flag_Debug_Init then - Synth.Debugger.Debug_Init; + Synth.Debugger.Debug_Init (Arch); end if; -- Dependencies first. diff --git a/src/synth/synth-stmts.adb b/src/synth/synth-stmts.adb index 952b19289..aa1a737ac 100644 --- a/src/synth/synth-stmts.adb +++ b/src/synth/synth-stmts.adb @@ -1842,6 +1842,10 @@ package body Synth.Stmts is Set_Error (Syn_Inst); end if; + if Debugger.Flag_Need_Debug then + Debugger.Debug_Leave (Sub_Inst); + end if; + Free_Instance (Sub_Inst); Areapools.Release (Area_Mark, Instance_Pool.all); |