diff options
Diffstat (limited to 'src/vhdl/nodes_gc.adb')
| -rw-r--r-- | src/vhdl/nodes_gc.adb | 212 |
1 files changed, 192 insertions, 20 deletions
diff --git a/src/vhdl/nodes_gc.adb b/src/vhdl/nodes_gc.adb index c73331e3a..3ff1002a2 100644 --- a/src/vhdl/nodes_gc.adb +++ b/src/vhdl/nodes_gc.adb @@ -19,7 +19,8 @@ with Ada.Text_IO; with Types; use Types; with Nodes; -with Nodes_Meta; +with Nodes_Meta; use Nodes_Meta; +with Errorout; use Errorout; with Iirs; use Iirs; with Libraries; with Disp_Tree; @@ -30,6 +31,8 @@ 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 Mark_Iir (N : Iir); @@ -66,8 +69,9 @@ package body Nodes_GC is is use Ada.Text_IO; begin + Put ("Already marked "); Disp_Tree.Disp_Tree (N, True); - return; + Has_Error := True; end Report_Already_Marked; procedure Already_Marked (N : Iir) is @@ -94,7 +98,7 @@ package body Nodes_GC is Report_Already_Marked (N); end Already_Marked; - procedure Not_Marked (N : Iir; F : Nodes_Meta.Fields_Enum) + procedure Report_Early_Reference (N : Iir; F : Nodes_Meta.Fields_Enum) is use Ada.Text_IO; begin @@ -102,7 +106,8 @@ package body Nodes_GC is Put (Nodes_Meta.Get_Field_Image (F)); Put (" in "); Disp_Tree.Disp_Tree (N, True); - end Not_Marked; + Has_Error := True; + end Report_Early_Reference; procedure Mark_Chain (Head : Iir) is @@ -118,8 +123,41 @@ package body Nodes_GC is procedure Report_Unreferenced_Node (N : Iir) is begin Disp_Tree.Disp_Tree (N, True); + -- Has_Error := True; end Report_Unreferenced_Node; + procedure Mark_Iir_Ref_Field (N : Iir; F : Fields_Enum) is + begin + case Get_Field_Type (F) is + when Type_Iir => + declare + 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; + when Type_Iir_List => + declare + Nl : constant Iir_List := Get_Iir_List (N, F); + El : Iir; + begin + if Is_Null_List (Nl) or else Nl in Iir_Lists_All_Others then + return; + end if; + for I in Natural loop + El := Get_Nth_Element (Nl, I); + exit when El = Null_Iir; + if not Markers (El) then + Report_Early_Reference (El, F); + end if; + end loop; + end; + when others => + raise Internal_Error; + end case; + end Mark_Iir_Ref_Field; + procedure Mark_Iir (N : Iir) is begin if N = Null_Iir then @@ -132,7 +170,6 @@ package body Nodes_GC is end if; declare - use Nodes_Meta; Fields : constant Fields_Array := Get_Fields (Get_Kind (N)); F : Fields_Enum; begin @@ -140,17 +177,37 @@ package body Nodes_GC is F := Fields (I); case Get_Field_Attribute (F) is when Attr_Ref => - pragma Assert (Get_Field_Type (F) = Type_Iir); - if Is_Valid (Get_Iir (N, F)) - and then not Markers (Get_Iir (N, F)) - then - Not_Marked (N, F); - end if; + 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 not Get_Is_Ref (N) then + if Get_Is_Ref (N) then + Mark_Iir_Ref_Field (N, F); + else Mark_Iir (Get_Iir (N, F)); end if; when Attr_Chain => @@ -169,12 +226,53 @@ package body Nodes_GC is null; end case; when Attr_Of_Ref => - null; + Mark_Iir_Ref_Field (N, F); end case; end loop; end; end Mark_Iir; + procedure Mark_Unit (Unit : Iir) + is + List : Iir_List; + El : Iir; + begin + pragma Assert (Get_Kind (Unit) = Iir_Kind_Design_Unit); + if Markers (Unit) then + return; + end if; + + -- First mark dependences + List := Get_Dependence_List (Unit); + if List /= Null_Iir_List then + for I in Natural loop + El := Get_Nth_Element (List, I); + exit when El = Null_Iir; + + 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 : constant Iir := Get_Architecture (El); + begin + Mark_Unit (Get_Design_Unit (Get_Named_Entity (Ent))); + if Is_Valid (Arch) + and then Is_Valid (Get_Named_Entity (Arch)) + then + Mark_Unit (Get_Named_Entity (Arch)); + end if; + end; + when others => + Error_Kind ("mark_unit", El); + end case; + end loop; + end if; + + Mark_Iir (Unit); + end Mark_Unit; + procedure Report_Unreferenced is use Ada.Text_IO; @@ -184,18 +282,92 @@ package body Nodes_GC is begin Markers := new Marker_Array'(Null_Iir .. Iirs.Get_Last_Node => False); - if Flag_Disp_Multiref then - Put_Line ("** nodes already marked:"); - end if; + Has_Error := False; + + -- Node not owned, but used for "/" (time, time). + Markers (Convertible_Integer_Type_Definition) := True; + Markers (Convertible_Real_Type_Definition) := True; + + -- 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; + + -- 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; - Mark_Chain (Libraries.Get_Libraries_Chain); - Mark_Chain (Libraries.Obsoleted_Design_Units); + -- 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_Iir (Error_Mark); Mark_Chain (Wildcard_Type_Declaration_Chain); + Mark_Iir (Error_Mark); El := Error_Mark; Nbr_Unreferenced := 0; @@ -210,7 +382,7 @@ package body Nodes_GC is El := Iir (Nodes.Next_Node (Nodes.Node_Type (El))); end loop; - if Nbr_Unreferenced /= 0 then + if Has_Error then raise Internal_Error; end if; end Report_Unreferenced; |