diff options
Diffstat (limited to 'src/synth/elab-debugger__on.adb')
| -rw-r--r-- | src/synth/elab-debugger__on.adb | 465 |
1 files changed, 0 insertions, 465 deletions
diff --git a/src/synth/elab-debugger__on.adb b/src/synth/elab-debugger__on.adb index faab400ca..1dc176a6e 100644 --- a/src/synth/elab-debugger__on.adb +++ b/src/synth/elab-debugger__on.adb @@ -285,284 +285,6 @@ package body Elab.Debugger is return P - 1; end Get_Word; - procedure Disp_Memtyp (M : Memtyp; Vtype : Node); - - procedure Disp_Discrete_Value (Val : Int64; Btype : Node) is - begin - case Get_Kind (Btype) is - when Iir_Kind_Integer_Type_Definition => - Put_Int64 (Val); - when Iir_Kind_Enumeration_Type_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; - 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) * Mem.Typ.Sz), - El_Type); - end loop; - Put (")"); - end if; - end Disp_Value_Vector; - - procedure Disp_Value_Array (Mem : Memtyp; A_Type: Node; Dim: Dim_Type) - is - Stride : Size_Type; - begin - if Dim = Mem.Typ.Abounds.Ndim then - -- Last dimension - 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 .. Mem.Typ.Abounds.D (Dim).Len loop - if I /= 1 then - Put (", "); - end if; - Disp_Value_Array ((Mem.Typ, Mem.Mem + Stride), A_Type, Dim + 1); - end loop; - Put (")"); - end if; - end Disp_Value_Array; - - 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.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_Protected => - Put ("*protected*"); - when Type_Unbounded_Array - | 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"); - when Value_File => - Put ("file"); - when Value_Const => - Put ("const: "); - Disp_Memtyp (Get_Memtyp (Vt), Vtype); - when Value_Alias => - Put ("alias"); - Disp_Memtyp (Get_Memtyp (Vt), Vtype); - 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 (' '); - case Bound.Dir is - when Dir_To => - Put ("to"); - when Dir_Downto => - Put ("downto"); - end case; - Put (' '); - Put_Int32 (Bound.Right); - end Disp_Bound_Type; - - 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.Vbound); - Put (')'); - when Type_Unbounded_Vector => - Put ("unbounded_vector"); - when Type_Array => - Put ("array"); - 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) 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 (Vhdl.Errors.Disp_Node (Decl)); - Put (": "); - Disp_Type (Val.Typ, Dtype); - Put (" = "); - Disp_Value (Val, Dtype); - New_Line; - end; - when Iir_Kinds_Signal_Attribute => - -- 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 => - null; - 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) - is - El : Iir; - begin - El := Decl_Chain; - while El /= Null_Iir loop - Disp_Declaration_Object (Instance, El); - El := Get_Chain (El); - end loop; - end Disp_Declaration_Objects; - procedure Info_Params_Proc (Line : String) is pragma Unreferenced (Line); @@ -629,193 +351,6 @@ package body Elab.Debugger is Debug_Synth_Instance (Current_Instance); end Info_Instance_Proc; - 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; - -- Next statement in the same frame, but handle compound statements as -- one statement. procedure Next_Stmt_Proc (Line : String) |