]>
Commit | Line | Data |
---|---|---|
38cbfe40 RK |
1 | ------------------------------------------------------------------------------ |
2 | -- -- | |
3 | -- GNAT COMPILER COMPONENTS -- | |
4 | -- -- | |
5 | -- I N L I N E -- | |
6 | -- -- | |
7 | -- B o d y -- | |
8 | -- -- | |
fbf5a39b | 9 | -- Copyright (C) 1992-2003 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- -- | |
13 | -- ware Foundation; either version 2, or (at your option) any later ver- -- | |
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 -- | |
18 | -- Public License distributed with GNAT; see file COPYING. If not, write -- | |
19 | -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, -- | |
20 | -- MA 02111-1307, USA. -- | |
21 | -- -- | |
22 | -- GNAT was originally developed by the GNAT team at New York University. -- | |
71ff80dc | 23 | -- Extensive contributions were provided by Ada Core Technologies Inc. -- |
38cbfe40 RK |
24 | -- -- |
25 | ------------------------------------------------------------------------------ | |
26 | ||
27 | with Atree; use Atree; | |
28 | with Einfo; use Einfo; | |
29 | with Elists; use Elists; | |
30 | with Errout; use Errout; | |
31 | with Exp_Ch7; use Exp_Ch7; | |
32 | with Exp_Ch11; use Exp_Ch11; | |
33 | with Exp_Tss; use Exp_Tss; | |
34 | with Fname; use Fname; | |
35 | with Fname.UF; use Fname.UF; | |
36 | with Lib; use Lib; | |
37 | with Nlists; use Nlists; | |
38 | with Opt; use Opt; | |
39 | with Sem_Ch8; use Sem_Ch8; | |
40 | with Sem_Ch10; use Sem_Ch10; | |
41 | with Sem_Ch12; use Sem_Ch12; | |
42 | with Sem_Util; use Sem_Util; | |
43 | with Sinfo; use Sinfo; | |
44 | with Snames; use Snames; | |
45 | with Stand; use Stand; | |
46 | with Uname; use Uname; | |
47 | ||
48 | package body Inline is | |
49 | ||
50 | -------------------- | |
51 | -- Inlined Bodies -- | |
52 | -------------------- | |
53 | ||
54 | -- Inlined functions are actually placed in line by the backend if the | |
55 | -- corresponding bodies are available (i.e. compiled). Whenever we find | |
56 | -- a call to an inlined subprogram, we add the name of the enclosing | |
57 | -- compilation unit to a worklist. After all compilation, and after | |
58 | -- expansion of generic bodies, we traverse the list of pending bodies | |
59 | -- and compile them as well. | |
60 | ||
61 | package Inlined_Bodies is new Table.Table ( | |
62 | Table_Component_Type => Entity_Id, | |
63 | Table_Index_Type => Int, | |
64 | Table_Low_Bound => 0, | |
65 | Table_Initial => Alloc.Inlined_Bodies_Initial, | |
66 | Table_Increment => Alloc.Inlined_Bodies_Increment, | |
67 | Table_Name => "Inlined_Bodies"); | |
68 | ||
69 | ----------------------- | |
70 | -- Inline Processing -- | |
71 | ----------------------- | |
72 | ||
73 | -- For each call to an inlined subprogram, we make entries in a table | |
74 | -- that stores caller and callee, and indicates a prerequisite from | |
75 | -- one to the other. We also record the compilation unit that contains | |
76 | -- the callee. After analyzing the bodies of all such compilation units, | |
77 | -- we produce a list of subprograms in topological order, for use by the | |
78 | -- back-end. If P2 is a prerequisite of P1, then P1 calls P2, and for | |
79 | -- proper inlining the back-end must analyze the body of P2 before that of | |
80 | -- P1. The code below guarantees that the transitive closure of inlined | |
81 | -- subprograms called from the main compilation unit is made available to | |
82 | -- the code generator. | |
83 | ||
84 | Last_Inlined : Entity_Id := Empty; | |
85 | ||
86 | -- For each entry in the table we keep a list of successors in topological | |
87 | -- order, i.e. callers of the current subprogram. | |
88 | ||
89 | type Subp_Index is new Nat; | |
90 | No_Subp : constant Subp_Index := 0; | |
91 | ||
92 | -- The subprogram entities are hashed into the Inlined table. | |
93 | ||
94 | Num_Hash_Headers : constant := 512; | |
95 | ||
96 | Hash_Headers : array (Subp_Index range 0 .. Num_Hash_Headers - 1) | |
97 | of Subp_Index; | |
98 | ||
99 | type Succ_Index is new Nat; | |
100 | No_Succ : constant Succ_Index := 0; | |
101 | ||
102 | type Succ_Info is record | |
103 | Subp : Subp_Index; | |
104 | Next : Succ_Index; | |
105 | end record; | |
106 | ||
107 | -- The following table stores list elements for the successor lists. | |
108 | -- These lists cannot be chained directly through entries in the Inlined | |
109 | -- table, because a given subprogram can appear in several such lists. | |
110 | ||
111 | package Successors is new Table.Table ( | |
112 | Table_Component_Type => Succ_Info, | |
113 | Table_Index_Type => Succ_Index, | |
114 | Table_Low_Bound => 1, | |
115 | Table_Initial => Alloc.Successors_Initial, | |
116 | Table_Increment => Alloc.Successors_Increment, | |
117 | Table_Name => "Successors"); | |
118 | ||
119 | type Subp_Info is record | |
120 | Name : Entity_Id := Empty; | |
121 | First_Succ : Succ_Index := No_Succ; | |
122 | Count : Integer := 0; | |
123 | Listed : Boolean := False; | |
124 | Main_Call : Boolean := False; | |
125 | Next : Subp_Index := No_Subp; | |
126 | Next_Nopred : Subp_Index := No_Subp; | |
127 | end record; | |
128 | ||
129 | package Inlined is new Table.Table ( | |
130 | Table_Component_Type => Subp_Info, | |
131 | Table_Index_Type => Subp_Index, | |
132 | Table_Low_Bound => 1, | |
133 | Table_Initial => Alloc.Inlined_Initial, | |
134 | Table_Increment => Alloc.Inlined_Increment, | |
135 | Table_Name => "Inlined"); | |
136 | ||
137 | ----------------------- | |
138 | -- Local Subprograms -- | |
139 | ----------------------- | |
140 | ||
141 | function Scope_In_Main_Unit (Scop : Entity_Id) return Boolean; | |
142 | -- Return True if Scop is in the main unit or its spec, or in a | |
143 | -- parent of the main unit if it is a child unit. | |
144 | ||
145 | procedure Add_Call (Called : Entity_Id; Caller : Entity_Id := Empty); | |
146 | -- Make two entries in Inlined table, for an inlined subprogram being | |
147 | -- called, and for the inlined subprogram that contains the call. If | |
148 | -- the call is in the main compilation unit, Caller is Empty. | |
149 | ||
150 | function Add_Subp (E : Entity_Id) return Subp_Index; | |
151 | -- Make entry in Inlined table for subprogram E, or return table index | |
152 | -- that already holds E. | |
153 | ||
154 | function Has_Initialized_Type (E : Entity_Id) return Boolean; | |
155 | -- If a candidate for inlining contains type declarations for types with | |
156 | -- non-trivial initialization procedures, they are not worth inlining. | |
157 | ||
158 | function Is_Nested (E : Entity_Id) return Boolean; | |
159 | -- If the function is nested inside some other function, it will | |
160 | -- always be compiled if that function is, so don't add it to the | |
161 | -- inline list. We cannot compile a nested function outside the | |
162 | -- scope of the containing function anyway. This is also the case if | |
163 | -- the function is defined in a task body or within an entry (for | |
164 | -- example, an initialization procedure). | |
165 | ||
166 | procedure Add_Inlined_Subprogram (Index : Subp_Index); | |
167 | -- Add subprogram to Inlined List once all of its predecessors have been | |
168 | -- placed on the list. Decrement the count of all its successors, and | |
169 | -- add them to list (recursively) if count drops to zero. | |
170 | ||
171 | ------------------------------ | |
172 | -- Deferred Cleanup Actions -- | |
173 | ------------------------------ | |
174 | ||
175 | -- The cleanup actions for scopes that contain instantiations is delayed | |
176 | -- until after expansion of those instantiations, because they may | |
177 | -- contain finalizable objects or tasks that affect the cleanup code. | |
178 | -- A scope that contains instantiations only needs to be finalized once, | |
179 | -- even if it contains more than one instance. We keep a list of scopes | |
180 | -- that must still be finalized, and call cleanup_actions after all the | |
181 | -- instantiations have been completed. | |
182 | ||
183 | To_Clean : Elist_Id; | |
184 | ||
185 | procedure Add_Scope_To_Clean (Inst : Entity_Id); | |
186 | -- Build set of scopes on which cleanup actions must be performed. | |
187 | ||
188 | procedure Cleanup_Scopes; | |
189 | -- Complete cleanup actions on scopes that need it. | |
190 | ||
191 | -------------- | |
192 | -- Add_Call -- | |
193 | -------------- | |
194 | ||
195 | procedure Add_Call (Called : Entity_Id; Caller : Entity_Id := Empty) is | |
fbf5a39b | 196 | P1 : constant Subp_Index := Add_Subp (Called); |
38cbfe40 RK |
197 | P2 : Subp_Index; |
198 | J : Succ_Index; | |
199 | ||
200 | begin | |
201 | if Present (Caller) then | |
202 | P2 := Add_Subp (Caller); | |
203 | ||
204 | -- Add P2 to the list of successors of P1, if not already there. | |
205 | -- Note that P2 may contain more than one call to P1, and only | |
206 | -- one needs to be recorded. | |
207 | ||
208 | J := Inlined.Table (P1).First_Succ; | |
209 | ||
210 | while J /= No_Succ loop | |
211 | ||
212 | if Successors.Table (J).Subp = P2 then | |
213 | return; | |
214 | end if; | |
215 | ||
216 | J := Successors.Table (J).Next; | |
217 | end loop; | |
218 | ||
219 | -- On exit, make a successor entry for P2. | |
220 | ||
221 | Successors.Increment_Last; | |
222 | Successors.Table (Successors.Last).Subp := P2; | |
223 | Successors.Table (Successors.Last).Next := | |
224 | Inlined.Table (P1).First_Succ; | |
225 | Inlined.Table (P1).First_Succ := Successors.Last; | |
226 | ||
227 | Inlined.Table (P2).Count := Inlined.Table (P2).Count + 1; | |
228 | ||
229 | else | |
230 | Inlined.Table (P1).Main_Call := True; | |
231 | end if; | |
232 | end Add_Call; | |
233 | ||
234 | ---------------------- | |
235 | -- Add_Inlined_Body -- | |
236 | ---------------------- | |
237 | ||
238 | procedure Add_Inlined_Body (E : Entity_Id) is | |
239 | Pack : Entity_Id; | |
38cbfe40 RK |
240 | |
241 | function Must_Inline return Boolean; | |
242 | -- Inlining is only done if the call statement N is in the main unit, | |
243 | -- or within the body of another inlined subprogram. | |
244 | ||
fbf5a39b AC |
245 | ----------------- |
246 | -- Must_Inline -- | |
247 | ----------------- | |
248 | ||
38cbfe40 RK |
249 | function Must_Inline return Boolean is |
250 | Scop : Entity_Id := Current_Scope; | |
251 | Comp : Node_Id; | |
252 | ||
253 | begin | |
fbf5a39b | 254 | -- Check if call is in main unit |
38cbfe40 RK |
255 | |
256 | while Scope (Scop) /= Standard_Standard | |
257 | and then not Is_Child_Unit (Scop) | |
258 | loop | |
259 | Scop := Scope (Scop); | |
260 | end loop; | |
261 | ||
262 | Comp := Parent (Scop); | |
263 | ||
264 | while Nkind (Comp) /= N_Compilation_Unit loop | |
265 | Comp := Parent (Comp); | |
266 | end loop; | |
267 | ||
fbf5a39b AC |
268 | if Comp = Cunit (Main_Unit) |
269 | or else Comp = Library_Unit (Cunit (Main_Unit)) | |
38cbfe40 RK |
270 | then |
271 | Add_Call (E); | |
272 | return True; | |
273 | end if; | |
274 | ||
275 | -- Call is not in main unit. See if it's in some inlined | |
276 | -- subprogram. | |
277 | ||
278 | Scop := Current_Scope; | |
279 | while Scope (Scop) /= Standard_Standard | |
280 | and then not Is_Child_Unit (Scop) | |
281 | loop | |
282 | if Is_Overloadable (Scop) | |
283 | and then Is_Inlined (Scop) | |
284 | then | |
285 | Add_Call (E, Scop); | |
286 | return True; | |
287 | end if; | |
288 | ||
289 | Scop := Scope (Scop); | |
290 | end loop; | |
291 | ||
292 | return False; | |
293 | ||
294 | end Must_Inline; | |
295 | ||
296 | -- Start of processing for Add_Inlined_Body | |
297 | ||
298 | begin | |
299 | -- Find unit containing E, and add to list of inlined bodies if needed. | |
300 | -- If the body is already present, no need to load any other unit. This | |
301 | -- is the case for an initialization procedure, which appears in the | |
302 | -- package declaration that contains the type. It is also the case if | |
303 | -- the body has already been analyzed. Finally, if the unit enclosing | |
304 | -- E is an instance, the instance body will be analyzed in any case, | |
305 | -- and there is no need to add the enclosing unit (whose body might not | |
306 | -- be available). | |
307 | ||
308 | -- Library-level functions must be handled specially, because there is | |
309 | -- no enclosing package to retrieve. In this case, it is the body of | |
310 | -- the function that will have to be loaded. | |
311 | ||
312 | if not Is_Abstract (E) and then not Is_Nested (E) | |
313 | and then Convention (E) /= Convention_Protected | |
314 | then | |
315 | Pack := Scope (E); | |
316 | ||
317 | if Must_Inline | |
318 | and then Ekind (Pack) = E_Package | |
319 | then | |
320 | Set_Is_Called (E); | |
38cbfe40 RK |
321 | |
322 | if Pack = Standard_Standard then | |
323 | ||
324 | -- Library-level inlined function. Add function iself to | |
325 | -- list of needed units. | |
326 | ||
327 | Inlined_Bodies.Increment_Last; | |
328 | Inlined_Bodies.Table (Inlined_Bodies.Last) := E; | |
329 | ||
330 | elsif Is_Generic_Instance (Pack) then | |
331 | null; | |
332 | ||
333 | elsif not Is_Inlined (Pack) | |
334 | and then not Has_Completion (E) | |
335 | and then not Scope_In_Main_Unit (Pack) | |
336 | then | |
337 | Set_Is_Inlined (Pack); | |
338 | Inlined_Bodies.Increment_Last; | |
339 | Inlined_Bodies.Table (Inlined_Bodies.Last) := Pack; | |
340 | end if; | |
341 | end if; | |
342 | end if; | |
343 | end Add_Inlined_Body; | |
344 | ||
345 | ---------------------------- | |
346 | -- Add_Inlined_Subprogram -- | |
347 | ---------------------------- | |
348 | ||
349 | procedure Add_Inlined_Subprogram (Index : Subp_Index) is | |
350 | E : constant Entity_Id := Inlined.Table (Index).Name; | |
351 | Succ : Succ_Index; | |
352 | Subp : Subp_Index; | |
353 | ||
fbf5a39b AC |
354 | function Back_End_Cannot_Inline (Subp : Entity_Id) return Boolean; |
355 | -- There are various conditions under which back-end inlining cannot | |
356 | -- be done reliably: | |
357 | -- | |
358 | -- a) If a body has handlers, it must not be inlined, because this | |
359 | -- may violate program semantics, and because in zero-cost exception | |
360 | -- mode it will lead to undefined symbols at link time. | |
361 | -- | |
362 | -- b) If a body contains inlined function instances, it cannot be | |
363 | -- inlined under ZCX because the numerix suffix generated by gigi | |
364 | -- will be different in the body and the place of the inlined call. | |
365 | -- | |
366 | -- This procedure must be carefully coordinated with the back end | |
367 | ||
368 | ---------------------------- | |
369 | -- Back_End_Cannot_Inline -- | |
370 | ---------------------------- | |
371 | ||
372 | function Back_End_Cannot_Inline (Subp : Entity_Id) return Boolean is | |
373 | Decl : Node_Id := Unit_Declaration_Node (Subp); | |
374 | Body_Ent : Entity_Id; | |
375 | Ent : Entity_Id; | |
376 | ||
377 | begin | |
378 | if Nkind (Decl) = N_Subprogram_Declaration | |
379 | and then Present (Corresponding_Body (Decl)) | |
380 | then | |
381 | Body_Ent := Corresponding_Body (Decl); | |
382 | else | |
383 | return False; | |
384 | end if; | |
385 | ||
386 | -- If subprogram is marked Inline_Always, inlining is mandatory | |
387 | ||
388 | if Is_Always_Inlined (Subp) then | |
389 | return False; | |
390 | end if; | |
391 | ||
392 | if Present | |
393 | (Exception_Handlers | |
394 | (Handled_Statement_Sequence | |
395 | (Unit_Declaration_Node (Corresponding_Body (Decl))))) | |
396 | then | |
397 | return True; | |
398 | end if; | |
399 | ||
400 | Ent := First_Entity (Body_Ent); | |
401 | ||
402 | while Present (Ent) loop | |
403 | if Is_Subprogram (Ent) | |
404 | and then Is_Generic_Instance (Ent) | |
405 | then | |
406 | return True; | |
407 | end if; | |
408 | ||
409 | Next_Entity (Ent); | |
410 | end loop; | |
411 | return False; | |
412 | end Back_End_Cannot_Inline; | |
413 | ||
414 | -- Start of processing for Add_Inlined_Subprogram | |
415 | ||
38cbfe40 | 416 | begin |
fbf5a39b AC |
417 | -- Insert the current subprogram in the list of inlined subprograms, |
418 | -- if it can actually be inlined by the back-end. | |
38cbfe40 RK |
419 | |
420 | if not Scope_In_Main_Unit (E) | |
421 | and then Is_Inlined (E) | |
422 | and then not Is_Nested (E) | |
423 | and then not Has_Initialized_Type (E) | |
424 | then | |
fbf5a39b AC |
425 | if Back_End_Cannot_Inline (E) then |
426 | Set_Is_Inlined (E, False); | |
427 | ||
38cbfe40 | 428 | else |
fbf5a39b AC |
429 | if No (Last_Inlined) then |
430 | Set_First_Inlined_Subprogram (Cunit (Main_Unit), E); | |
431 | else | |
432 | Set_Next_Inlined_Subprogram (Last_Inlined, E); | |
433 | end if; | |
38cbfe40 | 434 | |
fbf5a39b AC |
435 | Last_Inlined := E; |
436 | end if; | |
38cbfe40 RK |
437 | end if; |
438 | ||
439 | Inlined.Table (Index).Listed := True; | |
440 | Succ := Inlined.Table (Index).First_Succ; | |
441 | ||
442 | while Succ /= No_Succ loop | |
443 | Subp := Successors.Table (Succ).Subp; | |
444 | Inlined.Table (Subp).Count := Inlined.Table (Subp).Count - 1; | |
445 | ||
446 | if Inlined.Table (Subp).Count = 0 then | |
447 | Add_Inlined_Subprogram (Subp); | |
448 | end if; | |
449 | ||
450 | Succ := Successors.Table (Succ).Next; | |
451 | end loop; | |
452 | end Add_Inlined_Subprogram; | |
453 | ||
454 | ------------------------ | |
455 | -- Add_Scope_To_Clean -- | |
456 | ------------------------ | |
457 | ||
458 | procedure Add_Scope_To_Clean (Inst : Entity_Id) is | |
fbf5a39b | 459 | Scop : constant Entity_Id := Enclosing_Dynamic_Scope (Inst); |
38cbfe40 | 460 | Elmt : Elmt_Id; |
38cbfe40 RK |
461 | |
462 | begin | |
463 | -- If the instance appears in a library-level package declaration, | |
464 | -- all finalization is global, and nothing needs doing here. | |
465 | ||
466 | if Scop = Standard_Standard then | |
467 | return; | |
468 | end if; | |
469 | ||
470 | Elmt := First_Elmt (To_Clean); | |
471 | ||
472 | while Present (Elmt) loop | |
473 | ||
474 | if Node (Elmt) = Scop then | |
475 | return; | |
476 | end if; | |
477 | ||
478 | Elmt := Next_Elmt (Elmt); | |
479 | end loop; | |
480 | ||
481 | Append_Elmt (Scop, To_Clean); | |
482 | end Add_Scope_To_Clean; | |
483 | ||
484 | -------------- | |
485 | -- Add_Subp -- | |
486 | -------------- | |
487 | ||
488 | function Add_Subp (E : Entity_Id) return Subp_Index is | |
489 | Index : Subp_Index := Subp_Index (E) mod Num_Hash_Headers; | |
490 | J : Subp_Index; | |
491 | ||
492 | procedure New_Entry; | |
493 | -- Initialize entry in Inlined table. | |
494 | ||
495 | procedure New_Entry is | |
496 | begin | |
497 | Inlined.Increment_Last; | |
498 | Inlined.Table (Inlined.Last).Name := E; | |
499 | Inlined.Table (Inlined.Last).First_Succ := No_Succ; | |
500 | Inlined.Table (Inlined.Last).Count := 0; | |
501 | Inlined.Table (Inlined.Last).Listed := False; | |
502 | Inlined.Table (Inlined.Last).Main_Call := False; | |
503 | Inlined.Table (Inlined.Last).Next := No_Subp; | |
504 | Inlined.Table (Inlined.Last).Next_Nopred := No_Subp; | |
505 | end New_Entry; | |
506 | ||
507 | -- Start of processing for Add_Subp | |
508 | ||
509 | begin | |
510 | if Hash_Headers (Index) = No_Subp then | |
511 | New_Entry; | |
512 | Hash_Headers (Index) := Inlined.Last; | |
513 | return Inlined.Last; | |
514 | ||
515 | else | |
516 | J := Hash_Headers (Index); | |
517 | ||
518 | while J /= No_Subp loop | |
519 | ||
520 | if Inlined.Table (J).Name = E then | |
521 | return J; | |
522 | else | |
523 | Index := J; | |
524 | J := Inlined.Table (J).Next; | |
525 | end if; | |
526 | end loop; | |
527 | ||
528 | -- On exit, subprogram was not found. Enter in table. Index is | |
529 | -- the current last entry on the hash chain. | |
530 | ||
531 | New_Entry; | |
532 | Inlined.Table (Index).Next := Inlined.Last; | |
533 | return Inlined.Last; | |
534 | end if; | |
535 | end Add_Subp; | |
536 | ||
537 | ---------------------------- | |
538 | -- Analyze_Inlined_Bodies -- | |
539 | ---------------------------- | |
540 | ||
541 | procedure Analyze_Inlined_Bodies is | |
542 | Comp_Unit : Node_Id; | |
543 | J : Int; | |
544 | Pack : Entity_Id; | |
545 | S : Succ_Index; | |
546 | ||
547 | begin | |
548 | Analyzing_Inlined_Bodies := False; | |
549 | ||
07fc65c4 | 550 | if Serious_Errors_Detected = 0 then |
38cbfe40 RK |
551 | New_Scope (Standard_Standard); |
552 | ||
553 | J := 0; | |
554 | while J <= Inlined_Bodies.Last | |
07fc65c4 | 555 | and then Serious_Errors_Detected = 0 |
38cbfe40 RK |
556 | loop |
557 | Pack := Inlined_Bodies.Table (J); | |
558 | ||
559 | while Present (Pack) | |
560 | and then Scope (Pack) /= Standard_Standard | |
561 | and then not Is_Child_Unit (Pack) | |
562 | loop | |
563 | Pack := Scope (Pack); | |
564 | end loop; | |
565 | ||
566 | Comp_Unit := Parent (Pack); | |
567 | ||
568 | while Present (Comp_Unit) | |
569 | and then Nkind (Comp_Unit) /= N_Compilation_Unit | |
570 | loop | |
571 | Comp_Unit := Parent (Comp_Unit); | |
572 | end loop; | |
573 | ||
07fc65c4 GB |
574 | -- Load the body, unless it the main unit, or is an instance |
575 | -- whose body has already been analyzed. | |
576 | ||
38cbfe40 RK |
577 | if Present (Comp_Unit) |
578 | and then Comp_Unit /= Cunit (Main_Unit) | |
579 | and then Body_Required (Comp_Unit) | |
07fc65c4 GB |
580 | and then (Nkind (Unit (Comp_Unit)) /= N_Package_Declaration |
581 | or else No (Corresponding_Body (Unit (Comp_Unit)))) | |
38cbfe40 RK |
582 | then |
583 | declare | |
584 | Bname : constant Unit_Name_Type := | |
585 | Get_Body_Name (Get_Unit_Name (Unit (Comp_Unit))); | |
586 | ||
587 | OK : Boolean; | |
588 | ||
589 | begin | |
590 | if not Is_Loaded (Bname) then | |
591 | Load_Needed_Body (Comp_Unit, OK); | |
592 | ||
593 | if not OK then | |
594 | Error_Msg_Unit_1 := Bname; | |
595 | Error_Msg_N | |
596 | ("one or more inlined subprograms accessed in $!", | |
597 | Comp_Unit); | |
598 | Error_Msg_Name_1 := | |
599 | Get_File_Name (Bname, Subunit => False); | |
600 | Error_Msg_N ("\but file{ was not found!", Comp_Unit); | |
601 | raise Unrecoverable_Error; | |
602 | end if; | |
603 | end if; | |
604 | end; | |
605 | end if; | |
606 | ||
607 | J := J + 1; | |
608 | end loop; | |
609 | ||
610 | -- The analysis of required bodies may have produced additional | |
611 | -- generic instantiations. To obtain further inlining, we perform | |
612 | -- another round of generic body instantiations. Establishing a | |
613 | -- fully recursive loop between inlining and generic instantiations | |
614 | -- is unlikely to yield more than this one additional pass. | |
615 | ||
616 | Instantiate_Bodies; | |
617 | ||
618 | -- The list of inlined subprograms is an overestimate, because | |
619 | -- it includes inlined functions called from functions that are | |
620 | -- compiled as part of an inlined package, but are not themselves | |
621 | -- called. An accurate computation of just those subprograms that | |
622 | -- are needed requires that we perform a transitive closure over | |
623 | -- the call graph, starting from calls in the main program. Here | |
624 | -- we do one step of the inverse transitive closure, and reset | |
625 | -- the Is_Called flag on subprograms all of whose callers are not. | |
626 | ||
627 | for Index in Inlined.First .. Inlined.Last loop | |
628 | S := Inlined.Table (Index).First_Succ; | |
629 | ||
630 | if S /= No_Succ | |
631 | and then not Inlined.Table (Index).Main_Call | |
632 | then | |
633 | Set_Is_Called (Inlined.Table (Index).Name, False); | |
634 | ||
635 | while S /= No_Succ loop | |
636 | ||
637 | if Is_Called | |
638 | (Inlined.Table (Successors.Table (S).Subp).Name) | |
639 | or else Inlined.Table (Successors.Table (S).Subp).Main_Call | |
640 | then | |
641 | Set_Is_Called (Inlined.Table (Index).Name); | |
642 | exit; | |
643 | end if; | |
644 | ||
645 | S := Successors.Table (S).Next; | |
646 | end loop; | |
647 | end if; | |
648 | end loop; | |
649 | ||
650 | -- Now that the units are compiled, chain the subprograms within | |
651 | -- that are called and inlined. Produce list of inlined subprograms | |
652 | -- sorted in topological order. Start with all subprograms that | |
653 | -- have no prerequisites, i.e. inlined subprograms that do not call | |
654 | -- other inlined subprograms. | |
655 | ||
656 | for Index in Inlined.First .. Inlined.Last loop | |
657 | ||
658 | if Is_Called (Inlined.Table (Index).Name) | |
659 | and then Inlined.Table (Index).Count = 0 | |
660 | and then not Inlined.Table (Index).Listed | |
661 | then | |
662 | Add_Inlined_Subprogram (Index); | |
663 | end if; | |
664 | end loop; | |
665 | ||
666 | -- Because Add_Inlined_Subprogram treats recursively nodes that have | |
667 | -- no prerequisites left, at the end of the loop all subprograms | |
668 | -- must have been listed. If there are any unlisted subprograms | |
669 | -- left, there must be some recursive chains that cannot be inlined. | |
670 | ||
671 | for Index in Inlined.First .. Inlined.Last loop | |
672 | if Is_Called (Inlined.Table (Index).Name) | |
673 | and then Inlined.Table (Index).Count /= 0 | |
674 | and then not Is_Predefined_File_Name | |
675 | (Unit_File_Name | |
676 | (Get_Source_Unit (Inlined.Table (Index).Name))) | |
677 | then | |
678 | Error_Msg_N | |
679 | ("& cannot be inlined?", Inlined.Table (Index).Name); | |
680 | -- A warning on the first one might be sufficient. | |
681 | end if; | |
682 | end loop; | |
683 | ||
684 | Pop_Scope; | |
685 | end if; | |
686 | end Analyze_Inlined_Bodies; | |
687 | ||
688 | -------------------------------- | |
689 | -- Check_Body_For_Inlining -- | |
690 | -------------------------------- | |
691 | ||
692 | procedure Check_Body_For_Inlining (N : Node_Id; P : Entity_Id) is | |
693 | Bname : Unit_Name_Type; | |
694 | E : Entity_Id; | |
695 | OK : Boolean; | |
696 | ||
697 | begin | |
698 | if Is_Compilation_Unit (P) | |
699 | and then not Is_Generic_Instance (P) | |
700 | then | |
701 | Bname := Get_Body_Name (Get_Unit_Name (Unit (N))); | |
702 | E := First_Entity (P); | |
703 | ||
704 | while Present (E) loop | |
fbf5a39b AC |
705 | if Is_Always_Inlined (E) |
706 | or else (Front_End_Inlining and then Has_Pragma_Inline (E)) | |
707 | then | |
38cbfe40 RK |
708 | if not Is_Loaded (Bname) then |
709 | Load_Needed_Body (N, OK); | |
710 | ||
fbf5a39b AC |
711 | if OK then |
712 | ||
713 | -- Check that we are not trying to inline a parent | |
714 | -- whose body depends on a child, when we are compiling | |
715 | -- the body of the child. Otherwise we have a potential | |
716 | -- elaboration circularity with inlined subprograms and | |
717 | -- with Taft-Amendment types. | |
718 | ||
719 | declare | |
720 | Comp : Node_Id; -- Body just compiled | |
721 | Child_Spec : Entity_Id; -- Spec of main unit | |
722 | Ent : Entity_Id; -- For iteration | |
723 | With_Clause : Node_Id; -- Context of body. | |
724 | ||
725 | begin | |
726 | if Nkind (Unit (Cunit (Main_Unit))) = N_Package_Body | |
727 | and then Present (Body_Entity (P)) | |
728 | then | |
729 | Child_Spec := | |
730 | Defining_Entity ( | |
731 | (Unit (Library_Unit (Cunit (Main_Unit))))); | |
732 | ||
733 | Comp := | |
734 | Parent (Unit_Declaration_Node (Body_Entity (P))); | |
735 | ||
736 | With_Clause := First (Context_Items (Comp)); | |
737 | ||
738 | -- Check whether the context of the body just | |
739 | -- compiled includes a child of itself, and that | |
740 | -- child is the spec of the main compilation. | |
741 | ||
742 | while Present (With_Clause) loop | |
743 | if Nkind (With_Clause) = N_With_Clause | |
744 | and then | |
745 | Scope (Entity (Name (With_Clause))) = P | |
746 | and then | |
747 | Entity (Name (With_Clause)) = Child_Spec | |
748 | then | |
749 | Error_Msg_Node_2 := Child_Spec; | |
750 | Error_Msg_NE | |
751 | ("body of & depends on child unit&?", | |
752 | With_Clause, P); | |
753 | Error_Msg_N | |
754 | ("\subprograms in body cannot be inlined?", | |
755 | With_Clause); | |
756 | ||
757 | -- Disable further inlining from this unit, | |
758 | -- and keep Taft-amendment types incomplete. | |
759 | ||
760 | Ent := First_Entity (P); | |
761 | ||
762 | while Present (Ent) loop | |
763 | if Is_Type (Ent) | |
764 | and then Has_Completion_In_Body (Ent) | |
765 | then | |
766 | Set_Full_View (Ent, Empty); | |
767 | ||
768 | elsif Is_Subprogram (Ent) then | |
769 | Set_Is_Inlined (Ent, False); | |
770 | end if; | |
771 | ||
772 | Next_Entity (Ent); | |
773 | end loop; | |
774 | ||
775 | return; | |
776 | end if; | |
777 | ||
778 | Next (With_Clause); | |
779 | end loop; | |
780 | end if; | |
781 | end; | |
782 | ||
783 | elsif Ineffective_Inline_Warnings then | |
38cbfe40 RK |
784 | Error_Msg_Unit_1 := Bname; |
785 | Error_Msg_N | |
786 | ("unable to inline subprograms defined in $?", P); | |
787 | Error_Msg_N ("\body not found?", P); | |
788 | return; | |
789 | end if; | |
790 | end if; | |
791 | ||
792 | return; | |
793 | end if; | |
794 | ||
795 | Next_Entity (E); | |
796 | end loop; | |
797 | end if; | |
798 | end Check_Body_For_Inlining; | |
799 | ||
800 | -------------------- | |
801 | -- Cleanup_Scopes -- | |
802 | -------------------- | |
803 | ||
804 | procedure Cleanup_Scopes is | |
805 | Elmt : Elmt_Id; | |
806 | Decl : Node_Id; | |
807 | Scop : Entity_Id; | |
808 | ||
809 | begin | |
810 | Elmt := First_Elmt (To_Clean); | |
811 | ||
812 | while Present (Elmt) loop | |
813 | Scop := Node (Elmt); | |
814 | ||
815 | if Ekind (Scop) = E_Entry then | |
816 | Scop := Protected_Body_Subprogram (Scop); | |
fbf5a39b AC |
817 | |
818 | elsif Is_Subprogram (Scop) | |
819 | and then Is_Protected_Type (Scope (Scop)) | |
820 | and then Present (Protected_Body_Subprogram (Scop)) | |
821 | then | |
822 | -- If a protected operation contains an instance, its | |
823 | -- cleanup operations have been delayed, and the subprogram | |
824 | -- has been rewritten in the expansion of the enclosing | |
825 | -- protected body. It is the corresponding subprogram that | |
826 | -- may require the cleanup operations. | |
827 | ||
828 | Set_Uses_Sec_Stack | |
829 | (Protected_Body_Subprogram (Scop), | |
830 | Uses_Sec_Stack (Scop)); | |
831 | Scop := Protected_Body_Subprogram (Scop); | |
38cbfe40 RK |
832 | end if; |
833 | ||
834 | if Ekind (Scop) = E_Block then | |
57568d91 | 835 | Decl := Parent (Block_Node (Scop)); |
38cbfe40 RK |
836 | |
837 | else | |
838 | Decl := Unit_Declaration_Node (Scop); | |
839 | ||
840 | if Nkind (Decl) = N_Subprogram_Declaration | |
841 | or else Nkind (Decl) = N_Task_Type_Declaration | |
842 | or else Nkind (Decl) = N_Subprogram_Body_Stub | |
843 | then | |
844 | Decl := Unit_Declaration_Node (Corresponding_Body (Decl)); | |
845 | end if; | |
846 | end if; | |
847 | ||
848 | New_Scope (Scop); | |
849 | Expand_Cleanup_Actions (Decl); | |
850 | End_Scope; | |
851 | ||
852 | Elmt := Next_Elmt (Elmt); | |
853 | end loop; | |
854 | end Cleanup_Scopes; | |
855 | ||
856 | -------------------------- | |
857 | -- Has_Initialized_Type -- | |
858 | -------------------------- | |
859 | ||
860 | function Has_Initialized_Type (E : Entity_Id) return Boolean is | |
861 | E_Body : constant Node_Id := Get_Subprogram_Body (E); | |
862 | Decl : Node_Id; | |
863 | ||
864 | begin | |
865 | if No (E_Body) then -- imported subprogram | |
866 | return False; | |
867 | ||
868 | else | |
869 | Decl := First (Declarations (E_Body)); | |
870 | ||
871 | while Present (Decl) loop | |
872 | ||
873 | if Nkind (Decl) = N_Full_Type_Declaration | |
874 | and then Present (Init_Proc (Defining_Identifier (Decl))) | |
875 | then | |
876 | return True; | |
877 | end if; | |
878 | ||
879 | Next (Decl); | |
880 | end loop; | |
881 | end if; | |
882 | ||
883 | return False; | |
884 | end Has_Initialized_Type; | |
885 | ||
886 | ---------------- | |
887 | -- Initialize -- | |
888 | ---------------- | |
889 | ||
890 | procedure Initialize is | |
891 | begin | |
892 | Analyzing_Inlined_Bodies := False; | |
893 | Pending_Descriptor.Init; | |
894 | Pending_Instantiations.Init; | |
895 | Inlined_Bodies.Init; | |
896 | Successors.Init; | |
897 | Inlined.Init; | |
898 | ||
899 | for J in Hash_Headers'Range loop | |
900 | Hash_Headers (J) := No_Subp; | |
901 | end loop; | |
902 | end Initialize; | |
903 | ||
904 | ------------------------ | |
905 | -- Instantiate_Bodies -- | |
906 | ------------------------ | |
907 | ||
908 | -- Generic bodies contain all the non-local references, so an | |
909 | -- instantiation does not need any more context than Standard | |
910 | -- itself, even if the instantiation appears in an inner scope. | |
911 | -- Generic associations have verified that the contract model is | |
912 | -- satisfied, so that any error that may occur in the analysis of | |
913 | -- the body is an internal error. | |
914 | ||
915 | procedure Instantiate_Bodies is | |
916 | J : Int; | |
917 | Info : Pending_Body_Info; | |
918 | ||
919 | begin | |
07fc65c4 | 920 | if Serious_Errors_Detected = 0 then |
38cbfe40 | 921 | |
fbf5a39b | 922 | Expander_Active := (Operating_Mode = Opt.Generate_Code); |
38cbfe40 RK |
923 | New_Scope (Standard_Standard); |
924 | To_Clean := New_Elmt_List; | |
925 | ||
926 | if Is_Generic_Unit (Cunit_Entity (Main_Unit)) then | |
927 | Start_Generic; | |
928 | end if; | |
929 | ||
930 | -- A body instantiation may generate additional instantiations, so | |
931 | -- the following loop must scan to the end of a possibly expanding | |
932 | -- set (that's why we can't simply use a FOR loop here). | |
933 | ||
934 | J := 0; | |
935 | ||
936 | while J <= Pending_Instantiations.Last | |
07fc65c4 | 937 | and then Serious_Errors_Detected = 0 |
38cbfe40 | 938 | loop |
38cbfe40 RK |
939 | Info := Pending_Instantiations.Table (J); |
940 | ||
fbf5a39b | 941 | -- If the instantiation node is absent, it has been removed |
38cbfe40 RK |
942 | -- as part of unreachable code. |
943 | ||
944 | if No (Info.Inst_Node) then | |
945 | null; | |
946 | ||
fbf5a39b | 947 | elsif Nkind (Info.Act_Decl) = N_Package_Declaration then |
38cbfe40 RK |
948 | Instantiate_Package_Body (Info); |
949 | Add_Scope_To_Clean (Defining_Entity (Info.Act_Decl)); | |
950 | ||
951 | else | |
952 | Instantiate_Subprogram_Body (Info); | |
953 | end if; | |
954 | ||
955 | J := J + 1; | |
956 | end loop; | |
957 | ||
958 | -- Reset the table of instantiations. Additional instantiations | |
959 | -- may be added through inlining, when additional bodies are | |
960 | -- analyzed. | |
961 | ||
962 | Pending_Instantiations.Init; | |
963 | ||
964 | -- We can now complete the cleanup actions of scopes that contain | |
965 | -- pending instantiations (skipped for generic units, since we | |
966 | -- never need any cleanups in generic units). | |
967 | -- pending instantiations. | |
968 | ||
969 | if Expander_Active | |
970 | and then not Is_Generic_Unit (Main_Unit_Entity) | |
971 | then | |
972 | Cleanup_Scopes; | |
973 | ||
974 | -- Also generate subprogram descriptors that were delayed | |
975 | ||
976 | for J in Pending_Descriptor.First .. Pending_Descriptor.Last loop | |
977 | declare | |
978 | Ent : constant Entity_Id := Pending_Descriptor.Table (J); | |
979 | ||
980 | begin | |
981 | if Is_Subprogram (Ent) then | |
982 | Generate_Subprogram_Descriptor_For_Subprogram | |
983 | (Get_Subprogram_Body (Ent), Ent); | |
984 | ||
985 | elsif Ekind (Ent) = E_Package then | |
986 | Generate_Subprogram_Descriptor_For_Package | |
987 | (Parent (Declaration_Node (Ent)), Ent); | |
988 | ||
989 | elsif Ekind (Ent) = E_Package_Body then | |
990 | Generate_Subprogram_Descriptor_For_Package | |
991 | (Declaration_Node (Ent), Ent); | |
992 | end if; | |
993 | end; | |
994 | end loop; | |
995 | ||
996 | elsif Is_Generic_Unit (Cunit_Entity (Main_Unit)) then | |
997 | End_Generic; | |
998 | end if; | |
999 | ||
1000 | Pop_Scope; | |
1001 | end if; | |
1002 | end Instantiate_Bodies; | |
1003 | ||
1004 | --------------- | |
1005 | -- Is_Nested -- | |
1006 | --------------- | |
1007 | ||
1008 | function Is_Nested (E : Entity_Id) return Boolean is | |
1009 | Scop : Entity_Id := Scope (E); | |
1010 | ||
1011 | begin | |
1012 | while Scop /= Standard_Standard loop | |
1013 | if Ekind (Scop) in Subprogram_Kind then | |
1014 | return True; | |
1015 | ||
1016 | elsif Ekind (Scop) = E_Task_Type | |
1017 | or else Ekind (Scop) = E_Entry | |
1018 | or else Ekind (Scop) = E_Entry_Family then | |
1019 | return True; | |
1020 | end if; | |
1021 | ||
1022 | Scop := Scope (Scop); | |
1023 | end loop; | |
1024 | ||
1025 | return False; | |
1026 | end Is_Nested; | |
1027 | ||
1028 | ---------- | |
1029 | -- Lock -- | |
1030 | ---------- | |
1031 | ||
1032 | procedure Lock is | |
1033 | begin | |
1034 | Pending_Instantiations.Locked := True; | |
1035 | Inlined_Bodies.Locked := True; | |
1036 | Successors.Locked := True; | |
1037 | Inlined.Locked := True; | |
1038 | Pending_Instantiations.Release; | |
1039 | Inlined_Bodies.Release; | |
1040 | Successors.Release; | |
1041 | Inlined.Release; | |
1042 | end Lock; | |
1043 | ||
1044 | -------------------------- | |
1045 | -- Remove_Dead_Instance -- | |
1046 | -------------------------- | |
1047 | ||
1048 | procedure Remove_Dead_Instance (N : Node_Id) is | |
1049 | J : Int; | |
1050 | ||
1051 | begin | |
1052 | J := 0; | |
1053 | ||
1054 | while J <= Pending_Instantiations.Last loop | |
1055 | ||
1056 | if Pending_Instantiations.Table (J).Inst_Node = N then | |
1057 | Pending_Instantiations.Table (J).Inst_Node := Empty; | |
1058 | return; | |
1059 | end if; | |
1060 | ||
1061 | J := J + 1; | |
1062 | end loop; | |
1063 | end Remove_Dead_Instance; | |
1064 | ||
1065 | ------------------------ | |
1066 | -- Scope_In_Main_Unit -- | |
1067 | ------------------------ | |
1068 | ||
1069 | function Scope_In_Main_Unit (Scop : Entity_Id) return Boolean is | |
1070 | Comp : Node_Id; | |
1071 | S : Entity_Id := Scop; | |
1072 | Ent : Entity_Id := Cunit_Entity (Main_Unit); | |
1073 | ||
1074 | begin | |
1075 | -- The scope may be within the main unit, or it may be an ancestor | |
1076 | -- of the main unit, if the main unit is a child unit. In both cases | |
1077 | -- it makes no sense to process the body before the main unit. In | |
1078 | -- the second case, this may lead to circularities if a parent body | |
1079 | -- depends on a child spec, and we are analyzing the child. | |
1080 | ||
1081 | while Scope (S) /= Standard_Standard | |
1082 | and then not Is_Child_Unit (S) | |
1083 | loop | |
1084 | S := Scope (S); | |
1085 | end loop; | |
1086 | ||
1087 | Comp := Parent (S); | |
1088 | ||
1089 | while Present (Comp) | |
1090 | and then Nkind (Comp) /= N_Compilation_Unit | |
1091 | loop | |
1092 | Comp := Parent (Comp); | |
1093 | end loop; | |
1094 | ||
1095 | if Is_Child_Unit (Ent) then | |
1096 | ||
1097 | while Present (Ent) | |
1098 | and then Is_Child_Unit (Ent) | |
1099 | loop | |
1100 | if Scope (Ent) = S then | |
1101 | return True; | |
1102 | end if; | |
1103 | ||
1104 | Ent := Scope (Ent); | |
1105 | end loop; | |
1106 | end if; | |
1107 | ||
1108 | return | |
1109 | Comp = Cunit (Main_Unit) | |
1110 | or else Comp = Library_Unit (Cunit (Main_Unit)); | |
1111 | end Scope_In_Main_Unit; | |
1112 | ||
1113 | end Inline; |