From e4960acab358ebdd76d796554f962e755ec8954c Mon Sep 17 00:00:00 2001 From: Tristan Gingold Date: Sun, 5 May 2019 08:28:43 +0200 Subject: vhdl: move nodes_gc to vhdl child. --- src/vhdl/nodes_gc.adb | 519 --------------------------------------------- src/vhdl/nodes_gc.ads | 29 --- src/vhdl/vhdl-nodes_gc.adb | 519 +++++++++++++++++++++++++++++++++++++++++++++ src/vhdl/vhdl-nodes_gc.ads | 29 +++ src/vhdl/vhdl-sem_lib.adb | 8 +- 5 files changed, 552 insertions(+), 552 deletions(-) delete mode 100644 src/vhdl/nodes_gc.adb delete mode 100644 src/vhdl/nodes_gc.ads create mode 100644 src/vhdl/vhdl-nodes_gc.adb create mode 100644 src/vhdl/vhdl-nodes_gc.ads diff --git a/src/vhdl/nodes_gc.adb b/src/vhdl/nodes_gc.adb deleted file mode 100644 index eb7d4dee3..000000000 --- a/src/vhdl/nodes_gc.adb +++ /dev/null @@ -1,519 +0,0 @@ --- Node garbage collector (for debugging). --- Copyright (C) 2014 Tristan Gingold --- --- GHDL is free software; you can redistribute it and/or modify it under --- the terms of the GNU General Public License as published by the Free --- Software Foundation; either version 2, or (at your option) any later --- version. --- --- GHDL is distributed in the hope that it will be useful, but WITHOUT ANY --- WARRANTY; without even the implied warranty of MERCHANTABILITY or --- FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --- for more details. --- --- You should have received a copy of the GNU General Public License --- along with GHDL; see the file COPYING. If not, write to the Free --- Software Foundation, 59 Temple Place - Suite 330, Boston, MA --- 02111-1307, USA. - -with Ada.Unchecked_Deallocation; -with Types; use Types; -with Logging; use Logging; -with Nodes; -with Nodes_Meta; use Nodes_Meta; -with Errorout; use Errorout; -with Libraries; -with Vhdl.Disp_Tree; -with Vhdl.Std_Package; - -package body Nodes_GC is - - type Marker_Array is array (Iir range <>) of Boolean; - type Marker_Array_Acc is access Marker_Array; - - Has_Error : Boolean := False; - - Markers : Marker_Array_Acc; - - procedure Free is new Ada.Unchecked_Deallocation - (Marker_Array, Marker_Array_Acc); - - procedure Report_Early_Reference (N : Iir; F : Nodes_Meta.Fields_Enum) is - begin - Log ("early reference to "); - Log (Nodes_Meta.Get_Field_Image (F)); - Log (" in "); - Vhdl.Disp_Tree.Disp_Tree (N, True); - Has_Error := True; - end Report_Early_Reference; - - procedure Report_Already_Marked (N : Iir) is - begin - Log ("Already marked "); - Vhdl.Disp_Tree.Disp_Tree (N, True); - Has_Error := True; - end Report_Already_Marked; - - procedure Mark_Iir (N : Iir); - - procedure Mark_Iir_List (N : Iir_List) - is - It : List_Iterator; - begin - case N is - when Null_Iir_List - | Iir_List_All => - null; - when others => - It := List_Iterate (N); - while Is_Valid (It) loop - Mark_Iir (Get_Element (It)); - Next (It); - end loop; - end case; - end Mark_Iir_List; - - procedure Mark_Iir_List_Ref (N : Iir_List; F : Fields_Enum) - is - El : Iir; - It : List_Iterator; - begin - case N is - when Null_Iir_List - | Iir_List_All => - null; - when others => - It := List_Iterate (N); - while Is_Valid (It) loop - El := Get_Element (It); - if not Markers (El) then - Report_Early_Reference (El, F); - end if; - Next (It); - end loop; - end case; - end Mark_Iir_List_Ref; - - procedure Mark_Iir_Flist (N : Iir_Flist) - is - El : Iir; - begin - case N is - when Null_Iir_Flist - | Iir_Flist_All - | Iir_Flist_Others => - null; - when others => - for I in Flist_First .. Flist_Last (N) loop - El := Get_Nth_Element (N, I); - Mark_Iir (El); - end loop; - end case; - end Mark_Iir_Flist; - - procedure Mark_Iir_Flist_Ref (N : Iir_Flist; F : Fields_Enum) - is - El : Iir; - begin - case N is - when Null_Iir_Flist - | Iir_Flist_All - | Iir_Flist_Others => - null; - when others => - for I in Flist_First .. Flist_Last (N) loop - El := Get_Nth_Element (N, I); - if not Markers (El) then - Report_Early_Reference (El, F); - end if; - end loop; - end case; - end Mark_Iir_Flist_Ref; - - procedure Mark_PSL_Node (N : PSL_Node) is - begin - null; - end Mark_PSL_Node; - - procedure Mark_PSL_NFA (N : PSL_NFA) is - begin - null; - end Mark_PSL_NFA; - - procedure Already_Marked (N : Iir) is - begin - -- An unused node mustn't be referenced. - if Get_Kind (N) = Iir_Kind_Unused then - raise Internal_Error; - end if; - - if not Flag_Disp_Multiref then - return; - end if; - - case Get_Kind (N) is - when Iir_Kind_Interface_Constant_Declaration => - if Get_Identifier (N) = Null_Identifier then - -- Anonymous interfaces are shared by predefined functions. - return; - end if; - when others => - null; - end case; - - Report_Already_Marked (N); - end Already_Marked; - - procedure Mark_Chain (Head : Iir) - is - El : Iir; - begin - El := Head; - while El /= Null_Iir loop - Mark_Iir (El); - El := Get_Chain (El); - end loop; - end Mark_Chain; - - procedure Report_Unreferenced_Node (N : Iir) is - begin - Vhdl.Disp_Tree.Disp_Tree (N, True); - Has_Error := True; - end Report_Unreferenced_Node; - - procedure Mark_Iir_Ref_Field (N : Iir; F : Fields_Enum) - is - Nf : constant Iir := Get_Iir (N, F); - begin - if Is_Valid (Nf) and then not Markers (Nf) then - Report_Early_Reference (N, F); - end if; - end Mark_Iir_Ref_Field; - - procedure Mark_Iir (N : Iir) is - begin - if N = Null_Iir then - return; - elsif Markers (N) then - Already_Marked (N); - return; - else - Markers (N) := True; - end if; - - declare - Fields : constant Fields_Array := Get_Fields (Get_Kind (N)); - F : Fields_Enum; - begin - for I in Fields'Range loop - F := Fields (I); - case Get_Field_Type (F) is - when Type_Iir => - case Get_Field_Attribute (F) is - when Attr_None => - Mark_Iir (Get_Iir (N, F)); - when Attr_Ref => - Mark_Iir_Ref_Field (N, F); - when Attr_Forward_Ref - | Attr_Chain_Next => - null; - when Attr_Maybe_Forward_Ref => - -- Only used for Named_Entity - pragma Assert (F = Field_Named_Entity); - - -- Overload_List has to be handled specially, as it - -- that case the Ref applies to the elements of the - -- list. - declare - Nf : constant Iir := Get_Iir (N, F); - begin - if Nf /= Null_Iir then - if Get_Is_Forward_Ref (N) then - pragma Assert - (Get_Kind (Nf) /= Iir_Kind_Overload_List); - null; - else - if Get_Kind (Nf) = Iir_Kind_Overload_List then - Mark_Iir (Nf); - else - Mark_Iir_Ref_Field (N, F); - end if; - end if; - end if; - end; - when Attr_Maybe_Ref => - if Get_Is_Ref (N) then - Mark_Iir_Ref_Field (N, F); - else - Mark_Iir (Get_Iir (N, F)); - end if; - when Attr_Chain => - Mark_Chain (Get_Iir (N, F)); - when Attr_Of_Ref | Attr_Of_Maybe_Ref => - raise Internal_Error; - end case; - when Type_Iir_List => - declare - Ref : Boolean; - begin - case Get_Field_Attribute (F) is - when Attr_None => - Ref := False; - when Attr_Of_Ref => - Ref := True; - when Attr_Of_Maybe_Ref => - Ref := Get_Is_Ref (N); - when Attr_Ref => - Ref := True; - when others => - raise Internal_Error; - end case; - if Ref then - Mark_Iir_List_Ref (Get_Iir_List (N, F), F); - else - Mark_Iir_List (Get_Iir_List (N, F)); - end if; - end; - when Type_Iir_Flist => - declare - Ref : Boolean; - begin - case Get_Field_Attribute (F) is - when Attr_None => - Ref := False; - when Attr_Of_Ref => - Ref := True; - when Attr_Of_Maybe_Ref => - Ref := Get_Is_Ref (N); - when Attr_Ref => - Ref := True; - when others => - raise Internal_Error; - end case; - if Ref then - Mark_Iir_Flist_Ref (Get_Iir_Flist (N, F), F); - else - Mark_Iir_Flist (Get_Iir_Flist (N, F)); - end if; - end; - when Type_PSL_Node => - Mark_PSL_Node (Get_PSL_Node (N, F)); - when Type_PSL_NFA => - Mark_PSL_NFA (Get_PSL_NFA (N, F)); - when others => - null; - end case; - end loop; - end; - end Mark_Iir; - - procedure Mark_Unit (Unit : Iir) - is - List : Iir_List; - It : List_Iterator; - El : Iir; - begin - pragma Assert (Get_Kind (Unit) = Iir_Kind_Design_Unit); - if Markers (Unit) then - return; - end if; - - -- Mark parents of UNIT. - declare - File : constant Iir := Get_Design_File (Unit); - Lib : constant Iir := Get_Library (File); - begin - Markers (File) := True; - Markers (Lib) := True; - end; - - -- First mark dependences - List := Get_Dependence_List (Unit); - if List /= Null_Iir_List then - It := List_Iterate (List); - while Is_Valid (It) loop - El := Get_Element (It); - case Get_Kind (El) is - when Iir_Kind_Design_Unit => - Mark_Unit (El); - when Iir_Kind_Entity_Aspect_Entity => - declare - Ent : constant Iir := Get_Entity_Name (El); - Arch_Name : constant Iir := Get_Architecture (El); - Arch : Iir; - begin - Mark_Unit (Get_Design_Unit (Get_Named_Entity (Ent))); - - -- Architecture is optional. - if Is_Valid (Arch_Name) then - Arch := Get_Named_Entity (Arch_Name); - -- There are many possibilities for the architecture. - if Is_Valid (Arch) then - case Get_Kind (Arch) is - when Iir_Kind_Design_Unit => - null; - when Iir_Kind_Architecture_Body => - Arch := Get_Design_Unit (Arch); - when others => - Error_Kind ("mark_unit", Arch); - end case; - Mark_Unit (Arch); - end if; - end if; - end; - when others => - Error_Kind ("mark_unit", El); - end case; - Next (It); - end loop; - end if; - - Mark_Iir (Unit); - end Mark_Unit; - - -- Initialize the mark process. Create the array and mark some unrooted - -- but referenced nodes in std_package. - procedure Mark_Init - is - use Vhdl.Std_Package; - begin - Markers := new Marker_Array'(Null_Iir .. Iirs.Get_Last_Node => False); - - Has_Error := False; - - -- 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 Vhdl.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; - File : Iir; - Unit : Iir; - begin - -- First mark all known libraries and file. - Lib := Libraries.Get_Libraries_Chain; - while Is_Valid (Lib) loop - pragma Assert (Get_Kind (Lib) = Iir_Kind_Library_Declaration); - pragma Assert (not Markers (Lib)); - Markers (Lib) := True; - File := Get_Design_File_Chain (Lib); - while Is_Valid (File) loop - pragma Assert (Get_Kind (File) = Iir_Kind_Design_File); - pragma Assert (not Markers (File)); - Markers (File) := True; - File := Get_Chain (File); - end loop; - Lib := Get_Chain (Lib); - end loop; - - -- Then mark all design units. This has to consider first the - -- dependencies. - Lib := Libraries.Get_Libraries_Chain; - while Is_Valid (Lib) loop - pragma Assert (Get_Kind (Lib) = Iir_Kind_Library_Declaration); - File := Get_Design_File_Chain (Lib); - while Is_Valid (File) loop - pragma Assert (Get_Kind (File) = Iir_Kind_Design_File); - Unit := Get_First_Design_Unit (File); - while Is_Valid (Unit) loop - Mark_Unit (Unit); - Unit := Get_Chain (Unit); - end loop; - File := Get_Chain (File); - end loop; - Lib := Get_Chain (Lib); - end loop; - end; - - -- Obsoleted units. - declare - Unit : Iir; - begin - Unit := Libraries.Obsoleted_Design_Units; - while Is_Valid (Unit) loop - pragma Assert (Get_Kind (Unit) = Iir_Kind_Design_Unit); - -- FIXME: obsoleted units may be in various state: - -- - unit created by the .cf file and replaced by the loaded one - -- (should have been free) - -- - unit directly obsoleted by a new unit in the same file - -- - unit indirectly obsoleted. - if Get_Date_State (Unit) <= Date_Disk then - -- Never loaded unit, so not referenced and removed from its - -- design file. - -- FIXME: free it early. - pragma Assert (Get_Dependence_List (Unit) = Null_Iir_List); - Mark_Iir (Unit); - else - if not Markers (Unit) then - Mark_Iir (Unit); - end if; - end if; - Unit := Get_Chain (Unit); - end loop; - end; - end Mark_Units_Of_All_Libraries; - - procedure Report_Unreferenced - is - use Vhdl.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 - if not Markers (El) and then Get_Kind (El) /= Iir_Kind_Unused then - if Nbr_Unreferenced = 0 then - Log_Line ("** unreferenced nodes:"); - end if; - Nbr_Unreferenced := Nbr_Unreferenced + 1; - Report_Unreferenced_Node (El); - end if; - 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 deleted file mode 100644 index 9b92b9e8b..000000000 --- a/src/vhdl/nodes_gc.ads +++ /dev/null @@ -1,29 +0,0 @@ --- Node garbage collector (for debugging). --- Copyright (C) 2014 Tristan Gingold --- --- GHDL is free software; you can redistribute it and/or modify it under --- the terms of the GNU General Public License as published by the Free --- Software Foundation; either version 2, or (at your option) any later --- version. --- --- GHDL is distributed in the hope that it will be useful, but WITHOUT ANY --- WARRANTY; without even the implied warranty of MERCHANTABILITY or --- FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --- for more details. --- --- You should have received a copy of the GNU General Public License --- along with GHDL; see the file COPYING. If not, write to the Free --- 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; diff --git a/src/vhdl/vhdl-nodes_gc.adb b/src/vhdl/vhdl-nodes_gc.adb new file mode 100644 index 000000000..8876528ff --- /dev/null +++ b/src/vhdl/vhdl-nodes_gc.adb @@ -0,0 +1,519 @@ +-- Node garbage collector (for debugging). +-- Copyright (C) 2014 Tristan Gingold +-- +-- GHDL is free software; you can redistribute it and/or modify it under +-- the terms of the GNU General Public License as published by the Free +-- Software Foundation; either version 2, or (at your option) any later +-- version. +-- +-- GHDL is distributed in the hope that it will be useful, but WITHOUT ANY +-- WARRANTY; without even the implied warranty of MERCHANTABILITY or +-- FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +-- for more details. +-- +-- You should have received a copy of the GNU General Public License +-- along with GHDL; see the file COPYING. If not, write to the Free +-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA +-- 02111-1307, USA. + +with Ada.Unchecked_Deallocation; +with Types; use Types; +with Logging; use Logging; +with Nodes; +with Nodes_Meta; use Nodes_Meta; +with Errorout; use Errorout; +with Libraries; +with Vhdl.Disp_Tree; +with Vhdl.Std_Package; + +package body Vhdl.Nodes_GC is + + type Marker_Array is array (Iir range <>) of Boolean; + type Marker_Array_Acc is access Marker_Array; + + Has_Error : Boolean := False; + + Markers : Marker_Array_Acc; + + procedure Free is new Ada.Unchecked_Deallocation + (Marker_Array, Marker_Array_Acc); + + procedure Report_Early_Reference (N : Iir; F : Nodes_Meta.Fields_Enum) is + begin + Log ("early reference to "); + Log (Nodes_Meta.Get_Field_Image (F)); + Log (" in "); + Vhdl.Disp_Tree.Disp_Tree (N, True); + Has_Error := True; + end Report_Early_Reference; + + procedure Report_Already_Marked (N : Iir) is + begin + Log ("Already marked "); + Vhdl.Disp_Tree.Disp_Tree (N, True); + Has_Error := True; + end Report_Already_Marked; + + procedure Mark_Iir (N : Iir); + + procedure Mark_Iir_List (N : Iir_List) + is + It : List_Iterator; + begin + case N is + when Null_Iir_List + | Iir_List_All => + null; + when others => + It := List_Iterate (N); + while Is_Valid (It) loop + Mark_Iir (Get_Element (It)); + Next (It); + end loop; + end case; + end Mark_Iir_List; + + procedure Mark_Iir_List_Ref (N : Iir_List; F : Fields_Enum) + is + El : Iir; + It : List_Iterator; + begin + case N is + when Null_Iir_List + | Iir_List_All => + null; + when others => + It := List_Iterate (N); + while Is_Valid (It) loop + El := Get_Element (It); + if not Markers (El) then + Report_Early_Reference (El, F); + end if; + Next (It); + end loop; + end case; + end Mark_Iir_List_Ref; + + procedure Mark_Iir_Flist (N : Iir_Flist) + is + El : Iir; + begin + case N is + when Null_Iir_Flist + | Iir_Flist_All + | Iir_Flist_Others => + null; + when others => + for I in Flist_First .. Flist_Last (N) loop + El := Get_Nth_Element (N, I); + Mark_Iir (El); + end loop; + end case; + end Mark_Iir_Flist; + + procedure Mark_Iir_Flist_Ref (N : Iir_Flist; F : Fields_Enum) + is + El : Iir; + begin + case N is + when Null_Iir_Flist + | Iir_Flist_All + | Iir_Flist_Others => + null; + when others => + for I in Flist_First .. Flist_Last (N) loop + El := Get_Nth_Element (N, I); + if not Markers (El) then + Report_Early_Reference (El, F); + end if; + end loop; + end case; + end Mark_Iir_Flist_Ref; + + procedure Mark_PSL_Node (N : PSL_Node) is + begin + null; + end Mark_PSL_Node; + + procedure Mark_PSL_NFA (N : PSL_NFA) is + begin + null; + end Mark_PSL_NFA; + + procedure Already_Marked (N : Iir) is + begin + -- An unused node mustn't be referenced. + if Get_Kind (N) = Iir_Kind_Unused then + raise Internal_Error; + end if; + + if not Flag_Disp_Multiref then + return; + end if; + + case Get_Kind (N) is + when Iir_Kind_Interface_Constant_Declaration => + if Get_Identifier (N) = Null_Identifier then + -- Anonymous interfaces are shared by predefined functions. + return; + end if; + when others => + null; + end case; + + Report_Already_Marked (N); + end Already_Marked; + + procedure Mark_Chain (Head : Iir) + is + El : Iir; + begin + El := Head; + while El /= Null_Iir loop + Mark_Iir (El); + El := Get_Chain (El); + end loop; + end Mark_Chain; + + procedure Report_Unreferenced_Node (N : Iir) is + begin + Vhdl.Disp_Tree.Disp_Tree (N, True); + Has_Error := True; + end Report_Unreferenced_Node; + + procedure Mark_Iir_Ref_Field (N : Iir; F : Fields_Enum) + is + Nf : constant Iir := Get_Iir (N, F); + begin + if Is_Valid (Nf) and then not Markers (Nf) then + Report_Early_Reference (N, F); + end if; + end Mark_Iir_Ref_Field; + + procedure Mark_Iir (N : Iir) is + begin + if N = Null_Iir then + return; + elsif Markers (N) then + Already_Marked (N); + return; + else + Markers (N) := True; + end if; + + declare + Fields : constant Fields_Array := Get_Fields (Get_Kind (N)); + F : Fields_Enum; + begin + for I in Fields'Range loop + F := Fields (I); + case Get_Field_Type (F) is + when Type_Iir => + case Get_Field_Attribute (F) is + when Attr_None => + Mark_Iir (Get_Iir (N, F)); + when Attr_Ref => + Mark_Iir_Ref_Field (N, F); + when Attr_Forward_Ref + | Attr_Chain_Next => + null; + when Attr_Maybe_Forward_Ref => + -- Only used for Named_Entity + pragma Assert (F = Field_Named_Entity); + + -- Overload_List has to be handled specially, as it + -- that case the Ref applies to the elements of the + -- list. + declare + Nf : constant Iir := Get_Iir (N, F); + begin + if Nf /= Null_Iir then + if Get_Is_Forward_Ref (N) then + pragma Assert + (Get_Kind (Nf) /= Iir_Kind_Overload_List); + null; + else + if Get_Kind (Nf) = Iir_Kind_Overload_List then + Mark_Iir (Nf); + else + Mark_Iir_Ref_Field (N, F); + end if; + end if; + end if; + end; + when Attr_Maybe_Ref => + if Get_Is_Ref (N) then + Mark_Iir_Ref_Field (N, F); + else + Mark_Iir (Get_Iir (N, F)); + end if; + when Attr_Chain => + Mark_Chain (Get_Iir (N, F)); + when Attr_Of_Ref | Attr_Of_Maybe_Ref => + raise Internal_Error; + end case; + when Type_Iir_List => + declare + Ref : Boolean; + begin + case Get_Field_Attribute (F) is + when Attr_None => + Ref := False; + when Attr_Of_Ref => + Ref := True; + when Attr_Of_Maybe_Ref => + Ref := Get_Is_Ref (N); + when Attr_Ref => + Ref := True; + when others => + raise Internal_Error; + end case; + if Ref then + Mark_Iir_List_Ref (Get_Iir_List (N, F), F); + else + Mark_Iir_List (Get_Iir_List (N, F)); + end if; + end; + when Type_Iir_Flist => + declare + Ref : Boolean; + begin + case Get_Field_Attribute (F) is + when Attr_None => + Ref := False; + when Attr_Of_Ref => + Ref := True; + when Attr_Of_Maybe_Ref => + Ref := Get_Is_Ref (N); + when Attr_Ref => + Ref := True; + when others => + raise Internal_Error; + end case; + if Ref then + Mark_Iir_Flist_Ref (Get_Iir_Flist (N, F), F); + else + Mark_Iir_Flist (Get_Iir_Flist (N, F)); + end if; + end; + when Type_PSL_Node => + Mark_PSL_Node (Get_PSL_Node (N, F)); + when Type_PSL_NFA => + Mark_PSL_NFA (Get_PSL_NFA (N, F)); + when others => + null; + end case; + end loop; + end; + end Mark_Iir; + + procedure Mark_Unit (Unit : Iir) + is + List : Iir_List; + It : List_Iterator; + El : Iir; + begin + pragma Assert (Get_Kind (Unit) = Iir_Kind_Design_Unit); + if Markers (Unit) then + return; + end if; + + -- Mark parents of UNIT. + declare + File : constant Iir := Get_Design_File (Unit); + Lib : constant Iir := Get_Library (File); + begin + Markers (File) := True; + Markers (Lib) := True; + end; + + -- First mark dependences + List := Get_Dependence_List (Unit); + if List /= Null_Iir_List then + It := List_Iterate (List); + while Is_Valid (It) loop + El := Get_Element (It); + case Get_Kind (El) is + when Iir_Kind_Design_Unit => + Mark_Unit (El); + when Iir_Kind_Entity_Aspect_Entity => + declare + Ent : constant Iir := Get_Entity_Name (El); + Arch_Name : constant Iir := Get_Architecture (El); + Arch : Iir; + begin + Mark_Unit (Get_Design_Unit (Get_Named_Entity (Ent))); + + -- Architecture is optional. + if Is_Valid (Arch_Name) then + Arch := Get_Named_Entity (Arch_Name); + -- There are many possibilities for the architecture. + if Is_Valid (Arch) then + case Get_Kind (Arch) is + when Iir_Kind_Design_Unit => + null; + when Iir_Kind_Architecture_Body => + Arch := Get_Design_Unit (Arch); + when others => + Error_Kind ("mark_unit", Arch); + end case; + Mark_Unit (Arch); + end if; + end if; + end; + when others => + Error_Kind ("mark_unit", El); + end case; + Next (It); + end loop; + end if; + + Mark_Iir (Unit); + end Mark_Unit; + + -- Initialize the mark process. Create the array and mark some unrooted + -- but referenced nodes in std_package. + procedure Mark_Init + is + use Vhdl.Std_Package; + begin + Markers := new Marker_Array'(Null_Iir .. Iirs.Get_Last_Node => False); + + Has_Error := False; + + -- 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 Vhdl.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; + File : Iir; + Unit : Iir; + begin + -- First mark all known libraries and file. + Lib := Libraries.Get_Libraries_Chain; + while Is_Valid (Lib) loop + pragma Assert (Get_Kind (Lib) = Iir_Kind_Library_Declaration); + pragma Assert (not Markers (Lib)); + Markers (Lib) := True; + File := Get_Design_File_Chain (Lib); + while Is_Valid (File) loop + pragma Assert (Get_Kind (File) = Iir_Kind_Design_File); + pragma Assert (not Markers (File)); + Markers (File) := True; + File := Get_Chain (File); + end loop; + Lib := Get_Chain (Lib); + end loop; + + -- Then mark all design units. This has to consider first the + -- dependencies. + Lib := Libraries.Get_Libraries_Chain; + while Is_Valid (Lib) loop + pragma Assert (Get_Kind (Lib) = Iir_Kind_Library_Declaration); + File := Get_Design_File_Chain (Lib); + while Is_Valid (File) loop + pragma Assert (Get_Kind (File) = Iir_Kind_Design_File); + Unit := Get_First_Design_Unit (File); + while Is_Valid (Unit) loop + Mark_Unit (Unit); + Unit := Get_Chain (Unit); + end loop; + File := Get_Chain (File); + end loop; + Lib := Get_Chain (Lib); + end loop; + end; + + -- Obsoleted units. + declare + Unit : Iir; + begin + Unit := Libraries.Obsoleted_Design_Units; + while Is_Valid (Unit) loop + pragma Assert (Get_Kind (Unit) = Iir_Kind_Design_Unit); + -- FIXME: obsoleted units may be in various state: + -- - unit created by the .cf file and replaced by the loaded one + -- (should have been free) + -- - unit directly obsoleted by a new unit in the same file + -- - unit indirectly obsoleted. + if Get_Date_State (Unit) <= Date_Disk then + -- Never loaded unit, so not referenced and removed from its + -- design file. + -- FIXME: free it early. + pragma Assert (Get_Dependence_List (Unit) = Null_Iir_List); + Mark_Iir (Unit); + else + if not Markers (Unit) then + Mark_Iir (Unit); + end if; + end if; + Unit := Get_Chain (Unit); + end loop; + end; + end Mark_Units_Of_All_Libraries; + + procedure Report_Unreferenced + is + use Vhdl.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 + if not Markers (El) and then Get_Kind (El) /= Iir_Kind_Unused then + if Nbr_Unreferenced = 0 then + Log_Line ("** unreferenced nodes:"); + end if; + Nbr_Unreferenced := Nbr_Unreferenced + 1; + Report_Unreferenced_Node (El); + end if; + 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 Vhdl.Nodes_GC; diff --git a/src/vhdl/vhdl-nodes_gc.ads b/src/vhdl/vhdl-nodes_gc.ads new file mode 100644 index 000000000..258ab7ab9 --- /dev/null +++ b/src/vhdl/vhdl-nodes_gc.ads @@ -0,0 +1,29 @@ +-- Node garbage collector (for debugging). +-- Copyright (C) 2014 Tristan Gingold +-- +-- GHDL is free software; you can redistribute it and/or modify it under +-- the terms of the GNU General Public License as published by the Free +-- Software Foundation; either version 2, or (at your option) any later +-- version. +-- +-- GHDL is distributed in the hope that it will be useful, but WITHOUT ANY +-- WARRANTY; without even the implied warranty of MERCHANTABILITY or +-- FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +-- for more details. +-- +-- You should have received a copy of the GNU General Public License +-- along with GHDL; see the file COPYING. If not, write to the Free +-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA +-- 02111-1307, USA. + +with Iirs; use Iirs; + +package Vhdl.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 Vhdl.Nodes_GC; diff --git a/src/vhdl/vhdl-sem_lib.adb b/src/vhdl/vhdl-sem_lib.adb index 10f6a60cc..fe788202d 100644 --- a/src/vhdl/vhdl-sem_lib.adb +++ b/src/vhdl/vhdl-sem_lib.adb @@ -28,7 +28,7 @@ with Vhdl.Disp_Vhdl; with Vhdl.Sem; with Vhdl.Post_Sems; with Vhdl.Canon; -with Nodes_GC; +with Vhdl.Nodes_GC; package body Vhdl.Sem_Lib is procedure Error_Lib_Msg (Msg : String; Arg1 : Earg_Type) is @@ -84,7 +84,7 @@ package body Vhdl.Sem_Lib is end if; if Flags.Check_Ast_Level > 0 then - Nodes_GC.Check_Tree (Unit); + Vhdl.Nodes_GC.Check_Tree (Unit); end if; if Flags.Verbose then @@ -107,7 +107,7 @@ package body Vhdl.Sem_Lib is end if; if Flags.Check_Ast_Level > 0 then - Nodes_GC.Check_Tree (Unit); + Vhdl.Nodes_GC.Check_Tree (Unit); end if; -- Post checks @@ -142,7 +142,7 @@ package body Vhdl.Sem_Lib is end if; if Flags.Check_Ast_Level > 0 then - Nodes_GC.Check_Tree (Unit); + Vhdl.Nodes_GC.Check_Tree (Unit); end if; end Finish_Compilation; -- cgit v1.2.3