diff options
Diffstat (limited to 'src/synth/elab-vhdl_debug.adb')
| -rw-r--r-- | src/synth/elab-vhdl_debug.adb | 345 |
1 files changed, 322 insertions, 23 deletions
diff --git a/src/synth/elab-vhdl_debug.adb b/src/synth/elab-vhdl_debug.adb index bdab9674f..e7cc2fc1e 100644 --- a/src/synth/elab-vhdl_debug.adb +++ b/src/synth/elab-vhdl_debug.adb @@ -31,9 +31,11 @@ package body Elab.Vhdl_Debug is procedure Disp_Discrete_Value (Val : Int64; Btype : Node) is begin case Get_Kind (Btype) is - when Iir_Kind_Integer_Type_Definition => + when Iir_Kind_Integer_Type_Definition + | Iir_Kind_Integer_Subtype_Definition => Put_Int64 (Val); - when Iir_Kind_Enumeration_Type_Definition => + when Iir_Kind_Enumeration_Type_Definition + | Iir_Kind_Enumeration_Subtype_Definition => declare Pos : constant Natural := Natural (Val); Enums : constant Node_Flist := @@ -200,20 +202,34 @@ package body Elab.Vhdl_Debug is end case; end Disp_Value; - procedure Disp_Bound_Type (Bound : Bound_Type) is + procedure Disp_Direction (Dir : Direction_Type) is begin - Put_Int32 (Bound.Left); - Put (' '); - case Bound.Dir is + case Dir is when Dir_To => Put ("to"); when Dir_Downto => Put ("downto"); end case; + end Disp_Direction; + + procedure Disp_Bound_Type (Bound : Bound_Type) is + begin + Put_Int32 (Bound.Left); + Put (' '); + Disp_Direction (Bound.Dir); Put (' '); Put_Int32 (Bound.Right); end Disp_Bound_Type; + procedure Disp_Discrete_Range (Rng : Discrete_Range_Type; Vtype : Node) is + begin + Disp_Discrete_Value (Rng.Left, Vtype); + Put (' '); + Disp_Direction (Rng.Dir); + Put (' '); + Disp_Discrete_Value (Rng.Right, Vtype); + end Disp_Discrete_Range; + procedure Disp_Type (Typ : Type_Acc; Vtype : Node) is pragma Unreferenced (Vtype); @@ -313,6 +329,7 @@ package body Elab.Vhdl_Debug is package Hierarchy_Pkg is type Config_Type is record With_Objs : Boolean; + Recurse : Boolean; Indent : Natural; end record; @@ -363,7 +380,7 @@ package body Elab.Vhdl_Debug is (Sub, Get_Port_Chain (Sub_Node), Cfg.Indent); end if; - if Comp_Inst /= null then + if Cfg.Recurse and then Comp_Inst /= null then Disp_Hierarchy (Comp_Inst, Inc_Indent (Cfg)); end if; when Iir_Kind_Architecture_Body => @@ -374,7 +391,9 @@ package body Elab.Vhdl_Debug is Put (Image (Get_Identifier (Sub_Node))); Put (')'); New_Line; - Disp_Hierarchy (Sub, Inc_Indent (Cfg)); + if Cfg.Recurse then + Disp_Hierarchy (Sub, Inc_Indent (Cfg)); + end if; when others => raise Internal_Error; end case; @@ -394,12 +413,15 @@ package body Elab.Vhdl_Debug is Put_Line (" [false]"); else Put_Line (" [true]"); - Disp_Hierarchy (Sub, Inc_Indent (Cfg)); + if Cfg.Recurse then + Disp_Hierarchy (Sub, Inc_Indent (Cfg)); + end if; end if; end; when Iir_Kind_For_Generate_Statement => declare It : constant Node := Get_Parameter_Specification (Stmt); + It_Type : constant Node := Get_Type (It); It_Rng : Type_Acc; It_Len : Natural; Gen_Inst : Synth_Instance_Acc; @@ -407,16 +429,20 @@ package body Elab.Vhdl_Debug is Put_Indent (Cfg.Indent); Put (Image (Get_Label (Stmt))); Put (": for-generate"); - New_Line; - - It_Rng := Get_Subtype_Object (Inst, Get_Type (It)); - It_Len := Natural (Get_Range_Length (It_Rng.Drange)); - Gen_Inst := Get_Sub_Instance (Inst, Stmt); - for I in 1 .. It_Len loop - Disp_Hierarchy - (Get_Generate_Sub_Instance (Gen_Inst, I), - Inc_Indent (Cfg)); - end loop; + Put (" ("); + It_Rng := Get_Subtype_Object (Inst, It_Type); + Disp_Discrete_Range (It_Rng.Drange, It_Type); + Put_Line (")"); + + if Cfg.Recurse then + It_Len := Natural (Get_Range_Length (It_Rng.Drange)); + Gen_Inst := Get_Sub_Instance (Inst, Stmt); + for I in 1 .. It_Len loop + Disp_Hierarchy + (Get_Generate_Sub_Instance (Gen_Inst, I), + Inc_Indent (Cfg)); + end loop; + end if; end; when Iir_Kind_Block_Statement => declare @@ -426,9 +452,11 @@ package body Elab.Vhdl_Debug is Put_Indent (Cfg.Indent); Put (Image (Get_Label (Stmt))); Put_Line (": block"); - Disp_Hierarchy_Statements - (Sub, Get_Concurrent_Statement_Chain (Stmt), - Inc_Indent (Cfg)); + if Cfg.Recurse then + Disp_Hierarchy_Statements + (Sub, Get_Concurrent_Statement_Chain (Stmt), + Inc_Indent (Cfg)); + end if; end; when Iir_Kinds_Concurrent_Signal_Assignment | Iir_Kind_Concurrent_Assertion_Statement @@ -500,6 +528,17 @@ package body Elab.Vhdl_Debug is Disp_Hierarchy (Get_Component_Instance (Inst), Inc_Indent (Cfg)); when Iir_Kind_Generate_Statement_Body => + Put_Indent (Cfg.Indent); + Put ("generate statement body"); + -- TODO: disp label or index ? + New_Line; + Disp_Hierarchy_Statements + (Inst, Get_Concurrent_Statement_Chain (N), Cfg); + when Iir_Kind_Block_Statement => + Put_Indent (Cfg.Indent); + Put ("block statement "); + Put (Image (Get_Identifier (N))); + New_Line; Disp_Hierarchy_Statements (Inst, Get_Concurrent_Statement_Chain (N), Cfg); when others => @@ -508,12 +547,15 @@ package body Elab.Vhdl_Debug is end Disp_Hierarchy; end Hierarchy_Pkg; - procedure Disp_Hierarchy (Inst : Synth_Instance_Acc; With_Objs : Boolean) + procedure Disp_Hierarchy (Inst : Synth_Instance_Acc; + Recurse : Boolean; + With_Objs : Boolean) is use Hierarchy_Pkg; Cfg : Config_Type; begin Cfg := (With_Objs => With_Objs, + Recurse => Recurse, Indent => 0); Hierarchy_Pkg.Disp_Hierarchy (Inst, Cfg); end Disp_Hierarchy; @@ -705,4 +747,261 @@ package body Elab.Vhdl_Debug is return Walk_Units (Cb_Walk_Declarations'Access); end Walk_Declarations; + function Find_Concurrent_Statement_By_Name (Stmts : Node; Id : Name_Id) + return Node + is + Stmt : Node; + begin + Stmt := Stmts; + while Stmt /= Null_Node loop + if Get_Label (Stmt) = Id then + return Stmt; + end if; + Stmt := Get_Chain (Stmt); + end loop; + return Null_Node; + end Find_Concurrent_Statement_By_Name; + + function Get_Sub_Instance_By_Name (Inst : Synth_Instance_Acc; Name : String) + return Synth_Instance_Acc + is + Scope : constant Node := Get_Source_Scope (Inst); + Has_Index : Boolean; + End_Id : Natural; + Index : Int64; + Stmt : Node; + Id : Name_Id; + begin + End_Id := Name'Last; + Has_Index := Name (End_Id) = ')'; + Index := 0; + if Has_Index then + -- There is a loop-generate index. + -- Search for '('. + for I in Name'Range loop + if Name (I) = '(' then + End_Id := I - 1; + exit; + end if; + end loop; + if End_Id = Name'Last or End_Id = Name'First then + return null; + end if; + -- Decode index (assume int). + for P in End_Id + 2 .. Name'Last - 1 loop + if Name (P) in '0' .. '9' then + Index := Index * 10 + + Character'Pos (Name (P)) - Character'Pos ('0'); + else + return null; + end if; + end loop; + end if; + + Id := Get_Identifier_No_Create (Name (Name'First .. End_Id)); + if Id = Null_Identifier then + -- All the identifiers are known, so this name cannot exist. + return null; + end if; + case Get_Kind (Scope) is + when Iir_Kind_Architecture_Body + | Iir_Kind_Generate_Statement_Body + | Iir_Kind_Block_Statement => + Stmt := Find_Concurrent_Statement_By_Name + (Get_Concurrent_Statement_Chain (Scope), Id); + when others => + Vhdl.Errors.Error_Kind ("get_sub_instance(1)", Scope); + end case; + + if Stmt = Null_Node then + return null; + end if; + + case Get_Kind (Stmt) is + when Iir_Kind_Component_Instantiation_Statement => + if Has_Index then + return null; + end if; + declare + Sub_Inst : constant Synth_Instance_Acc := + Get_Sub_Instance (Inst, Stmt); + Sub_Node : constant Node := Get_Source_Scope (Sub_Inst); + begin + case Get_Kind (Sub_Node) is + when Iir_Kind_Component_Declaration => + return Get_Component_Instance (Sub_Inst); + when Iir_Kind_Architecture_Body => + return Sub_Inst; + when others => + raise Internal_Error; + end case; + end; + when Iir_Kind_If_Generate_Statement + | Iir_Kind_Block_Statement => + if Has_Index then + return null; + end if; + return Get_Sub_Instance (Inst, Stmt); + when Iir_Kind_For_Generate_Statement => + if not Has_Index then + return null; + end if; + declare + Iterator : constant Node := + Get_Parameter_Specification (Stmt); + It_Rng : constant Type_Acc := + Get_Subtype_Object (Inst, Get_Type (Iterator)); + Gen_Inst : constant Synth_Instance_Acc := + Get_Sub_Instance (Inst, Stmt); + Off : Int64; + begin + case It_Rng.Drange.Dir is + when Dir_To => + if Index < It_Rng.Drange.Left + or else Index > It_Rng.Drange.Right + then + return null; + end if; + Off := Index - It_Rng.Drange.Left + 1; + when Dir_Downto => + if Index > It_Rng.Drange.Left + or else Index < It_Rng.Drange.Right + then + return null; + end if; + Off := Index - It_Rng.Drange.Right + 1; + end case; + return Get_Generate_Sub_Instance (Gen_Inst, Positive (Off)); + end; + when Iir_Kinds_Concurrent_Signal_Assignment + | Iir_Kind_Concurrent_Assertion_Statement + | Iir_Kind_Concurrent_Procedure_Call_Statement => + return null; + when others => + Vhdl.Errors.Error_Kind ("get_sub_instance(2)", Stmt); + end case; + end Get_Sub_Instance_By_Name; + + function Find_Concurrent_Statement_By_Instance + (Inst : Synth_Instance_Acc; + Stmts : Node; + Sub_Inst : Synth_Instance_Acc) return Node + is + Stmt : Node; + begin + Stmt := Stmts; + while Stmt /= Null_Node loop + case Get_Kind (Stmt) is + when Iir_Kind_Component_Instantiation_Statement + | Iir_Kind_If_Generate_Statement + | Iir_Kind_Block_Statement => + declare + Sub : constant Synth_Instance_Acc := + Get_Sub_Instance (Inst, Stmt); + begin + if Sub = Sub_Inst then + return Stmt; + end if; + end; + when Iir_Kind_For_Generate_Statement => + declare + Sub : constant Synth_Instance_Acc := + Get_Sub_Instance (Inst, Stmt); + begin + if Sub = Sub_Inst then -- Get_Instance_Parent (Sub_Inst) then + return Stmt; + end if; + end; + when others => + null; + end case; + Stmt := Get_Chain (Stmt); + end loop; + raise Internal_Error; + end Find_Concurrent_Statement_By_Instance; + + function Skip_Instance_Parent (Inst : Synth_Instance_Acc) + return Synth_Instance_Acc + is + Parent : constant Synth_Instance_Acc := Get_Instance_Parent (Inst); + Parent_Scope : constant Node := Get_Source_Scope (Parent); + begin + if Parent_Scope = Null_Node then + -- The root. + return null; + end if; + + case Get_Kind (Parent_Scope) is + when Iir_Kind_Architecture_Body + | Iir_Kind_Block_Statement => + return Inst; + when Iir_Kind_Component_Declaration => + return Parent; + when Iir_Kind_For_Generate_Statement => + return Parent; + when Iir_Kind_Generate_Statement_Body => + -- For an if-generate, the parent is really the parent. + return Inst; + when others => + Vhdl.Errors.Error_Kind ("skip_instance_parent", Parent_Scope); + end case; + end Skip_Instance_Parent; + + function Get_Instance_Path_Parent (Inst : Synth_Instance_Acc) + return Synth_Instance_Acc + is + Pre_Parent : constant Synth_Instance_Acc := Skip_Instance_Parent (Inst); + begin + if Pre_Parent = null then + -- The root. + return null; + end if; + return Get_Instance_Parent (Pre_Parent); + end Get_Instance_Path_Parent; + + procedure Disp_Instance_Path_1 (Inst : Synth_Instance_Acc) + is + Pre_Parent_Inst : constant Synth_Instance_Acc := + Skip_Instance_Parent (Inst); + Parent_Inst : Synth_Instance_Acc; + Parent_Scope : Node; + Stmt : Node; + begin + if Pre_Parent_Inst = null then + return; + end if; + + Parent_Inst := Get_Instance_Parent (Pre_Parent_Inst); + Parent_Scope := Get_Source_Scope (Parent_Inst); + Disp_Instance_Path (Parent_Inst); + Put ('/'); + + Stmt := Find_Concurrent_Statement_By_Instance + (Parent_Inst, Get_Concurrent_Statement_Chain (Parent_Scope), + Pre_Parent_Inst); + Put (Image (Get_Identifier (Stmt))); + if Get_Kind (Stmt) = Iir_Kind_For_Generate_Statement then + declare + It : constant Node := Get_Parameter_Specification (Stmt); + It_Type : constant Node := Get_Type (It); + Val : constant Valtyp := Get_Value (Inst, It); + begin + Put ("("); + Disp_Discrete_Value (Read_Discrete (Val), It_Type); + Put (")"); + end; + end if; + end Disp_Instance_Path_1; + + procedure Disp_Instance_Path (Inst : Synth_Instance_Acc) + is + Parent : constant Synth_Instance_Acc := Get_Instance_Parent (Inst); + begin + if Parent = null then + -- The root. + Put ('/'); + else + Disp_Instance_Path_1 (Inst); + end if; + end Disp_Instance_Path; end Elab.Vhdl_Debug; |