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