diff options
-rw-r--r-- | src/flags.ads | 4 | ||||
-rw-r--r-- | src/ghdldrv/ghdlcomp.adb | 12 | ||||
-rw-r--r-- | src/libraries.adb | 5 | ||||
-rw-r--r-- | src/vhdl/nodes_gc.adb | 72 | ||||
-rw-r--r-- | src/vhdl/nodes_gc.ads | 5 |
5 files changed, 71 insertions, 27 deletions
diff --git a/src/flags.ads b/src/flags.ads index 4bb6ec486..dc6dcc96d 100644 --- a/src/flags.ads +++ b/src/flags.ads @@ -67,6 +67,10 @@ package Flags is -- -dstats: disp statistics. Dump_Stats : Boolean := False; + -- If not 0, do internal consistency and leaks check on the AST after + -- analysis. + Check_Ast_Level : Natural := 0; + -- -lX options: list tree as a vhdl file. -- --lall option: makes -lX options to apply to all files diff --git a/src/ghdldrv/ghdlcomp.adb b/src/ghdldrv/ghdlcomp.adb index 5d7dd7a28..18ed69380 100644 --- a/src/ghdldrv/ghdlcomp.adb +++ b/src/ghdldrv/ghdlcomp.adb @@ -24,7 +24,6 @@ with Ada.Text_IO; with Types; with Iirs; use Iirs; -with Nodes_GC; with Flags; with Sem; with Name_Table; @@ -38,9 +37,6 @@ package body Ghdlcomp is Flag_Expect_Failure : Boolean := False; - Flag_Debug_Nodes_Leak : Boolean := False; - -- If True, detect unreferenced nodes at the end of analysis. - -- Commands which use the mcode compiler. type Command_Comp is abstract new Command_Lib with null record; procedure Decode_Option (Cmd : in out Command_Comp; @@ -58,8 +54,8 @@ package body Ghdlcomp is if Option = "--expect-failure" then Flag_Expect_Failure := True; Res := Option_Ok; - elsif Option = "--debug-nodes-leak" then - Flag_Debug_Nodes_Leak := True; + elsif Option = "--check-ast" then + Flags.Check_Ast_Level := Flags.Check_Ast_Level + 1; Res := Option_Ok; elsif Hooks.Decode_Option.all (Option) then Res := Option_Ok; @@ -377,10 +373,6 @@ package body Ghdlcomp is raise Compilation_Error; end if; - if Flag_Debug_Nodes_Leak then - Nodes_GC.Report_Unreferenced; - end if; - Libraries.Save_Work_Library; exception diff --git a/src/libraries.adb b/src/libraries.adb index bb8b69089..4258eeaea 100644 --- a/src/libraries.adb +++ b/src/libraries.adb @@ -37,6 +37,7 @@ with Disp_Vhdl; with Sem; with Post_Sems; with Canon; +with Nodes_GC; package body Libraries is -- Chain of known libraries. This is also the top node of all iir node. @@ -1556,6 +1557,10 @@ package body Libraries is Disp_Tree.Disp_Tree (Unit); end if; + if Flags.Check_Ast_Level > 0 then + Nodes_GC.Check_Tree (Unit); + end if; + if Flags.Verbose then Report_Msg (Msgid_Note, Semantic, +Lib_Unit, "analyze %n", (1 => +Lib_Unit)); diff --git a/src/vhdl/nodes_gc.adb b/src/vhdl/nodes_gc.adb index 9b1c34cf7..99343222f 100644 --- a/src/vhdl/nodes_gc.adb +++ b/src/vhdl/nodes_gc.adb @@ -17,11 +17,11 @@ -- 02111-1307, USA. with Ada.Text_IO; +with Ada.Unchecked_Deallocation; with Types; use Types; with Nodes; with Nodes_Meta; use Nodes_Meta; with Errorout; use Errorout; -with Iirs; use Iirs; with Libraries; with Disp_Tree; with Std_Package; @@ -35,6 +35,9 @@ package body Nodes_GC is Markers : Marker_Array_Acc; + procedure Free is new Ada.Unchecked_Deallocation + (Marker_Array, Marker_Array_Acc); + procedure Mark_Iir (N : Iir); procedure Mark_Iir_List (N : Iir_List) @@ -242,6 +245,8 @@ package body Nodes_GC is return; end if; + Markers (Get_Design_File (Unit)) := True; + -- First mark dependences List := Get_Dependence_List (Unit); if List /= Null_Iir_List then @@ -273,12 +278,11 @@ package body Nodes_GC is Mark_Iir (Unit); end Mark_Unit; - procedure Report_Unreferenced + -- Initialize the mark process. Create the array and mark some unrooted + -- but referenced nodes in std_package. + procedure Mark_Init is - use Ada.Text_IO; use Std_Package; - El : Iir; - Nbr_Unreferenced : Natural; begin Markers := new Marker_Array'(Null_Iir .. Iirs.Get_Last_Node => False); @@ -287,7 +291,29 @@ package body Nodes_GC is -- Node not owned, but used for "/" (time, time). Markers (Convertible_Integer_Type_Definition) := True; Markers (Convertible_Real_Type_Definition) := True; + end Mark_Init; + + -- Marks known nodes that aren't owned. + procedure Mark_Not_Owned + is + use Std_Package; + begin + -- These nodes are owned by type/subtype declarations, so unmark them + -- before marking their owner. + Markers (Convertible_Integer_Type_Definition) := False; + Markers (Convertible_Real_Type_Definition) := False; + + -- These nodes are not rooted. + Mark_Iir (Convertible_Integer_Type_Declaration); + Mark_Iir (Convertible_Integer_Subtype_Declaration); + Mark_Iir (Convertible_Real_Type_Declaration); + Mark_Iir (Universal_Integer_One); + Mark_Chain (Wildcard_Type_Declaration_Chain); + Mark_Iir (Error_Mark); + end Mark_Not_Owned; + procedure Mark_Units_Of_All_Libraries is + begin -- The user nodes. declare Lib : Iir; @@ -355,20 +381,20 @@ package body Nodes_GC is Unit := Get_Chain (Unit); end loop; end; + end Mark_Units_Of_All_Libraries; - -- These nodes are owned by type/subtype declarations, so unmark them - -- before marking their owner. - Markers (Convertible_Integer_Type_Definition) := False; - Markers (Convertible_Real_Type_Definition) := False; - - -- These nodes are not rooted. - Mark_Iir (Convertible_Integer_Type_Declaration); - Mark_Iir (Convertible_Integer_Subtype_Declaration); - Mark_Iir (Convertible_Real_Type_Declaration); - Mark_Iir (Universal_Integer_One); - Mark_Chain (Wildcard_Type_Declaration_Chain); - Mark_Iir (Error_Mark); + procedure Report_Unreferenced + is + use Ada.Text_IO; + use Std_Package; + El : Iir; + Nbr_Unreferenced : Natural; + begin + Mark_Init; + Mark_Units_Of_All_Libraries; + Mark_Not_Owned; + -- Iterate on all nodes, and report nodes not marked. El := Error_Mark; Nbr_Unreferenced := 0; while El in Markers'Range loop @@ -382,8 +408,20 @@ package body Nodes_GC is El := Iir (Nodes.Next_Node (Nodes.Node_Type (El))); end loop; + Free (Markers); + if Has_Error then raise Internal_Error; end if; end Report_Unreferenced; + + procedure Check_Tree (Unit : Iir) is + begin + Mark_Init; + Mark_Unit (Unit); + Free (Markers); + if Has_Error then + raise Internal_Error; + end if; + end Check_Tree; end Nodes_GC; diff --git a/src/vhdl/nodes_gc.ads b/src/vhdl/nodes_gc.ads index ad17c67b7..9b92b9e8b 100644 --- a/src/vhdl/nodes_gc.ads +++ b/src/vhdl/nodes_gc.ads @@ -16,9 +16,14 @@ -- Software Foundation, 59 Temple Place - Suite 330, Boston, MA -- 02111-1307, USA. +with Iirs; use Iirs; + package Nodes_GC is Flag_Disp_Multiref : Boolean := True; + -- Perform an internal check on the tree structure of UNIT. + procedure Check_Tree (Unit : Iir); + procedure Report_Unreferenced; -- Display nodes that aren't referenced. end Nodes_GC; |