blob: 7c4303bc5c72134d91180dca3cb04358eae10c33 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
|
-- 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.Text_IO;
with Types; use Types;
with Nodes;
with Iirs; use Iirs;
with Libraries;
with Disp_Tree;
with Std_Package;
package body Nodes_GC is
type Marker_Array is array (Iir range <>) of Boolean;
type Marker_Array_Acc is access Marker_Array;
Markers : Marker_Array_Acc;
procedure Mark_Iir (N : Iir);
procedure Mark_Iir_List (N : Iir_List)
is
El : Iir;
begin
case N is
when Null_Iir_List
| Iir_List_All
| Iir_List_Others =>
null;
when others =>
for I in Natural loop
El := Get_Nth_Element (N, I);
exit when El = Null_Iir;
Mark_Iir (El);
end loop;
end case;
end Mark_Iir_List;
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 Report_Already_Marked (N : Iir)
is
use Ada.Text_IO;
begin
Disp_Tree.Disp_Tree (N, True);
return;
end Report_Already_Marked;
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_Constant_Interface_Declaration =>
if Get_Identifier (N) = Null_Identifier then
-- Anonymous interfaces are shared by predefined functions.
return;
end if;
when Iir_Kind_Enumeration_Literal =>
if Get_Enum_Pos (N) = 0
or else N = Get_Right_Limit (Get_Range_Constraint
(Get_Type (N)))
then
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
Disp_Tree.Disp_Tree (N, True);
end Report_Unreferenced_Node;
-- Subprograms
procedure Report_Unreferenced
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);
if Flag_Disp_Multiref then
Put_Line ("** nodes already marked:");
end if;
Mark_Chain (Libraries.Get_Libraries_Chain);
Mark_Chain (Libraries.Obsoleted_Design_Units);
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);
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
Put_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;
if Nbr_Unreferenced /= 0 then
raise Internal_Error;
end if;
end Report_Unreferenced;
end Nodes_GC;
|