]>
Commit | Line | Data |
---|---|---|
38cbfe40 RK |
1 | ------------------------------------------------------------------------------ |
2 | -- -- | |
3 | -- GNAT COMPILER COMPONENTS -- | |
4 | -- -- | |
5 | -- L I V E -- | |
6 | -- -- | |
7 | -- B o d y -- | |
8 | -- -- | |
8d0d46f4 | 9 | -- Copyright (C) 2000-2021, Free Software Foundation, Inc. -- |
38cbfe40 RK |
10 | -- -- |
11 | -- GNAT is free software; you can redistribute it and/or modify it under -- | |
12 | -- terms of the GNU General Public License as published by the Free Soft- -- | |
b5c84c3c | 13 | -- ware Foundation; either version 3, or (at your option) any later ver- -- |
38cbfe40 RK |
14 | -- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- |
15 | -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- | |
16 | -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- | |
17 | -- for more details. You should have received a copy of the GNU General -- | |
b5c84c3c RD |
18 | -- Public License distributed with GNAT; see file COPYING3. If not, go to -- |
19 | -- http://www.gnu.org/licenses for a complete copy of the license. -- | |
38cbfe40 RK |
20 | -- -- |
21 | -- GNAT was originally developed by the GNAT team at New York University. -- | |
71ff80dc | 22 | -- Extensive contributions were provided by Ada Core Technologies Inc. -- |
38cbfe40 RK |
23 | -- -- |
24 | ------------------------------------------------------------------------------ | |
25 | ||
104f58db BD |
26 | with Atree; use Atree; |
27 | with Einfo; use Einfo; | |
76f9c7f4 | 28 | with Einfo.Entities; use Einfo.Entities; |
104f58db BD |
29 | with Einfo.Utils; use Einfo.Utils; |
30 | with Lib; use Lib; | |
31 | with Nlists; use Nlists; | |
32 | with Sem_Aux; use Sem_Aux; | |
33 | with Sem_Util; use Sem_Util; | |
34 | with Sinfo; use Sinfo; | |
35 | with Sinfo.Nodes; use Sinfo.Nodes; | |
36 | with Sinfo.Utils; use Sinfo.Utils; | |
37 | with Types; use Types; | |
38cbfe40 RK |
38 | |
39 | package body Live is | |
40 | ||
41 | -- Name_Set | |
42 | ||
0da343bc AC |
43 | -- The Name_Set type is used to store the temporary mark bits used by the |
44 | -- garbage collection of entities. Using a separate array prevents using up | |
45 | -- any valuable per-node space and possibly results in better locality and | |
46 | -- cache usage. | |
38cbfe40 RK |
47 | |
48 | type Name_Set is array (Node_Id range <>) of Boolean; | |
49 | pragma Pack (Name_Set); | |
50 | ||
51 | function Marked (Marks : Name_Set; Name : Node_Id) return Boolean; | |
52 | pragma Inline (Marked); | |
53 | ||
54 | procedure Set_Marked | |
55 | (Marks : in out Name_Set; | |
56 | Name : Node_Id; | |
57 | Mark : Boolean := True); | |
58 | pragma Inline (Set_Marked); | |
59 | ||
60 | -- Algorithm | |
61 | ||
62 | -- The problem of finding live entities is solved in two steps: | |
63 | ||
64 | procedure Mark (Root : Node_Id; Marks : out Name_Set); | |
9de61fcb | 65 | -- Mark all live entities in Root as Marked |
38cbfe40 RK |
66 | |
67 | procedure Sweep (Root : Node_Id; Marks : Name_Set); | |
68 | -- For all unmarked entities in Root set Is_Eliminated to true | |
69 | ||
70 | -- The Mark phase is split into two phases: | |
71 | ||
72 | procedure Init_Marked (Root : Node_Id; Marks : out Name_Set); | |
0da343bc AC |
73 | -- For all subprograms, reset Is_Public flag if a pragma Eliminate applies |
74 | -- to the entity, and set the Marked flag to Is_Public. | |
38cbfe40 RK |
75 | |
76 | procedure Trace_Marked (Root : Node_Id; Marks : in out Name_Set); | |
0da343bc AC |
77 | -- Traverse the tree skipping any unmarked subprogram bodies. All visited |
78 | -- entities are marked, as well as entities denoted by a visited identifier | |
79 | -- or operator. When an entity is first marked it is traced as well. | |
38cbfe40 RK |
80 | |
81 | -- Local functions | |
82 | ||
83 | function Body_Of (E : Entity_Id) return Node_Id; | |
84 | -- Returns subprogram body corresponding to entity E | |
85 | ||
86 | function Spec_Of (N : Node_Id) return Entity_Id; | |
87 | -- Given a subprogram body N, return defining identifier of its declaration | |
88 | ||
38cbfe40 RK |
89 | ------------- |
90 | -- Body_Of -- | |
91 | ------------- | |
92 | ||
93 | function Body_Of (E : Entity_Id) return Node_Id is | |
fbf5a39b AC |
94 | Decl : constant Node_Id := Unit_Declaration_Node (E); |
95 | Kind : constant Node_Kind := Nkind (Decl); | |
96 | Result : Node_Id; | |
38cbfe40 RK |
97 | |
98 | begin | |
99 | if Kind = N_Subprogram_Body then | |
100 | Result := Decl; | |
101 | ||
102 | elsif Kind /= N_Subprogram_Declaration | |
103 | and Kind /= N_Subprogram_Body_Stub | |
104 | then | |
105 | Result := Empty; | |
106 | ||
107 | else | |
108 | Result := Corresponding_Body (Decl); | |
109 | ||
110 | if Result /= Empty then | |
111 | Result := Unit_Declaration_Node (Result); | |
112 | end if; | |
113 | end if; | |
114 | ||
115 | return Result; | |
116 | end Body_Of; | |
117 | ||
118 | ------------------------------ | |
119 | -- Collect_Garbage_Entities -- | |
120 | ------------------------------ | |
121 | ||
122 | procedure Collect_Garbage_Entities is | |
123 | Root : constant Node_Id := Cunit (Main_Unit); | |
124 | Marks : Name_Set (0 .. Last_Node_Id); | |
125 | ||
126 | begin | |
127 | Mark (Root, Marks); | |
128 | Sweep (Root, Marks); | |
129 | end Collect_Garbage_Entities; | |
130 | ||
131 | ----------------- | |
132 | -- Init_Marked -- | |
133 | ----------------- | |
134 | ||
135 | procedure Init_Marked (Root : Node_Id; Marks : out Name_Set) is | |
136 | ||
137 | function Process (N : Node_Id) return Traverse_Result; | |
138 | procedure Traverse is new Traverse_Proc (Process); | |
139 | ||
0da343bc AC |
140 | ------------- |
141 | -- Process -- | |
142 | ------------- | |
143 | ||
38cbfe40 RK |
144 | function Process (N : Node_Id) return Traverse_Result is |
145 | begin | |
146 | case Nkind (N) is | |
147 | when N_Entity'Range => | |
148 | if Is_Eliminated (N) then | |
149 | Set_Is_Public (N, False); | |
150 | end if; | |
151 | ||
152 | Set_Marked (Marks, N, Is_Public (N)); | |
153 | ||
154 | when N_Subprogram_Body => | |
155 | Traverse (Spec_Of (N)); | |
156 | ||
157 | when N_Package_Body_Stub => | |
158 | if Present (Library_Unit (N)) then | |
159 | Traverse (Proper_Body (Unit (Library_Unit (N)))); | |
160 | end if; | |
161 | ||
162 | when N_Package_Body => | |
163 | declare | |
164 | Elmt : Node_Id := First (Declarations (N)); | |
165 | begin | |
166 | while Present (Elmt) loop | |
167 | Traverse (Elmt); | |
168 | Next (Elmt); | |
169 | end loop; | |
170 | end; | |
171 | ||
172 | when others => | |
173 | null; | |
174 | end case; | |
175 | ||
176 | return OK; | |
177 | end Process; | |
178 | ||
179 | -- Start of processing for Init_Marked | |
180 | ||
181 | begin | |
182 | Marks := (others => False); | |
183 | Traverse (Root); | |
184 | end Init_Marked; | |
185 | ||
186 | ---------- | |
187 | -- Mark -- | |
188 | ---------- | |
189 | ||
190 | procedure Mark (Root : Node_Id; Marks : out Name_Set) is | |
191 | begin | |
192 | Init_Marked (Root, Marks); | |
193 | Trace_Marked (Root, Marks); | |
194 | end Mark; | |
195 | ||
196 | ------------ | |
197 | -- Marked -- | |
198 | ------------ | |
199 | ||
200 | function Marked (Marks : Name_Set; Name : Node_Id) return Boolean is | |
201 | begin | |
202 | return Marks (Name); | |
203 | end Marked; | |
204 | ||
205 | ---------------- | |
206 | -- Set_Marked -- | |
207 | ---------------- | |
208 | ||
209 | procedure Set_Marked | |
210 | (Marks : in out Name_Set; | |
211 | Name : Node_Id; | |
212 | Mark : Boolean := True) | |
213 | is | |
214 | begin | |
215 | Marks (Name) := Mark; | |
216 | end Set_Marked; | |
217 | ||
218 | ------------- | |
219 | -- Spec_Of -- | |
220 | ------------- | |
221 | ||
222 | function Spec_Of (N : Node_Id) return Entity_Id is | |
223 | begin | |
224 | if Acts_As_Spec (N) then | |
225 | return Defining_Entity (N); | |
226 | else | |
227 | return Corresponding_Spec (N); | |
228 | end if; | |
229 | end Spec_Of; | |
230 | ||
231 | ----------- | |
232 | -- Sweep -- | |
233 | ----------- | |
234 | ||
235 | procedure Sweep (Root : Node_Id; Marks : Name_Set) is | |
236 | ||
237 | function Process (N : Node_Id) return Traverse_Result; | |
238 | procedure Traverse is new Traverse_Proc (Process); | |
239 | ||
0da343bc AC |
240 | ------------- |
241 | -- Process -- | |
242 | ------------- | |
243 | ||
38cbfe40 RK |
244 | function Process (N : Node_Id) return Traverse_Result is |
245 | begin | |
246 | case Nkind (N) is | |
247 | when N_Entity'Range => | |
248 | Set_Is_Eliminated (N, not Marked (Marks, N)); | |
249 | ||
250 | when N_Subprogram_Body => | |
251 | Traverse (Spec_Of (N)); | |
252 | ||
253 | when N_Package_Body_Stub => | |
254 | if Present (Library_Unit (N)) then | |
255 | Traverse (Proper_Body (Unit (Library_Unit (N)))); | |
256 | end if; | |
257 | ||
258 | when N_Package_Body => | |
259 | declare | |
260 | Elmt : Node_Id := First (Declarations (N)); | |
261 | begin | |
262 | while Present (Elmt) loop | |
263 | Traverse (Elmt); | |
264 | Next (Elmt); | |
265 | end loop; | |
266 | end; | |
267 | ||
268 | when others => | |
269 | null; | |
270 | end case; | |
d8f43ee6 | 271 | |
38cbfe40 RK |
272 | return OK; |
273 | end Process; | |
274 | ||
0da343bc AC |
275 | -- Start of processing for Sweep |
276 | ||
38cbfe40 RK |
277 | begin |
278 | Traverse (Root); | |
279 | end Sweep; | |
280 | ||
281 | ------------------ | |
282 | -- Trace_Marked -- | |
283 | ------------------ | |
284 | ||
285 | procedure Trace_Marked (Root : Node_Id; Marks : in out Name_Set) is | |
286 | ||
287 | function Process (N : Node_Id) return Traverse_Result; | |
288 | procedure Process (N : Node_Id); | |
289 | procedure Traverse is new Traverse_Proc (Process); | |
290 | ||
0da343bc AC |
291 | ------------- |
292 | -- Process -- | |
293 | ------------- | |
294 | ||
38cbfe40 RK |
295 | procedure Process (N : Node_Id) is |
296 | Result : Traverse_Result; | |
fbf5a39b AC |
297 | pragma Warnings (Off, Result); |
298 | ||
38cbfe40 RK |
299 | begin |
300 | Result := Process (N); | |
301 | end Process; | |
302 | ||
303 | function Process (N : Node_Id) return Traverse_Result is | |
304 | Result : Traverse_Result := OK; | |
305 | B : Node_Id; | |
306 | E : Entity_Id; | |
307 | ||
308 | begin | |
309 | case Nkind (N) is | |
d8f43ee6 HK |
310 | when N_Generic_Declaration'Range |
311 | | N_Pragma | |
312 | | N_Subprogram_Body_Stub | |
313 | | N_Subprogram_Declaration | |
314 | => | |
38cbfe40 RK |
315 | Result := Skip; |
316 | ||
317 | when N_Subprogram_Body => | |
318 | if not Marked (Marks, Spec_Of (N)) then | |
319 | Result := Skip; | |
320 | end if; | |
321 | ||
322 | when N_Package_Body_Stub => | |
323 | if Present (Library_Unit (N)) then | |
324 | Traverse (Proper_Body (Unit (Library_Unit (N)))); | |
325 | end if; | |
326 | ||
d8f43ee6 HK |
327 | when N_Expanded_Name |
328 | | N_Identifier | |
329 | | N_Operator_Symbol | |
330 | => | |
38cbfe40 RK |
331 | E := Entity (N); |
332 | ||
333 | if E /= Empty and then not Marked (Marks, E) then | |
334 | Process (E); | |
335 | ||
336 | if Is_Subprogram (E) then | |
337 | B := Body_Of (E); | |
338 | ||
339 | if B /= Empty then | |
340 | Traverse (B); | |
341 | end if; | |
342 | end if; | |
343 | end if; | |
344 | ||
345 | when N_Entity'Range => | |
346 | if (Ekind (N) = E_Component) and then not Marked (Marks, N) then | |
347 | if Present (Discriminant_Checking_Func (N)) then | |
348 | Process (Discriminant_Checking_Func (N)); | |
349 | end if; | |
350 | end if; | |
351 | ||
352 | Set_Marked (Marks, N); | |
353 | ||
354 | when others => | |
355 | null; | |
356 | end case; | |
357 | ||
358 | return Result; | |
359 | end Process; | |
360 | ||
361 | -- Start of processing for Trace_Marked | |
362 | ||
363 | begin | |
364 | Traverse (Root); | |
365 | end Trace_Marked; | |
366 | ||
367 | end Live; |