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
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
|
-- 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 Nodes_Meta;
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_Interface_Constant_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;
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
use Nodes_Meta;
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_Attribute (F) is
when Attr_Ref
| Attr_Chain_Next =>
null;
when Attr_Maybe_Ref =>
if not Get_Is_Ref (N) then
Mark_Iir (Get_Iir (N, F));
end if;
when Attr_Chain =>
Mark_Chain (Get_Iir (N, F));
when Attr_None =>
case Get_Field_Type (F) is
when Type_Iir =>
Mark_Iir (Get_Iir (N, F));
when Type_Iir_List =>
Mark_Iir_List (Get_Iir_List (N, F));
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;
when Attr_Of_Ref =>
raise Internal_Error;
end case;
end loop;
end;
end Mark_Iir;
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;
|
