diff options
| -rw-r--r-- | src/simul/simul-vhdl_debug.adb | 53 | ||||
| -rw-r--r-- | src/synth/elab-debugger.adb | 4 | ||||
| -rw-r--r-- | src/synth/elab-vhdl_debug.adb | 50 | ||||
| -rw-r--r-- | src/synth/elab-vhdl_debug.ads | 5 |
4 files changed, 74 insertions, 38 deletions
diff --git a/src/simul/simul-vhdl_debug.adb b/src/simul/simul-vhdl_debug.adb index c54bea94f..8edf963d8 100644 --- a/src/simul/simul-vhdl_debug.adb +++ b/src/simul/simul-vhdl_debug.adb @@ -138,43 +138,45 @@ package body Simul.Vhdl_Debug is New_Line; end Disp_Conn_Entry; - function Read_Value (Value_Ptr : Ghdl_Value_Ptr; Mode : Mode_Type) - return Int64 is + procedure Disp_Value (Value_Ptr : Ghdl_Value_Ptr; + Mode : Mode_Type; + Btype : Node) is begin case Mode is when Mode_B1 => - return Ghdl_B1'Pos (Value_Ptr.B1); + Disp_Enumeration_Value (Ghdl_B1'Pos (Value_Ptr.B1), Btype); when Mode_E8 => - return Int64 (Value_Ptr.E8); + Disp_Enumeration_Value (Int64 (Value_Ptr.E8), Btype); when Mode_E32 => - return Int64 (Value_Ptr.E32); + Disp_Enumeration_Value (Int64 (Value_Ptr.E32), Btype); when Mode_I32 => - return Int64 (Value_Ptr.I32); + Disp_Integer_Value (Int64 (Value_Ptr.I32), Btype); when Mode_I64 => - return Int64 (Value_Ptr.I64); + Disp_Integer_Value (Int64 (Value_Ptr.I64), Btype); when Mode_F64 => - raise Internal_Error; + Disp_Float_Value (Fp64 (Value_Ptr.F64), Btype); end case; - end Read_Value; + end Disp_Value; - function Read_Value (Value : Value_Union; Mode : Mode_Type) - return Int64 is + procedure Disp_Value (Value : Value_Union; + Mode : Mode_Type; + Btype : Node) is begin case Mode is when Mode_B1 => - return Ghdl_B1'Pos (Value.B1); + Disp_Enumeration_Value (Ghdl_B1'Pos (Value.B1), Btype); when Mode_E8 => - return Int64 (Value.E8); + Disp_Enumeration_Value (Int64 (Value.E8), Btype); when Mode_E32 => - return Int64 (Value.E32); + Disp_Enumeration_Value (Int64 (Value.E32), Btype); when Mode_I32 => - return Int64 (Value.I32); + Disp_Integer_Value (Int64 (Value.I32), Btype); when Mode_I64 => - return Int64 (Value.I64); + Disp_Integer_Value (Int64 (Value.I64), Btype); when Mode_F64 => - raise Internal_Error; + Disp_Float_Value (Fp64 (Value.F64), Btype); end case; - end Read_Value; + end Disp_Value; procedure Disp_Transaction (Trans : Transaction_Acc; Sig_Type : Node; @@ -186,9 +188,9 @@ package body Simul.Vhdl_Debug is loop case T.Kind is when Trans_Value => - Disp_Discrete_Value (Read_Value (T.Val, Mode), Sig_Type); + Disp_Value (T.Val, Mode, Sig_Type); when Trans_Direct => - Disp_Discrete_Value (Read_Value (T.Val_Ptr, Mode), Sig_Type); + Disp_Value (T.Val_Ptr, Mode, Sig_Type); when Trans_Null => Put ("NULL"); when Trans_Error => @@ -218,9 +220,9 @@ package body Simul.Vhdl_Debug is Put (' '); Grt.Disp_Signals.Disp_Single_Signal_Attributes (Sig); Put (" val="); - Disp_Discrete_Value (Read_Value (Sig.Value_Ptr, Sig.Mode), Stype); + Disp_Value (Sig.Value_Ptr, Sig.Mode, Stype); Put ("; drv="); - Disp_Discrete_Value (Read_Value (Sig.Driving_Value, Sig.Mode), Stype); + Disp_Value (Sig.Driving_Value, Sig.Mode, Stype); if Sig.Nbr_Ports > 0 then Put (';'); Put_Int32 (Int32 (Sig.Nbr_Ports)); @@ -267,9 +269,7 @@ package body Simul.Vhdl_Debug is procedure For_Each_Scalar_Signal (S : Memtyp; Stype : Node) is begin case S.Typ.Kind is - when Type_Bit - | Type_Logic - | Type_Discrete => + when Type_Scalars => For_Scalar_Signal (S, Get_Base_Type (Stype)); when Type_Vector | Type_Array => @@ -309,8 +309,7 @@ package body Simul.Vhdl_Debug is Get_Type (El)); end loop; end; - when Type_Float - | Type_Unbounded_Vector + when Type_Unbounded_Vector | Type_Unbounded_Record | Type_Unbounded_Array | Type_Slice diff --git a/src/synth/elab-debugger.adb b/src/synth/elab-debugger.adb index 66b1fe835..441a64eb1 100644 --- a/src/synth/elab-debugger.adb +++ b/src/synth/elab-debugger.adb @@ -448,6 +448,10 @@ package body Elab.Debugger is P : Natural; begin P := Skip_Blanks (Line); + if P > Line'Last then + Put_Line ("missing subprogram name"); + return; + end if; if Line (P) = '"' then -- An operator name. declare diff --git a/src/synth/elab-vhdl_debug.adb b/src/synth/elab-vhdl_debug.adb index 8db0f2058..d47c310f0 100644 --- a/src/synth/elab-vhdl_debug.adb +++ b/src/synth/elab-vhdl_debug.adb @@ -55,23 +55,51 @@ package body Elab.Vhdl_Debug is & 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 => - Put_Int64 (Val); + Disp_Integer_Value (Val, Btype); when Iir_Kind_Enumeration_Type_Definition | Iir_Kind_Enumeration_Subtype_Definition => - declare - 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 (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; @@ -158,7 +186,7 @@ package body Elab.Vhdl_Debug is if I /= 1 then Put (", "); end if; - Disp_Value_Array ((Mem.Typ, + Disp_Value_Array ((Mem.Typ.Arr_El, Mem.Mem + Size_Type (Len - I) * Stride), A_Type); end loop; diff --git a/src/synth/elab-vhdl_debug.ads b/src/synth/elab-vhdl_debug.ads index a1200d621..f9dd900c0 100644 --- a/src/synth/elab-vhdl_debug.ads +++ b/src/synth/elab-vhdl_debug.ads @@ -27,6 +27,11 @@ package Elab.Vhdl_Debug is procedure Disp_Memtyp (M : Memtyp; Vtype : Node); function Walk_Declarations (Cb : Walk_Cb) return Walk_Status; + procedure Disp_Integer_Value (Val : Int64; Btype : Node); + procedure Disp_Enumeration_Value (Val : Int64; Btype : Node); + procedure Disp_Physical_Value (Val : Int64; Btype : Node); + procedure Disp_Float_Value (Val : Fp64; Btype : Node); + procedure Disp_Discrete_Value (Val : Int64; Btype : Node); procedure Disp_Declaration_Objects |