]>
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 | -- -- | |
d2b10647 | 9 | -- Copyright (C) 1992-2011, 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 | ||
344 | elsif not Is_Inlined (Pack) | |
d2b10647 ES |
345 | and then |
346 | (not Has_Completion (E) | |
afc8324d | 347 | or else Is_Expression_Function (E)) |
f8726f2b AC |
348 | then |
349 | Set_Is_Inlined (Pack); | |
350 | Inlined_Bodies.Increment_Last; | |
351 | Inlined_Bodies.Table (Inlined_Bodies.Last) := Pack; | |
352 | end if; | |
38cbfe40 | 353 | end if; |
f8726f2b | 354 | end; |
38cbfe40 RK |
355 | end if; |
356 | end Add_Inlined_Body; | |
357 | ||
358 | ---------------------------- | |
359 | -- Add_Inlined_Subprogram -- | |
360 | ---------------------------- | |
361 | ||
362 | procedure Add_Inlined_Subprogram (Index : Subp_Index) is | |
363 | E : constant Entity_Id := Inlined.Table (Index).Name; | |
feecad68 | 364 | Pack : constant Entity_Id := Get_Code_Unit_Entity (E); |
38cbfe40 RK |
365 | Succ : Succ_Index; |
366 | Subp : Subp_Index; | |
367 | ||
fbf5a39b AC |
368 | function Back_End_Cannot_Inline (Subp : Entity_Id) return Boolean; |
369 | -- There are various conditions under which back-end inlining cannot | |
370 | -- be done reliably: | |
371 | -- | |
372 | -- a) If a body has handlers, it must not be inlined, because this | |
373 | -- may violate program semantics, and because in zero-cost exception | |
374 | -- mode it will lead to undefined symbols at link time. | |
375 | -- | |
376 | -- b) If a body contains inlined function instances, it cannot be | |
dec55d76 | 377 | -- inlined under ZCX because the numeric suffix generated by gigi |
fbf5a39b AC |
378 | -- will be different in the body and the place of the inlined call. |
379 | -- | |
46ff89f3 | 380 | -- This procedure must be carefully coordinated with the back end. |
fbf5a39b AC |
381 | |
382 | ---------------------------- | |
383 | -- Back_End_Cannot_Inline -- | |
384 | ---------------------------- | |
385 | ||
386 | function Back_End_Cannot_Inline (Subp : Entity_Id) return Boolean is | |
91b1417d | 387 | Decl : constant Node_Id := Unit_Declaration_Node (Subp); |
fbf5a39b AC |
388 | Body_Ent : Entity_Id; |
389 | Ent : Entity_Id; | |
390 | ||
391 | begin | |
392 | if Nkind (Decl) = N_Subprogram_Declaration | |
393 | and then Present (Corresponding_Body (Decl)) | |
394 | then | |
395 | Body_Ent := Corresponding_Body (Decl); | |
396 | else | |
397 | return False; | |
398 | end if; | |
399 | ||
400 | -- If subprogram is marked Inline_Always, inlining is mandatory | |
401 | ||
800621e0 | 402 | if Has_Pragma_Inline_Always (Subp) then |
fbf5a39b AC |
403 | return False; |
404 | end if; | |
405 | ||
406 | if Present | |
407 | (Exception_Handlers | |
408 | (Handled_Statement_Sequence | |
46ff89f3 | 409 | (Unit_Declaration_Node (Corresponding_Body (Decl))))) |
fbf5a39b AC |
410 | then |
411 | return True; | |
412 | end if; | |
413 | ||
414 | Ent := First_Entity (Body_Ent); | |
fbf5a39b AC |
415 | while Present (Ent) loop |
416 | if Is_Subprogram (Ent) | |
417 | and then Is_Generic_Instance (Ent) | |
418 | then | |
419 | return True; | |
420 | end if; | |
421 | ||
422 | Next_Entity (Ent); | |
423 | end loop; | |
46ff89f3 | 424 | |
5daed84a | 425 | return False; |
fbf5a39b AC |
426 | end Back_End_Cannot_Inline; |
427 | ||
428 | -- Start of processing for Add_Inlined_Subprogram | |
429 | ||
38cbfe40 | 430 | begin |
1237d6ef AC |
431 | -- Insert the current subprogram in the list of inlined subprograms, if |
432 | -- it can actually be inlined by the back-end, and if its unit is known | |
433 | -- to be inlined, or is an instance whose body will be analyzed anyway. | |
38cbfe40 | 434 | |
1237d6ef AC |
435 | if (Is_Inlined (Pack) or else Is_Generic_Instance (Pack)) |
436 | and then not Scope_In_Main_Unit (E) | |
38cbfe40 RK |
437 | and then Is_Inlined (E) |
438 | and then not Is_Nested (E) | |
439 | and then not Has_Initialized_Type (E) | |
440 | then | |
fbf5a39b AC |
441 | if Back_End_Cannot_Inline (E) then |
442 | Set_Is_Inlined (E, False); | |
443 | ||
38cbfe40 | 444 | else |
fbf5a39b AC |
445 | if No (Last_Inlined) then |
446 | Set_First_Inlined_Subprogram (Cunit (Main_Unit), E); | |
447 | else | |
448 | Set_Next_Inlined_Subprogram (Last_Inlined, E); | |
449 | end if; | |
38cbfe40 | 450 | |
fbf5a39b AC |
451 | Last_Inlined := E; |
452 | end if; | |
38cbfe40 RK |
453 | end if; |
454 | ||
455 | Inlined.Table (Index).Listed := True; | |
38cbfe40 | 456 | |
f8b86c2d AC |
457 | -- Now add to the list those callers of the current subprogram that |
458 | -- are themselves called. They may appear on the graph as callers | |
459 | -- of the current one, even if they are themselves not called, and | |
460 | -- there is no point in including them in the list for the backend. | |
461 | -- Furthermore, they might not even be public, in which case the | |
462 | -- back-end cannot handle them at all. | |
463 | ||
46ff89f3 | 464 | Succ := Inlined.Table (Index).First_Succ; |
38cbfe40 RK |
465 | while Succ /= No_Succ loop |
466 | Subp := Successors.Table (Succ).Subp; | |
467 | Inlined.Table (Subp).Count := Inlined.Table (Subp).Count - 1; | |
468 | ||
f8b86c2d AC |
469 | if Inlined.Table (Subp).Count = 0 |
470 | and then Is_Called (Inlined.Table (Subp).Name) | |
471 | then | |
38cbfe40 RK |
472 | Add_Inlined_Subprogram (Subp); |
473 | end if; | |
474 | ||
475 | Succ := Successors.Table (Succ).Next; | |
476 | end loop; | |
477 | end Add_Inlined_Subprogram; | |
478 | ||
479 | ------------------------ | |
480 | -- Add_Scope_To_Clean -- | |
481 | ------------------------ | |
482 | ||
483 | procedure Add_Scope_To_Clean (Inst : Entity_Id) is | |
fbf5a39b | 484 | Scop : constant Entity_Id := Enclosing_Dynamic_Scope (Inst); |
38cbfe40 | 485 | Elmt : Elmt_Id; |
38cbfe40 RK |
486 | |
487 | begin | |
488 | -- If the instance appears in a library-level package declaration, | |
489 | -- all finalization is global, and nothing needs doing here. | |
490 | ||
491 | if Scop = Standard_Standard then | |
492 | return; | |
493 | end if; | |
494 | ||
0fb2ea01 AC |
495 | -- If the instance appears within a generic subprogram there is nothing |
496 | -- to finalize either. | |
497 | ||
498 | declare | |
499 | S : Entity_Id; | |
5132708f | 500 | |
0fb2ea01 AC |
501 | begin |
502 | S := Scope (Inst); | |
503 | while Present (S) and then S /= Standard_Standard loop | |
504 | if Is_Generic_Subprogram (S) then | |
505 | return; | |
506 | end if; | |
507 | ||
508 | S := Scope (S); | |
509 | end loop; | |
510 | end; | |
511 | ||
38cbfe40 | 512 | Elmt := First_Elmt (To_Clean); |
38cbfe40 | 513 | while Present (Elmt) loop |
38cbfe40 RK |
514 | if Node (Elmt) = Scop then |
515 | return; | |
516 | end if; | |
517 | ||
518 | Elmt := Next_Elmt (Elmt); | |
519 | end loop; | |
520 | ||
521 | Append_Elmt (Scop, To_Clean); | |
522 | end Add_Scope_To_Clean; | |
523 | ||
524 | -------------- | |
525 | -- Add_Subp -- | |
526 | -------------- | |
527 | ||
528 | function Add_Subp (E : Entity_Id) return Subp_Index is | |
529 | Index : Subp_Index := Subp_Index (E) mod Num_Hash_Headers; | |
530 | J : Subp_Index; | |
531 | ||
532 | procedure New_Entry; | |
9de61fcb | 533 | -- Initialize entry in Inlined table |
38cbfe40 RK |
534 | |
535 | procedure New_Entry is | |
536 | begin | |
537 | Inlined.Increment_Last; | |
538 | Inlined.Table (Inlined.Last).Name := E; | |
539 | Inlined.Table (Inlined.Last).First_Succ := No_Succ; | |
540 | Inlined.Table (Inlined.Last).Count := 0; | |
541 | Inlined.Table (Inlined.Last).Listed := False; | |
542 | Inlined.Table (Inlined.Last).Main_Call := False; | |
543 | Inlined.Table (Inlined.Last).Next := No_Subp; | |
544 | Inlined.Table (Inlined.Last).Next_Nopred := No_Subp; | |
545 | end New_Entry; | |
546 | ||
547 | -- Start of processing for Add_Subp | |
548 | ||
549 | begin | |
550 | if Hash_Headers (Index) = No_Subp then | |
551 | New_Entry; | |
552 | Hash_Headers (Index) := Inlined.Last; | |
553 | return Inlined.Last; | |
554 | ||
555 | else | |
556 | J := Hash_Headers (Index); | |
38cbfe40 | 557 | while J /= No_Subp loop |
38cbfe40 RK |
558 | if Inlined.Table (J).Name = E then |
559 | return J; | |
560 | else | |
561 | Index := J; | |
562 | J := Inlined.Table (J).Next; | |
563 | end if; | |
564 | end loop; | |
565 | ||
566 | -- On exit, subprogram was not found. Enter in table. Index is | |
567 | -- the current last entry on the hash chain. | |
568 | ||
569 | New_Entry; | |
570 | Inlined.Table (Index).Next := Inlined.Last; | |
571 | return Inlined.Last; | |
572 | end if; | |
573 | end Add_Subp; | |
574 | ||
575 | ---------------------------- | |
576 | -- Analyze_Inlined_Bodies -- | |
577 | ---------------------------- | |
578 | ||
579 | procedure Analyze_Inlined_Bodies is | |
580 | Comp_Unit : Node_Id; | |
581 | J : Int; | |
582 | Pack : Entity_Id; | |
583 | S : Succ_Index; | |
584 | ||
92cbddaa | 585 | function Is_Ancestor_Of_Main |
1237d6ef AC |
586 | (U_Name : Entity_Id; |
587 | Nam : Node_Id) return Boolean; | |
588 | -- Determine whether the unit whose body is loaded is an ancestor of | |
92cbddaa | 589 | -- the main unit, and has a with_clause on it. The body is not |
1237d6ef AC |
590 | -- analyzed yet, so the check is purely lexical: the name of the with |
591 | -- clause is a selected component, and names of ancestors must match. | |
592 | ||
92cbddaa AC |
593 | ------------------------- |
594 | -- Is_Ancestor_Of_Main -- | |
595 | ------------------------- | |
1237d6ef | 596 | |
92cbddaa | 597 | function Is_Ancestor_Of_Main |
1237d6ef AC |
598 | (U_Name : Entity_Id; |
599 | Nam : Node_Id) return Boolean | |
600 | is | |
601 | Pref : Node_Id; | |
602 | ||
603 | begin | |
604 | if Nkind (Nam) /= N_Selected_Component then | |
605 | return False; | |
606 | ||
607 | else | |
92cbddaa AC |
608 | if Chars (Selector_Name (Nam)) /= |
609 | Chars (Cunit_Entity (Main_Unit)) | |
610 | then | |
611 | return False; | |
612 | end if; | |
613 | ||
1237d6ef AC |
614 | Pref := Prefix (Nam); |
615 | if Nkind (Pref) = N_Identifier then | |
616 | ||
617 | -- Par is an ancestor of Par.Child. | |
618 | ||
619 | return Chars (Pref) = Chars (U_Name); | |
620 | ||
621 | elsif Nkind (Pref) = N_Selected_Component | |
622 | and then Chars (Selector_Name (Pref)) = Chars (U_Name) | |
623 | then | |
624 | -- Par.Child is an ancestor of Par.Child.Grand. | |
625 | ||
626 | return True; -- should check that ancestor match | |
627 | ||
628 | else | |
629 | -- A is an ancestor of A.B.C if it is an ancestor of A.B | |
630 | ||
92cbddaa | 631 | return Is_Ancestor_Of_Main (U_Name, Pref); |
1237d6ef AC |
632 | end if; |
633 | end if; | |
92cbddaa | 634 | end Is_Ancestor_Of_Main; |
1237d6ef AC |
635 | |
636 | -- Start of processing for Analyze_Inlined_Bodies | |
637 | ||
38cbfe40 RK |
638 | begin |
639 | Analyzing_Inlined_Bodies := False; | |
640 | ||
07fc65c4 | 641 | if Serious_Errors_Detected = 0 then |
a99ada67 | 642 | Push_Scope (Standard_Standard); |
38cbfe40 RK |
643 | |
644 | J := 0; | |
645 | while J <= Inlined_Bodies.Last | |
07fc65c4 | 646 | and then Serious_Errors_Detected = 0 |
38cbfe40 RK |
647 | loop |
648 | Pack := Inlined_Bodies.Table (J); | |
38cbfe40 RK |
649 | while Present (Pack) |
650 | and then Scope (Pack) /= Standard_Standard | |
651 | and then not Is_Child_Unit (Pack) | |
652 | loop | |
653 | Pack := Scope (Pack); | |
654 | end loop; | |
655 | ||
656 | Comp_Unit := Parent (Pack); | |
38cbfe40 RK |
657 | while Present (Comp_Unit) |
658 | and then Nkind (Comp_Unit) /= N_Compilation_Unit | |
659 | loop | |
660 | Comp_Unit := Parent (Comp_Unit); | |
661 | end loop; | |
662 | ||
1237d6ef AC |
663 | -- Load the body, unless it the main unit, or is an instance whose |
664 | -- body has already been analyzed. | |
07fc65c4 | 665 | |
38cbfe40 RK |
666 | if Present (Comp_Unit) |
667 | and then Comp_Unit /= Cunit (Main_Unit) | |
668 | and then Body_Required (Comp_Unit) | |
07fc65c4 GB |
669 | and then (Nkind (Unit (Comp_Unit)) /= N_Package_Declaration |
670 | or else No (Corresponding_Body (Unit (Comp_Unit)))) | |
38cbfe40 RK |
671 | then |
672 | declare | |
673 | Bname : constant Unit_Name_Type := | |
674 | Get_Body_Name (Get_Unit_Name (Unit (Comp_Unit))); | |
675 | ||
676 | OK : Boolean; | |
677 | ||
678 | begin | |
679 | if not Is_Loaded (Bname) then | |
1237d6ef AC |
680 | Style_Check := False; |
681 | Load_Needed_Body (Comp_Unit, OK, Do_Analyze => False); | |
38cbfe40 RK |
682 | |
683 | if not OK then | |
46ff89f3 AC |
684 | |
685 | -- Warn that a body was not available for inlining | |
686 | -- by the back-end. | |
687 | ||
38cbfe40 RK |
688 | Error_Msg_Unit_1 := Bname; |
689 | Error_Msg_N | |
46ff89f3 | 690 | ("one or more inlined subprograms accessed in $!?", |
38cbfe40 | 691 | Comp_Unit); |
a99ada67 | 692 | Error_Msg_File_1 := |
38cbfe40 | 693 | Get_File_Name (Bname, Subunit => False); |
46ff89f3 | 694 | Error_Msg_N ("\but file{ was not found!?", Comp_Unit); |
1237d6ef AC |
695 | |
696 | else | |
697 | -- If the package to be inlined is an ancestor unit of | |
698 | -- the main unit, and it has a semantic dependence on | |
699 | -- it, the inlining cannot take place to prevent an | |
700 | -- elaboration circularity. The desired body is not | |
701 | -- analyzed yet, to prevent the completion of Taft | |
702 | -- amendment types that would lead to elaboration | |
703 | -- circularities in gigi. | |
704 | ||
705 | declare | |
706 | U_Id : constant Entity_Id := | |
707 | Defining_Entity (Unit (Comp_Unit)); | |
708 | Body_Unit : constant Node_Id := | |
709 | Library_Unit (Comp_Unit); | |
710 | Item : Node_Id; | |
711 | ||
712 | begin | |
713 | Item := First (Context_Items (Body_Unit)); | |
714 | while Present (Item) loop | |
715 | if Nkind (Item) = N_With_Clause | |
92cbddaa AC |
716 | and then |
717 | Is_Ancestor_Of_Main (U_Id, Name (Item)) | |
1237d6ef AC |
718 | then |
719 | Set_Is_Inlined (U_Id, False); | |
720 | exit; | |
721 | end if; | |
722 | ||
723 | Next (Item); | |
724 | end loop; | |
725 | ||
726 | -- If no suspicious with_clauses, analyze the body. | |
727 | ||
728 | if Is_Inlined (U_Id) then | |
729 | Semantics (Body_Unit); | |
730 | end if; | |
731 | end; | |
38cbfe40 RK |
732 | end if; |
733 | end if; | |
734 | end; | |
735 | end if; | |
736 | ||
737 | J := J + 1; | |
738 | end loop; | |
739 | ||
740 | -- The analysis of required bodies may have produced additional | |
741 | -- generic instantiations. To obtain further inlining, we perform | |
742 | -- another round of generic body instantiations. Establishing a | |
743 | -- fully recursive loop between inlining and generic instantiations | |
744 | -- is unlikely to yield more than this one additional pass. | |
745 | ||
746 | Instantiate_Bodies; | |
747 | ||
1237d6ef AC |
748 | -- The list of inlined subprograms is an overestimate, because it |
749 | -- includes inlined functions called from functions that are compiled | |
750 | -- as part of an inlined package, but are not themselves called. An | |
751 | -- accurate computation of just those subprograms that are needed | |
752 | -- requires that we perform a transitive closure over the call graph, | |
753 | -- starting from calls in the main program. Here we do one step of | |
754 | -- the inverse transitive closure, and reset the Is_Called flag on | |
755 | -- subprograms all of whose callers are not. | |
38cbfe40 RK |
756 | |
757 | for Index in Inlined.First .. Inlined.Last loop | |
758 | S := Inlined.Table (Index).First_Succ; | |
759 | ||
760 | if S /= No_Succ | |
761 | and then not Inlined.Table (Index).Main_Call | |
762 | then | |
763 | Set_Is_Called (Inlined.Table (Index).Name, False); | |
764 | ||
765 | while S /= No_Succ loop | |
38cbfe40 RK |
766 | if Is_Called |
767 | (Inlined.Table (Successors.Table (S).Subp).Name) | |
768 | or else Inlined.Table (Successors.Table (S).Subp).Main_Call | |
769 | then | |
770 | Set_Is_Called (Inlined.Table (Index).Name); | |
771 | exit; | |
772 | end if; | |
773 | ||
774 | S := Successors.Table (S).Next; | |
775 | end loop; | |
776 | end if; | |
777 | end loop; | |
778 | ||
779 | -- Now that the units are compiled, chain the subprograms within | |
780 | -- that are called and inlined. Produce list of inlined subprograms | |
781 | -- sorted in topological order. Start with all subprograms that | |
782 | -- have no prerequisites, i.e. inlined subprograms that do not call | |
783 | -- other inlined subprograms. | |
784 | ||
785 | for Index in Inlined.First .. Inlined.Last loop | |
786 | ||
787 | if Is_Called (Inlined.Table (Index).Name) | |
788 | and then Inlined.Table (Index).Count = 0 | |
789 | and then not Inlined.Table (Index).Listed | |
790 | then | |
791 | Add_Inlined_Subprogram (Index); | |
792 | end if; | |
793 | end loop; | |
794 | ||
795 | -- Because Add_Inlined_Subprogram treats recursively nodes that have | |
796 | -- no prerequisites left, at the end of the loop all subprograms | |
797 | -- must have been listed. If there are any unlisted subprograms | |
798 | -- left, there must be some recursive chains that cannot be inlined. | |
799 | ||
800 | for Index in Inlined.First .. Inlined.Last loop | |
801 | if Is_Called (Inlined.Table (Index).Name) | |
802 | and then Inlined.Table (Index).Count /= 0 | |
803 | and then not Is_Predefined_File_Name | |
804 | (Unit_File_Name | |
805 | (Get_Source_Unit (Inlined.Table (Index).Name))) | |
806 | then | |
807 | Error_Msg_N | |
808 | ("& cannot be inlined?", Inlined.Table (Index).Name); | |
9de61fcb RD |
809 | |
810 | -- A warning on the first one might be sufficient ??? | |
38cbfe40 RK |
811 | end if; |
812 | end loop; | |
813 | ||
814 | Pop_Scope; | |
815 | end if; | |
816 | end Analyze_Inlined_Bodies; | |
817 | ||
15ce9ca2 AC |
818 | ----------------------------- |
819 | -- Check_Body_For_Inlining -- | |
820 | ----------------------------- | |
38cbfe40 RK |
821 | |
822 | procedure Check_Body_For_Inlining (N : Node_Id; P : Entity_Id) is | |
823 | Bname : Unit_Name_Type; | |
824 | E : Entity_Id; | |
825 | OK : Boolean; | |
826 | ||
827 | begin | |
828 | if Is_Compilation_Unit (P) | |
829 | and then not Is_Generic_Instance (P) | |
830 | then | |
831 | Bname := Get_Body_Name (Get_Unit_Name (Unit (N))); | |
38cbfe40 | 832 | |
5132708f | 833 | E := First_Entity (P); |
38cbfe40 | 834 | while Present (E) loop |
800621e0 | 835 | if Has_Pragma_Inline_Always (E) |
fbf5a39b AC |
836 | or else (Front_End_Inlining and then Has_Pragma_Inline (E)) |
837 | then | |
38cbfe40 RK |
838 | if not Is_Loaded (Bname) then |
839 | Load_Needed_Body (N, OK); | |
840 | ||
fbf5a39b AC |
841 | if OK then |
842 | ||
5132708f RD |
843 | -- Check we are not trying to inline a parent whose body |
844 | -- depends on a child, when we are compiling the body of | |
845 | -- the child. Otherwise we have a potential elaboration | |
846 | -- circularity with inlined subprograms and with | |
847 | -- Taft-Amendment types. | |
fbf5a39b AC |
848 | |
849 | declare | |
850 | Comp : Node_Id; -- Body just compiled | |
851 | Child_Spec : Entity_Id; -- Spec of main unit | |
852 | Ent : Entity_Id; -- For iteration | |
853 | With_Clause : Node_Id; -- Context of body. | |
854 | ||
855 | begin | |
856 | if Nkind (Unit (Cunit (Main_Unit))) = N_Package_Body | |
857 | and then Present (Body_Entity (P)) | |
858 | then | |
859 | Child_Spec := | |
5132708f RD |
860 | Defining_Entity |
861 | ((Unit (Library_Unit (Cunit (Main_Unit))))); | |
fbf5a39b AC |
862 | |
863 | Comp := | |
864 | Parent (Unit_Declaration_Node (Body_Entity (P))); | |
865 | ||
fbf5a39b AC |
866 | -- Check whether the context of the body just |
867 | -- compiled includes a child of itself, and that | |
868 | -- child is the spec of the main compilation. | |
869 | ||
5132708f | 870 | With_Clause := First (Context_Items (Comp)); |
fbf5a39b AC |
871 | while Present (With_Clause) loop |
872 | if Nkind (With_Clause) = N_With_Clause | |
873 | and then | |
874 | Scope (Entity (Name (With_Clause))) = P | |
875 | and then | |
876 | Entity (Name (With_Clause)) = Child_Spec | |
877 | then | |
878 | Error_Msg_Node_2 := Child_Spec; | |
879 | Error_Msg_NE | |
880 | ("body of & depends on child unit&?", | |
881 | With_Clause, P); | |
882 | Error_Msg_N | |
883 | ("\subprograms in body cannot be inlined?", | |
884 | With_Clause); | |
885 | ||
886 | -- Disable further inlining from this unit, | |
887 | -- and keep Taft-amendment types incomplete. | |
888 | ||
889 | Ent := First_Entity (P); | |
fbf5a39b AC |
890 | while Present (Ent) loop |
891 | if Is_Type (Ent) | |
892 | and then Has_Completion_In_Body (Ent) | |
893 | then | |
894 | Set_Full_View (Ent, Empty); | |
895 | ||
896 | elsif Is_Subprogram (Ent) then | |
897 | Set_Is_Inlined (Ent, False); | |
898 | end if; | |
899 | ||
900 | Next_Entity (Ent); | |
901 | end loop; | |
902 | ||
903 | return; | |
904 | end if; | |
905 | ||
906 | Next (With_Clause); | |
907 | end loop; | |
908 | end if; | |
909 | end; | |
910 | ||
911 | elsif Ineffective_Inline_Warnings then | |
38cbfe40 RK |
912 | Error_Msg_Unit_1 := Bname; |
913 | Error_Msg_N | |
914 | ("unable to inline subprograms defined in $?", P); | |
915 | Error_Msg_N ("\body not found?", P); | |
916 | return; | |
917 | end if; | |
918 | end if; | |
919 | ||
920 | return; | |
921 | end if; | |
922 | ||
923 | Next_Entity (E); | |
924 | end loop; | |
925 | end if; | |
926 | end Check_Body_For_Inlining; | |
927 | ||
928 | -------------------- | |
929 | -- Cleanup_Scopes -- | |
930 | -------------------- | |
931 | ||
932 | procedure Cleanup_Scopes is | |
933 | Elmt : Elmt_Id; | |
934 | Decl : Node_Id; | |
935 | Scop : Entity_Id; | |
936 | ||
937 | begin | |
938 | Elmt := First_Elmt (To_Clean); | |
38cbfe40 RK |
939 | while Present (Elmt) loop |
940 | Scop := Node (Elmt); | |
941 | ||
942 | if Ekind (Scop) = E_Entry then | |
943 | Scop := Protected_Body_Subprogram (Scop); | |
fbf5a39b AC |
944 | |
945 | elsif Is_Subprogram (Scop) | |
946 | and then Is_Protected_Type (Scope (Scop)) | |
947 | and then Present (Protected_Body_Subprogram (Scop)) | |
948 | then | |
949 | -- If a protected operation contains an instance, its | |
950 | -- cleanup operations have been delayed, and the subprogram | |
951 | -- has been rewritten in the expansion of the enclosing | |
952 | -- protected body. It is the corresponding subprogram that | |
1b762d7b ES |
953 | -- may require the cleanup operations, so propagate the |
954 | -- information that triggers cleanup activity. | |
fbf5a39b AC |
955 | |
956 | Set_Uses_Sec_Stack | |
957 | (Protected_Body_Subprogram (Scop), | |
958 | Uses_Sec_Stack (Scop)); | |
1b762d7b ES |
959 | Set_Finalization_Chain_Entity |
960 | (Protected_Body_Subprogram (Scop), | |
961 | Finalization_Chain_Entity (Scop)); | |
fbf5a39b | 962 | Scop := Protected_Body_Subprogram (Scop); |
38cbfe40 RK |
963 | end if; |
964 | ||
965 | if Ekind (Scop) = E_Block then | |
57568d91 | 966 | Decl := Parent (Block_Node (Scop)); |
38cbfe40 RK |
967 | |
968 | else | |
969 | Decl := Unit_Declaration_Node (Scop); | |
970 | ||
971 | if Nkind (Decl) = N_Subprogram_Declaration | |
972 | or else Nkind (Decl) = N_Task_Type_Declaration | |
973 | or else Nkind (Decl) = N_Subprogram_Body_Stub | |
974 | then | |
975 | Decl := Unit_Declaration_Node (Corresponding_Body (Decl)); | |
976 | end if; | |
977 | end if; | |
978 | ||
a99ada67 | 979 | Push_Scope (Scop); |
38cbfe40 RK |
980 | Expand_Cleanup_Actions (Decl); |
981 | End_Scope; | |
982 | ||
983 | Elmt := Next_Elmt (Elmt); | |
984 | end loop; | |
985 | end Cleanup_Scopes; | |
986 | ||
70c34e1c AC |
987 | -------------------------- |
988 | -- Get_Code_Unit_Entity -- | |
989 | -------------------------- | |
990 | ||
991 | function Get_Code_Unit_Entity (E : Entity_Id) return Entity_Id is | |
992 | begin | |
993 | return Cunit_Entity (Get_Code_Unit (E)); | |
994 | end Get_Code_Unit_Entity; | |
995 | ||
38cbfe40 RK |
996 | -------------------------- |
997 | -- Has_Initialized_Type -- | |
998 | -------------------------- | |
999 | ||
1000 | function Has_Initialized_Type (E : Entity_Id) return Boolean is | |
1001 | E_Body : constant Node_Id := Get_Subprogram_Body (E); | |
1002 | Decl : Node_Id; | |
1003 | ||
1004 | begin | |
1005 | if No (E_Body) then -- imported subprogram | |
1006 | return False; | |
1007 | ||
1008 | else | |
1009 | Decl := First (Declarations (E_Body)); | |
38cbfe40 RK |
1010 | while Present (Decl) loop |
1011 | ||
1012 | if Nkind (Decl) = N_Full_Type_Declaration | |
1013 | and then Present (Init_Proc (Defining_Identifier (Decl))) | |
1014 | then | |
1015 | return True; | |
1016 | end if; | |
1017 | ||
1018 | Next (Decl); | |
1019 | end loop; | |
1020 | end if; | |
1021 | ||
1022 | return False; | |
1023 | end Has_Initialized_Type; | |
1024 | ||
1025 | ---------------- | |
1026 | -- Initialize -- | |
1027 | ---------------- | |
1028 | ||
1029 | procedure Initialize is | |
1030 | begin | |
1031 | Analyzing_Inlined_Bodies := False; | |
1032 | Pending_Descriptor.Init; | |
1033 | Pending_Instantiations.Init; | |
1034 | Inlined_Bodies.Init; | |
1035 | Successors.Init; | |
1036 | Inlined.Init; | |
1037 | ||
1038 | for J in Hash_Headers'Range loop | |
1039 | Hash_Headers (J) := No_Subp; | |
1040 | end loop; | |
1041 | end Initialize; | |
1042 | ||
1043 | ------------------------ | |
1044 | -- Instantiate_Bodies -- | |
1045 | ------------------------ | |
1046 | ||
1047 | -- Generic bodies contain all the non-local references, so an | |
1048 | -- instantiation does not need any more context than Standard | |
1049 | -- itself, even if the instantiation appears in an inner scope. | |
1050 | -- Generic associations have verified that the contract model is | |
1051 | -- satisfied, so that any error that may occur in the analysis of | |
1052 | -- the body is an internal error. | |
1053 | ||
1054 | procedure Instantiate_Bodies is | |
1055 | J : Int; | |
1056 | Info : Pending_Body_Info; | |
1057 | ||
1058 | begin | |
07fc65c4 | 1059 | if Serious_Errors_Detected = 0 then |
38cbfe40 | 1060 | |
fbf5a39b | 1061 | Expander_Active := (Operating_Mode = Opt.Generate_Code); |
a99ada67 | 1062 | Push_Scope (Standard_Standard); |
38cbfe40 RK |
1063 | To_Clean := New_Elmt_List; |
1064 | ||
1065 | if Is_Generic_Unit (Cunit_Entity (Main_Unit)) then | |
1066 | Start_Generic; | |
1067 | end if; | |
1068 | ||
1069 | -- A body instantiation may generate additional instantiations, so | |
1070 | -- the following loop must scan to the end of a possibly expanding | |
1071 | -- set (that's why we can't simply use a FOR loop here). | |
1072 | ||
1073 | J := 0; | |
38cbfe40 | 1074 | while J <= Pending_Instantiations.Last |
07fc65c4 | 1075 | and then Serious_Errors_Detected = 0 |
38cbfe40 | 1076 | loop |
38cbfe40 RK |
1077 | Info := Pending_Instantiations.Table (J); |
1078 | ||
fbf5a39b | 1079 | -- If the instantiation node is absent, it has been removed |
38cbfe40 RK |
1080 | -- as part of unreachable code. |
1081 | ||
1082 | if No (Info.Inst_Node) then | |
1083 | null; | |
1084 | ||
fbf5a39b | 1085 | elsif Nkind (Info.Act_Decl) = N_Package_Declaration then |
38cbfe40 RK |
1086 | Instantiate_Package_Body (Info); |
1087 | Add_Scope_To_Clean (Defining_Entity (Info.Act_Decl)); | |
1088 | ||
1089 | else | |
1090 | Instantiate_Subprogram_Body (Info); | |
1091 | end if; | |
1092 | ||
1093 | J := J + 1; | |
1094 | end loop; | |
1095 | ||
1096 | -- Reset the table of instantiations. Additional instantiations | |
1097 | -- may be added through inlining, when additional bodies are | |
1098 | -- analyzed. | |
1099 | ||
1100 | Pending_Instantiations.Init; | |
1101 | ||
1102 | -- We can now complete the cleanup actions of scopes that contain | |
1103 | -- pending instantiations (skipped for generic units, since we | |
1104 | -- never need any cleanups in generic units). | |
1105 | -- pending instantiations. | |
1106 | ||
1107 | if Expander_Active | |
1108 | and then not Is_Generic_Unit (Main_Unit_Entity) | |
1109 | then | |
1110 | Cleanup_Scopes; | |
38cbfe40 RK |
1111 | elsif Is_Generic_Unit (Cunit_Entity (Main_Unit)) then |
1112 | End_Generic; | |
1113 | end if; | |
1114 | ||
1115 | Pop_Scope; | |
1116 | end if; | |
1117 | end Instantiate_Bodies; | |
1118 | ||
1119 | --------------- | |
1120 | -- Is_Nested -- | |
1121 | --------------- | |
1122 | ||
1123 | function Is_Nested (E : Entity_Id) return Boolean is | |
5132708f | 1124 | Scop : Entity_Id; |
38cbfe40 RK |
1125 | |
1126 | begin | |
5132708f | 1127 | Scop := Scope (E); |
38cbfe40 RK |
1128 | while Scop /= Standard_Standard loop |
1129 | if Ekind (Scop) in Subprogram_Kind then | |
1130 | return True; | |
1131 | ||
1132 | elsif Ekind (Scop) = E_Task_Type | |
1133 | or else Ekind (Scop) = E_Entry | |
1134 | or else Ekind (Scop) = E_Entry_Family then | |
1135 | return True; | |
1136 | end if; | |
1137 | ||
1138 | Scop := Scope (Scop); | |
1139 | end loop; | |
1140 | ||
1141 | return False; | |
1142 | end Is_Nested; | |
1143 | ||
1144 | ---------- | |
1145 | -- Lock -- | |
1146 | ---------- | |
1147 | ||
1148 | procedure Lock is | |
1149 | begin | |
1150 | Pending_Instantiations.Locked := True; | |
1151 | Inlined_Bodies.Locked := True; | |
1152 | Successors.Locked := True; | |
1153 | Inlined.Locked := True; | |
1154 | Pending_Instantiations.Release; | |
1155 | Inlined_Bodies.Release; | |
1156 | Successors.Release; | |
1157 | Inlined.Release; | |
1158 | end Lock; | |
1159 | ||
1160 | -------------------------- | |
1161 | -- Remove_Dead_Instance -- | |
1162 | -------------------------- | |
1163 | ||
1164 | procedure Remove_Dead_Instance (N : Node_Id) is | |
5132708f | 1165 | J : Int; |
38cbfe40 RK |
1166 | |
1167 | begin | |
1168 | J := 0; | |
38cbfe40 | 1169 | while J <= Pending_Instantiations.Last loop |
38cbfe40 RK |
1170 | if Pending_Instantiations.Table (J).Inst_Node = N then |
1171 | Pending_Instantiations.Table (J).Inst_Node := Empty; | |
1172 | return; | |
1173 | end if; | |
1174 | ||
1175 | J := J + 1; | |
1176 | end loop; | |
1177 | end Remove_Dead_Instance; | |
1178 | ||
1179 | ------------------------ | |
1180 | -- Scope_In_Main_Unit -- | |
1181 | ------------------------ | |
1182 | ||
1183 | function Scope_In_Main_Unit (Scop : Entity_Id) return Boolean is | |
1237d6ef | 1184 | Comp : constant Node_Id := Cunit (Get_Code_Unit (Scop)); |
38cbfe40 RK |
1185 | |
1186 | begin | |
1237d6ef AC |
1187 | -- Check whether the scope of the subprogram to inline is within the |
1188 | -- main unit or within its spec. In either case there are no additional | |
1189 | -- bodies to process. If the subprogram appears in a parent of the | |
1190 | -- current unit, the check on whether inlining is possible is done in | |
1191 | -- Analyze_Inlined_Bodies. | |
38cbfe40 RK |
1192 | |
1193 | return | |
1194 | Comp = Cunit (Main_Unit) | |
1195 | or else Comp = Library_Unit (Cunit (Main_Unit)); | |
1196 | end Scope_In_Main_Unit; | |
1197 | ||
1198 | end Inline; |