]>
Commit | Line | Data |
---|---|---|
5a271a7f RD |
1 | ------------------------------------------------------------------------------ |
2 | -- -- | |
3 | -- GNAT COMPILER COMPONENTS -- | |
4 | -- -- | |
5 | -- E X P _ U N S T -- | |
6 | -- -- | |
7 | -- B o d y -- | |
8 | -- -- | |
1d005acc | 9 | -- Copyright (C) 2014-2019, Free Software Foundation, Inc. -- |
5a271a7f RD |
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 3, 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 COPYING3. If not, go to -- | |
19 | -- http://www.gnu.org/licenses for a complete copy of the license. -- | |
20 | -- -- | |
21 | -- GNAT was originally developed by the GNAT team at New York University. -- | |
22 | -- Extensive contributions were provided by Ada Core Technologies Inc. -- | |
23 | -- -- | |
24 | ------------------------------------------------------------------------------ | |
25 | ||
26 | with Atree; use Atree; | |
f8dae9bb | 27 | with Debug; use Debug; |
5a271a7f RD |
28 | with Einfo; use Einfo; |
29 | with Elists; use Elists; | |
3af796b5 | 30 | with Exp_Util; use Exp_Util; |
89f0276a | 31 | with Lib; use Lib; |
5a271a7f RD |
32 | with Namet; use Namet; |
33 | with Nlists; use Nlists; | |
34 | with Nmake; use Nmake; | |
851e9f19 | 35 | with Opt; |
f8dae9bb | 36 | with Output; use Output; |
5a271a7f | 37 | with Rtsfind; use Rtsfind; |
89f0276a | 38 | with Sem; use Sem; |
36357cf3 | 39 | with Sem_Aux; use Sem_Aux; |
488f9623 | 40 | with Sem_Ch8; use Sem_Ch8; |
89f0276a RD |
41 | with Sem_Mech; use Sem_Mech; |
42 | with Sem_Res; use Sem_Res; | |
5a271a7f RD |
43 | with Sem_Util; use Sem_Util; |
44 | with Sinfo; use Sinfo; | |
f8dae9bb | 45 | with Sinput; use Sinput; |
5a271a7f | 46 | with Snames; use Snames; |
ade649b2 | 47 | with Stand; use Stand; |
5a271a7f | 48 | with Tbuild; use Tbuild; |
3830827c | 49 | with Uintp; use Uintp; |
5a271a7f RD |
50 | |
51 | package body Exp_Unst is | |
52 | ||
29a56f61 JM |
53 | ----------------------- |
54 | -- Local Subprograms -- | |
55 | ----------------------- | |
56 | ||
dd241b94 AC |
57 | procedure Unnest_Subprogram |
58 | (Subp : Entity_Id; Subp_Body : Node_Id; For_Inline : Boolean := False); | |
29a56f61 JM |
59 | -- Subp is a library-level subprogram which has nested subprograms, and |
60 | -- Subp_Body is the corresponding N_Subprogram_Body node. This procedure | |
61 | -- declares the AREC types and objects, adds assignments to the AREC record | |
62 | -- as required, defines the xxxPTR types for uplevel referenced objects, | |
63 | -- adds the ARECP parameter to all nested subprograms which need it, and | |
dd241b94 AC |
64 | -- modifies all uplevel references appropriately. If For_Inline is True, |
65 | -- we're unnesting this subprogram because it's on the list of inlined | |
66 | -- subprograms and should unnest it despite it not being part of the main | |
67 | -- unit. | |
29a56f61 | 68 | |
f8dae9bb AC |
69 | ----------- |
70 | -- Calls -- | |
71 | ----------- | |
72 | ||
73 | -- Table to record calls within the nest being analyzed. These are the | |
ee935273 AC |
74 | -- calls which may need to have an AREC actual added. This table is built |
75 | -- new for each subprogram nest and cleared at the end of processing each | |
76 | -- subprogram nest. | |
f8dae9bb | 77 | |
3830827c | 78 | type Call_Entry is record |
89f0276a | 79 | N : Node_Id; |
3830827c AC |
80 | -- The actual call |
81 | ||
f8dae9bb AC |
82 | Caller : Entity_Id; |
83 | -- Entity of the subprogram containing the call (can be at any level) | |
3830827c | 84 | |
f8dae9bb AC |
85 | Callee : Entity_Id; |
86 | -- Entity of the subprogram called (always at level 2 or higher). Note | |
87 | -- that in accordance with the basic rules of nesting, the level of To | |
88 | -- is either less than or equal to the level of From, or one greater. | |
3830827c AC |
89 | end record; |
90 | ||
91 | package Calls is new Table.Table ( | |
92 | Table_Component_Type => Call_Entry, | |
93 | Table_Index_Type => Nat, | |
94 | Table_Low_Bound => 1, | |
95 | Table_Initial => 100, | |
96 | Table_Increment => 200, | |
89f0276a | 97 | Table_Name => "Unnest_Calls"); |
3830827c AC |
98 | -- Records each call within the outer subprogram and all nested subprograms |
99 | -- that are to other subprograms nested within the outer subprogram. These | |
100 | -- are the calls that may need an additional parameter. | |
101 | ||
9a476d75 AC |
102 | procedure Append_Unique_Call (Call : Call_Entry); |
103 | -- Append a call entry to the Calls table. A check is made to see if the | |
104 | -- table already contains this entry and if so it has no effect. | |
105 | ||
fc0e632a | 106 | ---------------------------------- |
1985767d | 107 | -- Subprograms For Fat Pointers -- |
fc0e632a ES |
108 | ---------------------------------- |
109 | ||
fc0e632a ES |
110 | function Build_Access_Type_Decl |
111 | (E : Entity_Id; | |
112 | Scop : Entity_Id) return Node_Id; | |
113 | -- For an uplevel reference that involves an unconstrained array type, | |
114 | -- build an access type declaration for the corresponding activation | |
115 | -- record component. The relevant attributes of the access type are | |
116 | -- set here to avoid a full analysis that would require a scope stack. | |
117 | ||
1985767d HK |
118 | function Needs_Fat_Pointer (E : Entity_Id) return Boolean; |
119 | -- A formal parameter of an unconstrained array type that appears in an | |
120 | -- uplevel reference requires the construction of an access type, to be | |
121 | -- used in the corresponding component declaration. | |
122 | ||
f8dae9bb AC |
123 | ----------- |
124 | -- Urefs -- | |
125 | ----------- | |
5a271a7f | 126 | |
f8dae9bb AC |
127 | -- Table to record explicit uplevel references to objects (variables, |
128 | -- constants, formal parameters). These are the references that will | |
129 | -- need rewriting to use the activation table (AREC) pointers. Also | |
130 | -- included are implicit and explicit uplevel references to types, but | |
ee935273 AC |
131 | -- these do not get rewritten by the front end. This table is built new |
132 | -- for each subprogram nest and cleared at the end of processing each | |
133 | -- subprogram nest. | |
5a271a7f | 134 | |
f8dae9bb AC |
135 | type Uref_Entry is record |
136 | Ref : Node_Id; | |
137 | -- The reference itself. For objects this is always an entity reference | |
138 | -- and the referenced entity will have its Is_Uplevel_Referenced_Entity | |
139 | -- flag set and will appear in the Uplevel_Referenced_Entities list of | |
140 | -- the subprogram declaring this entity. | |
5a271a7f | 141 | |
f8dae9bb AC |
142 | Ent : Entity_Id; |
143 | -- The Entity_Id of the uplevel referenced object or type | |
3830827c | 144 | |
f8dae9bb AC |
145 | Caller : Entity_Id; |
146 | -- The entity for the subprogram immediately containing this entity | |
3830827c | 147 | |
f8dae9bb AC |
148 | Callee : Entity_Id; |
149 | -- The entity for the subprogram containing the referenced entity. Note | |
150 | -- that the level of Callee must be less than the level of Caller, since | |
731261c3 | 151 | -- this is an uplevel reference. |
f8dae9bb | 152 | end record; |
5a271a7f | 153 | |
f8dae9bb AC |
154 | package Urefs is new Table.Table ( |
155 | Table_Component_Type => Uref_Entry, | |
156 | Table_Index_Type => Nat, | |
157 | Table_Low_Bound => 1, | |
158 | Table_Initial => 100, | |
159 | Table_Increment => 200, | |
160 | Table_Name => "Unnest_Urefs"); | |
5a271a7f | 161 | |
9a476d75 AC |
162 | ------------------------ |
163 | -- Append_Unique_Call -- | |
164 | ------------------------ | |
165 | ||
166 | procedure Append_Unique_Call (Call : Call_Entry) is | |
167 | begin | |
168 | for J in Calls.First .. Calls.Last loop | |
169 | if Calls.Table (J) = Call then | |
170 | return; | |
171 | end if; | |
172 | end loop; | |
173 | ||
174 | Calls.Append (Call); | |
175 | end Append_Unique_Call; | |
176 | ||
fc0e632a ES |
177 | ----------------------------- |
178 | -- Build_Access_Type_Decl -- | |
179 | ----------------------------- | |
180 | ||
181 | function Build_Access_Type_Decl | |
182 | (E : Entity_Id; | |
183 | Scop : Entity_Id) return Node_Id | |
184 | is | |
1985767d HK |
185 | Loc : constant Source_Ptr := Sloc (E); |
186 | Typ : Entity_Id; | |
fc0e632a ES |
187 | |
188 | begin | |
189 | Typ := Make_Temporary (Loc, 'S'); | |
190 | Set_Ekind (Typ, E_General_Access_Type); | |
191 | Set_Etype (Typ, Typ); | |
192 | Set_Scope (Typ, Scop); | |
193 | Set_Directly_Designated_Type (Typ, Etype (E)); | |
194 | ||
1985767d HK |
195 | return |
196 | Make_Full_Type_Declaration (Loc, | |
197 | Defining_Identifier => Typ, | |
198 | Type_Definition => | |
199 | Make_Access_To_Object_Definition (Loc, | |
200 | Subtype_Indication => New_Occurrence_Of (Etype (E), Loc))); | |
fc0e632a ES |
201 | end Build_Access_Type_Decl; |
202 | ||
18431dc5 AC |
203 | --------------- |
204 | -- Get_Level -- | |
205 | --------------- | |
206 | ||
207 | function Get_Level (Subp : Entity_Id; Sub : Entity_Id) return Nat is | |
208 | Lev : Nat; | |
209 | S : Entity_Id; | |
61d1b085 | 210 | |
18431dc5 AC |
211 | begin |
212 | Lev := 1; | |
213 | S := Sub; | |
214 | loop | |
215 | if S = Subp then | |
216 | return Lev; | |
217 | else | |
18431dc5 | 218 | Lev := Lev + 1; |
61d1b085 | 219 | S := Enclosing_Subprogram (S); |
18431dc5 AC |
220 | end if; |
221 | end loop; | |
222 | end Get_Level; | |
223 | ||
ade649b2 ES |
224 | -------------------------- |
225 | -- In_Synchronized_Unit -- | |
226 | -------------------------- | |
227 | ||
228 | function In_Synchronized_Unit (Subp : Entity_Id) return Boolean is | |
229 | S : Entity_Id := Scope (Subp); | |
230 | ||
231 | begin | |
232 | while Present (S) and then S /= Standard_Standard loop | |
233 | if Is_Concurrent_Type (S) then | |
234 | return True; | |
c14bd502 ES |
235 | |
236 | elsif Is_Private_Type (S) | |
237 | and then Present (Full_View (S)) | |
238 | and then Is_Concurrent_Type (Full_View (S)) | |
239 | then | |
240 | return True; | |
ade649b2 ES |
241 | end if; |
242 | ||
243 | S := Scope (S); | |
244 | end loop; | |
245 | ||
246 | return False; | |
247 | end In_Synchronized_Unit; | |
248 | ||
1985767d HK |
249 | ----------------------- |
250 | -- Needs_Fat_Pointer -- | |
251 | ----------------------- | |
252 | ||
253 | function Needs_Fat_Pointer (E : Entity_Id) return Boolean is | |
1d499c15 | 254 | Typ : Entity_Id; |
1985767d | 255 | begin |
1d499c15 ES |
256 | if Is_Formal (E) then |
257 | Typ := Etype (E); | |
258 | if Is_Private_Type (Typ) and then Present (Full_View (Typ)) then | |
259 | Typ := Full_View (Typ); | |
260 | end if; | |
261 | ||
68f27c97 | 262 | return Is_Array_Type (Typ) and then not Is_Constrained (Typ); |
1d499c15 ES |
263 | else |
264 | return False; | |
265 | end if; | |
1985767d HK |
266 | end Needs_Fat_Pointer; |
267 | ||
18431dc5 AC |
268 | ---------------- |
269 | -- Subp_Index -- | |
270 | ---------------- | |
271 | ||
272 | function Subp_Index (Sub : Entity_Id) return SI_Type is | |
36357cf3 AC |
273 | E : Entity_Id := Sub; |
274 | ||
18431dc5 | 275 | begin |
36357cf3 AC |
276 | pragma Assert (Is_Subprogram (E)); |
277 | ||
278 | if Subps_Index (E) = Uint_0 then | |
279 | E := Ultimate_Alias (E); | |
280 | ||
0d756922 | 281 | -- The body of a protected operation has a different name and |
dd81163f HK |
282 | -- has been scanned at this point, and thus has an entry in the |
283 | -- subprogram table. | |
0d756922 | 284 | |
92a68a04 | 285 | if E = Sub and then Convention (E) = Convention_Protected then |
0d756922 ES |
286 | E := Protected_Body_Subprogram (E); |
287 | end if; | |
288 | ||
36357cf3 AC |
289 | if Ekind (E) = E_Function |
290 | and then Rewritten_For_C (E) | |
291 | and then Present (Corresponding_Procedure (E)) | |
292 | then | |
293 | E := Corresponding_Procedure (E); | |
294 | end if; | |
295 | end if; | |
296 | ||
297 | pragma Assert (Subps_Index (E) /= Uint_0); | |
298 | return SI_Type (UI_To_Int (Subps_Index (E))); | |
18431dc5 AC |
299 | end Subp_Index; |
300 | ||
5a271a7f RD |
301 | ----------------------- |
302 | -- Unnest_Subprogram -- | |
303 | ----------------------- | |
304 | ||
dd241b94 AC |
305 | procedure Unnest_Subprogram |
306 | (Subp : Entity_Id; Subp_Body : Node_Id; For_Inline : Boolean := False) is | |
551e1935 AC |
307 | function AREC_Name (J : Pos; S : String) return Name_Id; |
308 | -- Returns name for string ARECjS, where j is the decimal value of j | |
5a271a7f | 309 | |
89f0276a | 310 | function Enclosing_Subp (Subp : SI_Type) return SI_Type; |
3830827c AC |
311 | -- Subp is the index of a subprogram which has a Lev greater than 1. |
312 | -- This function returns the index of the enclosing subprogram which | |
313 | -- will have a Lev value one less than this. | |
314 | ||
551e1935 AC |
315 | function Img_Pos (N : Pos) return String; |
316 | -- Return image of N without leading blank | |
317 | ||
551e1935 AC |
318 | function Upref_Name |
319 | (Ent : Entity_Id; | |
320 | Index : Pos; | |
321 | Clist : List_Id) return Name_Id; | |
ddbc55d8 | 322 | -- This function returns the name to be used in the activation record to |
f8dae9bb | 323 | -- reference the variable uplevel. Clist is the list of components that |
551e1935 AC |
324 | -- have been created in the activation record so far. Normally the name |
325 | -- is just a copy of the Chars field of the entity. The exception is | |
326 | -- when the name has already been used, in which case we suffix the name | |
327 | -- with the index value Index to avoid duplication. This happens with | |
328 | -- declare blocks and generic parameters at least. | |
57d08392 | 329 | |
551e1935 AC |
330 | --------------- |
331 | -- AREC_Name -- | |
332 | --------------- | |
5a271a7f | 333 | |
551e1935 | 334 | function AREC_Name (J : Pos; S : String) return Name_Id is |
5a271a7f | 335 | begin |
3e20cb68 | 336 | return Name_Find ("AREC" & Img_Pos (J) & S); |
551e1935 | 337 | end AREC_Name; |
5a271a7f | 338 | |
89f0276a RD |
339 | -------------------- |
340 | -- Enclosing_Subp -- | |
341 | -------------------- | |
3830827c | 342 | |
89f0276a | 343 | function Enclosing_Subp (Subp : SI_Type) return SI_Type is |
3830827c | 344 | STJ : Subp_Entry renames Subps.Table (Subp); |
89f0276a | 345 | Ret : constant SI_Type := Subp_Index (Enclosing_Subprogram (STJ.Ent)); |
3830827c AC |
346 | begin |
347 | pragma Assert (STJ.Lev > 1); | |
348 | pragma Assert (Subps.Table (Ret).Lev = STJ.Lev - 1); | |
349 | return Ret; | |
89f0276a | 350 | end Enclosing_Subp; |
3830827c | 351 | |
551e1935 AC |
352 | ------------- |
353 | -- Img_Pos -- | |
354 | ------------- | |
355 | ||
356 | function Img_Pos (N : Pos) return String is | |
357 | Buf : String (1 .. 20); | |
358 | Ptr : Natural; | |
359 | NV : Nat; | |
360 | ||
361 | begin | |
362 | Ptr := Buf'Last; | |
363 | NV := N; | |
364 | while NV /= 0 loop | |
365 | Buf (Ptr) := Character'Val (48 + NV mod 10); | |
366 | Ptr := Ptr - 1; | |
367 | NV := NV / 10; | |
368 | end loop; | |
369 | ||
370 | return Buf (Ptr + 1 .. Buf'Last); | |
371 | end Img_Pos; | |
372 | ||
ddbc55d8 AC |
373 | ---------------- |
374 | -- Upref_Name -- | |
375 | ---------------- | |
376 | ||
551e1935 AC |
377 | function Upref_Name |
378 | (Ent : Entity_Id; | |
379 | Index : Pos; | |
380 | Clist : List_Id) return Name_Id | |
381 | is | |
f8dae9bb | 382 | C : Node_Id; |
ddbc55d8 | 383 | begin |
f8dae9bb AC |
384 | C := First (Clist); |
385 | loop | |
386 | if No (C) then | |
387 | return Chars (Ent); | |
87feba05 | 388 | |
f8dae9bb | 389 | elsif Chars (Defining_Identifier (C)) = Chars (Ent) then |
87feba05 AC |
390 | return |
391 | Name_Find (Get_Name_String (Chars (Ent)) & Img_Pos (Index)); | |
f8dae9bb AC |
392 | else |
393 | Next (C); | |
394 | end if; | |
395 | end loop; | |
ddbc55d8 AC |
396 | end Upref_Name; |
397 | ||
5a271a7f RD |
398 | -- Start of processing for Unnest_Subprogram |
399 | ||
400 | begin | |
d50a26f2 AC |
401 | -- Nothing to do inside a generic (all processing is for instance) |
402 | ||
403 | if Inside_A_Generic then | |
404 | return; | |
405 | end if; | |
f8dae9bb | 406 | |
c581c520 PMR |
407 | -- If the main unit is a package body then we need to examine the spec |
408 | -- to determine whether the main unit is generic (the scope stack is not | |
409 | -- present when this is called on the main unit). | |
410 | ||
dd241b94 AC |
411 | if not For_Inline |
412 | and then Ekind (Cunit_Entity (Main_Unit)) = E_Package_Body | |
c581c520 PMR |
413 | and then Is_Generic_Unit (Spec_Entity (Cunit_Entity (Main_Unit))) |
414 | then | |
415 | return; | |
c581c520 | 416 | |
9531aef5 AC |
417 | -- Only unnest when generating code for the main source unit or if |
418 | -- we're unnesting for inline. But in some Annex E cases the Sloc | |
419 | -- points to a different unit, so also make sure that the Parent | |
420 | -- isn't in something that we know we're generating code for. | |
89f0276a | 421 | |
dd241b94 AC |
422 | elsif not For_Inline |
423 | and then not In_Extended_Main_Code_Unit (Subp_Body) | |
9531aef5 | 424 | and then not In_Extended_Main_Code_Unit (Parent (Subp_Body)) |
dd241b94 | 425 | then |
89f0276a RD |
426 | return; |
427 | end if; | |
428 | ||
f8dae9bb AC |
429 | -- This routine is called late, after the scope stack is gone. The |
430 | -- following creates a suitable dummy scope stack to be used for the | |
431 | -- analyze/expand calls made from this routine. | |
432 | ||
433 | Push_Scope (Subp); | |
434 | ||
5a271a7f RD |
435 | -- First step, we must mark all nested subprograms that require a static |
436 | -- link (activation record) because either they contain explicit uplevel | |
3373589b AC |
437 | -- references (as indicated by Is_Uplevel_Referenced_Entity being set at |
438 | -- this point), or they make calls to other subprograms in the same nest | |
439 | -- that require a static link (in which case we set this flag). | |
5a271a7f RD |
440 | |
441 | -- This is a recursive definition, and to implement this, we have to | |
442 | -- build a call graph for the set of nested subprograms, and then go | |
443 | -- over this graph to implement recursively the invariant that if a | |
444 | -- subprogram has a call to a subprogram requiring a static link, then | |
445 | -- the calling subprogram requires a static link. | |
446 | ||
3830827c | 447 | -- First populate the above tables |
5a271a7f | 448 | |
ee935273 | 449 | Subps_First := Subps.Last + 1; |
5a271a7f | 450 | Calls.Init; |
f8dae9bb | 451 | Urefs.Init; |
5a271a7f RD |
452 | |
453 | Build_Tables : declare | |
2ffa39d2 | 454 | Current_Subprogram : Entity_Id := Empty; |
f8dae9bb AC |
455 | -- When we scan a subprogram body, we set Current_Subprogram to the |
456 | -- corresponding entity. This gets recursively saved and restored. | |
457 | ||
5a271a7f RD |
458 | function Visit_Node (N : Node_Id) return Traverse_Result; |
459 | -- Visit a single node in Subp | |
460 | ||
f8dae9bb AC |
461 | ----------- |
462 | -- Visit -- | |
463 | ----------- | |
464 | ||
465 | procedure Visit is new Traverse_Proc (Visit_Node); | |
466 | -- Used to traverse the body of Subp, populating the tables | |
467 | ||
5a271a7f RD |
468 | ---------------- |
469 | -- Visit_Node -- | |
470 | ---------------- | |
471 | ||
472 | function Visit_Node (N : Node_Id) return Traverse_Result is | |
f8dae9bb AC |
473 | Ent : Entity_Id; |
474 | Caller : Entity_Id; | |
475 | Callee : Entity_Id; | |
476 | ||
577ad216 | 477 | procedure Check_Static_Type |
6578a6bf HK |
478 | (T : Entity_Id; |
479 | N : Node_Id; | |
480 | DT : in out Boolean; | |
97c0b990 | 481 | Check_Designated : Boolean := False); |
356ffab8 AC |
482 | -- Given a type T, checks if it is a static type defined as a type |
483 | -- with no dynamic bounds in sight. If so, the only action is to | |
484 | -- set Is_Static_Type True for T. If T is not a static type, then | |
485 | -- all types with dynamic bounds associated with T are detected, | |
486 | -- and their bounds are marked as uplevel referenced if not at the | |
577ad216 RK |
487 | -- library level, and DT is set True. If N is specified, it's the |
488 | -- node that will need to be replaced. If not specified, it means | |
489 | -- we can't do a replacement because the bound is implicit. | |
f8dae9bb | 490 | |
97c0b990 ES |
491 | -- If Check_Designated is True and T or its full view is an access |
492 | -- type, check whether the designated type has dynamic bounds. | |
493 | ||
f8dae9bb AC |
494 | procedure Note_Uplevel_Ref |
495 | (E : Entity_Id; | |
577ad216 | 496 | N : Node_Id; |
f8dae9bb AC |
497 | Caller : Entity_Id; |
498 | Callee : Entity_Id); | |
499 | -- Called when we detect an explicit or implicit uplevel reference | |
500 | -- from within Caller to entity E declared in Callee. E can be a | |
501 | -- an object or a type. | |
502 | ||
5d514884 ES |
503 | procedure Register_Subprogram (E : Entity_Id; Bod : Node_Id); |
504 | -- Enter a subprogram whose body is visible or which is a | |
505 | -- subprogram instance into the subprogram table. | |
506 | ||
f8dae9bb AC |
507 | ----------------------- |
508 | -- Check_Static_Type -- | |
509 | ----------------------- | |
510 | ||
577ad216 | 511 | procedure Check_Static_Type |
6578a6bf HK |
512 | (T : Entity_Id; |
513 | N : Node_Id; | |
514 | DT : in out Boolean; | |
97c0b990 | 515 | Check_Designated : Boolean := False) |
577ad216 RK |
516 | is |
517 | procedure Note_Uplevel_Bound (N : Node_Id; Ref : Node_Id); | |
f8dae9bb AC |
518 | -- N is the bound of a dynamic type. This procedure notes that |
519 | -- this bound is uplevel referenced, it can handle references | |
520 | -- to entities (typically _FIRST and _LAST entities), and also | |
521 | -- attribute references of the form T'name (name is typically | |
522 | -- FIRST or LAST) where T is the uplevel referenced bound. | |
577ad216 RK |
523 | -- Ref, if Present, is the location of the reference to |
524 | -- replace. | |
f8dae9bb AC |
525 | |
526 | ------------------------ | |
527 | -- Note_Uplevel_Bound -- | |
528 | ------------------------ | |
529 | ||
577ad216 | 530 | procedure Note_Uplevel_Bound (N : Node_Id; Ref : Node_Id) is |
f8dae9bb | 531 | begin |
9ea43db6 | 532 | -- Entity name case. Make sure that the entity is declared |
604801a4 PT |
533 | -- in a subprogram. This may not be the case for a type in a |
534 | -- loop appearing in a precondition. | |
5d514884 ES |
535 | -- Exclude explicitly discriminants (that can appear |
536 | -- in bounds of discriminated components). | |
f8dae9bb AC |
537 | |
538 | if Is_Entity_Name (N) then | |
5fe0b8c3 | 539 | if Present (Entity (N)) |
0d756922 | 540 | and then not Is_Type (Entity (N)) |
9ea43db6 | 541 | and then Present (Enclosing_Subprogram (Entity (N))) |
f4bf7b62 | 542 | and then Ekind (Entity (N)) /= E_Discriminant |
5fe0b8c3 | 543 | then |
f8dae9bb AC |
544 | Note_Uplevel_Ref |
545 | (E => Entity (N), | |
0d756922 | 546 | N => Empty, |
f8dae9bb AC |
547 | Caller => Current_Subprogram, |
548 | Callee => Enclosing_Subprogram (Entity (N))); | |
549 | end if; | |
5a271a7f | 550 | |
577ad216 RK |
551 | -- Attribute or indexed component case |
552 | ||
553 | elsif Nkind_In (N, N_Attribute_Reference, | |
554 | N_Indexed_Component) | |
555 | then | |
556 | Note_Uplevel_Bound (Prefix (N), Ref); | |
557 | ||
184a6ba6 ES |
558 | -- The indices of the indexed components, or the |
559 | -- associated expressions of an attribute reference, | |
560 | -- may also involve uplevel references. | |
561 | ||
562 | declare | |
563 | Expr : Node_Id; | |
564 | ||
565 | begin | |
566 | Expr := First (Expressions (N)); | |
567 | while Present (Expr) loop | |
568 | Note_Uplevel_Bound (Expr, Ref); | |
569 | Next (Expr); | |
570 | end loop; | |
571 | end; | |
572 | ||
ef8f9700 ES |
573 | -- The type of the prefix may be have an uplevel |
574 | -- reference if this needs bounds. | |
575 | ||
576 | if Nkind (N) = N_Attribute_Reference then | |
577 | declare | |
578 | Attr : constant Attribute_Id := | |
dd81163f HK |
579 | Get_Attribute_Id (Attribute_Name (N)); |
580 | DT : Boolean := False; | |
581 | ||
ef8f9700 ES |
582 | begin |
583 | if (Attr = Attribute_First | |
584 | or else Attr = Attribute_Last | |
585 | or else Attr = Attribute_Length) | |
586 | and then Is_Constrained (Etype (Prefix (N))) | |
587 | then | |
dd81163f HK |
588 | Check_Static_Type |
589 | (Etype (Prefix (N)), Empty, DT); | |
ef8f9700 ES |
590 | end if; |
591 | end; | |
592 | end if; | |
593 | ||
400ad4e9 HK |
594 | -- Binary operator cases. These can apply to arrays for |
595 | -- which we may need bounds. | |
ccc2a613 ES |
596 | |
597 | elsif Nkind (N) in N_Binary_Op then | |
598 | Note_Uplevel_Bound (Left_Opnd (N), Ref); | |
599 | Note_Uplevel_Bound (Right_Opnd (N), Ref); | |
600 | ||
601 | -- Unary operator case | |
602 | ||
603 | elsif Nkind (N) in N_Unary_Op then | |
604 | Note_Uplevel_Bound (Right_Opnd (N), Ref); | |
605 | ||
0d756922 | 606 | -- Explicit dereference and selected component case |
ccc2a613 | 607 | |
92a68a04 HK |
608 | elsif Nkind_In (N, N_Explicit_Dereference, |
609 | N_Selected_Component) | |
0d756922 | 610 | then |
ccc2a613 ES |
611 | Note_Uplevel_Bound (Prefix (N), Ref); |
612 | ||
eedc5882 | 613 | -- Conditional expressions |
c3c41b29 ES |
614 | |
615 | elsif Nkind (N) = N_If_Expression then | |
616 | declare | |
617 | Expr : Node_Id; | |
618 | ||
619 | begin | |
620 | Expr := First (Expressions (N)); | |
621 | while Present (Expr) loop | |
622 | Note_Uplevel_Bound (Expr, Ref); | |
623 | Next (Expr); | |
624 | end loop; | |
625 | end; | |
626 | ||
627 | elsif Nkind (N) = N_Case_Expression then | |
628 | declare | |
629 | Alternative : Node_Id; | |
630 | ||
631 | begin | |
632 | Note_Uplevel_Bound (Expression (N), Ref); | |
633 | ||
634 | Alternative := First (Alternatives (N)); | |
635 | while Present (Alternative) loop | |
636 | Note_Uplevel_Bound (Expression (Alternative), Ref); | |
637 | end loop; | |
638 | end; | |
639 | ||
577ad216 | 640 | -- Conversion case |
5a271a7f | 641 | |
577ad216 RK |
642 | elsif Nkind (N) = N_Type_Conversion then |
643 | Note_Uplevel_Bound (Expression (N), Ref); | |
f8dae9bb AC |
644 | end if; |
645 | end Note_Uplevel_Bound; | |
5a271a7f | 646 | |
f8dae9bb | 647 | -- Start of processing for Check_Static_Type |
5a271a7f RD |
648 | |
649 | begin | |
f8dae9bb | 650 | -- If already marked static, immediate return |
5a271a7f | 651 | |
97c0b990 | 652 | if Is_Static_Type (T) and then not Check_Designated then |
f8dae9bb AC |
653 | return; |
654 | end if; | |
655 | ||
656 | -- If the type is at library level, always consider it static, | |
657 | -- since such uplevel references are irrelevant. | |
658 | ||
659 | if Is_Library_Level_Entity (T) then | |
660 | Set_Is_Static_Type (T); | |
661 | return; | |
662 | end if; | |
663 | ||
664 | -- Otherwise figure out what the story is with this type | |
665 | ||
666 | -- For a scalar type, check bounds | |
667 | ||
668 | if Is_Scalar_Type (T) then | |
669 | ||
670 | -- If both bounds static, then this is a static type | |
671 | ||
672 | declare | |
673 | LB : constant Node_Id := Type_Low_Bound (T); | |
674 | UB : constant Node_Id := Type_High_Bound (T); | |
675 | ||
676 | begin | |
677 | if not Is_Static_Expression (LB) then | |
577ad216 | 678 | Note_Uplevel_Bound (LB, N); |
f8dae9bb | 679 | DT := True; |
5a271a7f | 680 | end if; |
f8dae9bb AC |
681 | |
682 | if not Is_Static_Expression (UB) then | |
577ad216 | 683 | Note_Uplevel_Bound (UB, N); |
f8dae9bb AC |
684 | DT := True; |
685 | end if; | |
686 | end; | |
687 | ||
4fd9587f ES |
688 | -- For record type, check all components and discriminant |
689 | -- constraints if present. | |
f8dae9bb AC |
690 | |
691 | elsif Is_Record_Type (T) then | |
692 | declare | |
693 | C : Entity_Id; | |
4fd9587f ES |
694 | D : Elmt_Id; |
695 | ||
f8dae9bb AC |
696 | begin |
697 | C := First_Component_Or_Discriminant (T); | |
698 | while Present (C) loop | |
577ad216 | 699 | Check_Static_Type (Etype (C), N, DT); |
f8dae9bb AC |
700 | Next_Component_Or_Discriminant (C); |
701 | end loop; | |
4fd9587f ES |
702 | |
703 | if Has_Discriminants (T) | |
704 | and then Present (Discriminant_Constraint (T)) | |
705 | then | |
706 | D := First_Elmt (Discriminant_Constraint (T)); | |
707 | while Present (D) loop | |
708 | if not Is_Static_Expression (Node (D)) then | |
709 | Note_Uplevel_Bound (Node (D), N); | |
710 | DT := True; | |
711 | end if; | |
712 | ||
713 | Next_Elmt (D); | |
714 | end loop; | |
715 | end if; | |
f8dae9bb AC |
716 | end; |
717 | ||
356ffab8 | 718 | -- For array type, check index types and component type |
f8dae9bb AC |
719 | |
720 | elsif Is_Array_Type (T) then | |
721 | declare | |
722 | IX : Node_Id; | |
723 | begin | |
577ad216 | 724 | Check_Static_Type (Component_Type (T), N, DT); |
f8dae9bb AC |
725 | |
726 | IX := First_Index (T); | |
727 | while Present (IX) loop | |
577ad216 | 728 | Check_Static_Type (Etype (IX), N, DT); |
f8dae9bb AC |
729 | Next_Index (IX); |
730 | end loop; | |
731 | end; | |
732 | ||
268aeaa9 AC |
733 | -- For private type, examine whether full view is static |
734 | ||
97c0b990 ES |
735 | elsif Is_Incomplete_Or_Private_Type (T) |
736 | and then Present (Full_View (T)) | |
737 | then | |
738 | Check_Static_Type (Full_View (T), N, DT, Check_Designated); | |
268aeaa9 AC |
739 | |
740 | if Is_Static_Type (Full_View (T)) then | |
741 | Set_Is_Static_Type (T); | |
742 | end if; | |
743 | ||
6578a6bf | 744 | -- For access types, check designated type when required |
97c0b990 ES |
745 | |
746 | elsif Is_Access_Type (T) and then Check_Designated then | |
747 | Check_Static_Type (Directly_Designated_Type (T), N, DT); | |
748 | ||
f8dae9bb AC |
749 | -- For now, ignore other types |
750 | ||
751 | else | |
752 | return; | |
753 | end if; | |
754 | ||
755 | if not DT then | |
756 | Set_Is_Static_Type (T); | |
757 | end if; | |
758 | end Check_Static_Type; | |
759 | ||
760 | ---------------------- | |
761 | -- Note_Uplevel_Ref -- | |
762 | ---------------------- | |
763 | ||
764 | procedure Note_Uplevel_Ref | |
765 | (E : Entity_Id; | |
577ad216 | 766 | N : Node_Id; |
f8dae9bb AC |
767 | Caller : Entity_Id; |
768 | Callee : Entity_Id) | |
769 | is | |
577ad216 | 770 | Full_E : Entity_Id := E; |
f8dae9bb AC |
771 | begin |
772 | -- Nothing to do for static type | |
773 | ||
774 | if Is_Static_Type (E) then | |
775 | return; | |
776 | end if; | |
777 | ||
778 | -- Nothing to do if Caller and Callee are the same | |
779 | ||
780 | if Caller = Callee then | |
781 | return; | |
ec6cfc5d | 782 | |
356ffab8 AC |
783 | -- Callee may be a function that returns an array, and that has |
784 | -- been rewritten as a procedure. If caller is that procedure, | |
785 | -- nothing to do either. | |
ec6cfc5d AC |
786 | |
787 | elsif Ekind (Callee) = E_Function | |
788 | and then Rewritten_For_C (Callee) | |
888be6b1 | 789 | and then Corresponding_Procedure (Callee) = Caller |
ec6cfc5d AC |
790 | then |
791 | return; | |
ef8f9700 ES |
792 | |
793 | elsif Ekind_In (Callee, E_Entry, E_Entry_Family) then | |
794 | return; | |
f8dae9bb AC |
795 | end if; |
796 | ||
797 | -- We have a new uplevel referenced entity | |
798 | ||
577ad216 RK |
799 | if Ekind (E) = E_Constant and then Present (Full_View (E)) then |
800 | Full_E := Full_View (E); | |
801 | end if; | |
802 | ||
f8dae9bb | 803 | -- All we do at this stage is to add the uplevel reference to |
48bb06a7 | 804 | -- the table. It's too early to do anything else, since this |
f8dae9bb AC |
805 | -- uplevel reference may come from an unreachable subprogram |
806 | -- in which case the entry will be deleted. | |
807 | ||
577ad216 | 808 | Urefs.Append ((N, Full_E, Caller, Callee)); |
f8dae9bb | 809 | end Note_Uplevel_Ref; |
5a271a7f | 810 | |
5d514884 ES |
811 | ------------------------- |
812 | -- Register_Subprogram -- | |
813 | ------------------------- | |
814 | ||
815 | procedure Register_Subprogram (E : Entity_Id; Bod : Node_Id) is | |
816 | L : constant Nat := Get_Level (Subp, E); | |
0c506265 | 817 | |
5d514884 | 818 | begin |
c7862167 HK |
819 | -- Subprograms declared in tasks and protected types cannot be |
820 | -- eliminated because calls to them may be in other units, so | |
821 | -- they must be treated as reachable. | |
f2c2cdfb | 822 | |
5d514884 ES |
823 | Subps.Append |
824 | ((Ent => E, | |
825 | Bod => Bod, | |
826 | Lev => L, | |
c1326996 ES |
827 | Reachable => In_Synchronized_Unit (E) |
828 | or else Address_Taken (E), | |
5d514884 ES |
829 | Uplevel_Ref => L, |
830 | Declares_AREC => False, | |
831 | Uents => No_Elist, | |
832 | Last => 0, | |
833 | ARECnF => Empty, | |
834 | ARECn => Empty, | |
835 | ARECnT => Empty, | |
836 | ARECnPT => Empty, | |
837 | ARECnP => Empty, | |
838 | ARECnU => Empty)); | |
0c506265 | 839 | |
5d514884 | 840 | Set_Subps_Index (E, UI_From_Int (Subps.Last)); |
ef8f9700 ES |
841 | |
842 | -- If we marked this reachable because it's in a synchronized | |
843 | -- unit, we have to mark all enclosing subprograms as reachable | |
844 | -- as well. | |
845 | ||
846 | if In_Synchronized_Unit (E) then | |
847 | declare | |
848 | S : Entity_Id := E; | |
849 | ||
850 | begin | |
851 | for J in reverse 1 .. L - 1 loop | |
852 | S := Enclosing_Subprogram (S); | |
853 | Subps.Table (Subp_Index (S)).Reachable := True; | |
854 | end loop; | |
855 | end; | |
856 | end if; | |
5d514884 ES |
857 | end Register_Subprogram; |
858 | ||
5a271a7f RD |
859 | -- Start of processing for Visit_Node |
860 | ||
861 | begin | |
5d514884 | 862 | case Nkind (N) is |
3830827c | 863 | |
5d514884 | 864 | -- Record a subprogram call |
488f9623 | 865 | |
0c506265 HK |
866 | when N_Function_Call |
867 | | N_Procedure_Call_Statement | |
868 | => | |
5d514884 | 869 | -- We are only interested in direct calls, not indirect |
0c506265 HK |
870 | -- calls (where Name (N) is an explicit dereference) at |
871 | -- least for now! | |
488f9623 | 872 | |
5d514884 ES |
873 | if Nkind (Name (N)) in N_Has_Entity then |
874 | Ent := Entity (Name (N)); | |
5a271a7f | 875 | |
5d514884 ES |
876 | -- We are only interested in calls to subprograms nested |
877 | -- within Subp. Calls to Subp itself or to subprograms | |
878 | -- outside the nested structure do not affect us. | |
488f9623 | 879 | |
5d514884 ES |
880 | if Scope_Within (Ent, Subp) |
881 | and then Is_Subprogram (Ent) | |
882 | and then not Is_Imported (Ent) | |
883 | then | |
884 | Append_Unique_Call ((N, Current_Subprogram, Ent)); | |
885 | end if; | |
886 | end if; | |
d50a26f2 | 887 | |
5d514884 ES |
888 | -- For all calls where the formal is an unconstrained array |
889 | -- and the actual is constrained we need to check the bounds | |
890 | -- for uplevel references. | |
d50a26f2 | 891 | |
5d514884 | 892 | declare |
5d514884 | 893 | Actual : Entity_Id; |
5d514884 | 894 | DT : Boolean := False; |
0c506265 HK |
895 | Formal : Node_Id; |
896 | Subp : Entity_Id; | |
488f9623 | 897 | |
5d514884 ES |
898 | begin |
899 | if Nkind (Name (N)) = N_Explicit_Dereference then | |
900 | Subp := Etype (Name (N)); | |
184a6ba6 | 901 | else |
5d514884 ES |
902 | Subp := Entity (Name (N)); |
903 | end if; | |
488f9623 | 904 | |
5d514884 ES |
905 | Actual := First_Actual (N); |
906 | Formal := First_Formal_With_Extras (Subp); | |
907 | while Present (Actual) loop | |
908 | if Is_Array_Type (Etype (Formal)) | |
909 | and then not Is_Constrained (Etype (Formal)) | |
910 | and then Is_Constrained (Etype (Actual)) | |
911 | then | |
912 | Check_Static_Type (Etype (Actual), Empty, DT); | |
184a6ba6 | 913 | end if; |
488f9623 | 914 | |
5d514884 ES |
915 | Next_Actual (Actual); |
916 | Next_Formal_With_Extras (Formal); | |
917 | end loop; | |
918 | end; | |
184a6ba6 | 919 | |
0c506265 HK |
920 | -- An At_End_Proc in a statement sequence indicates that there |
921 | -- is a call from the enclosing construct or block to that | |
922 | -- subprogram. As above, the called entity must be local and | |
923 | -- not imported. | |
184a6ba6 | 924 | |
5d514884 ES |
925 | when N_Handled_Sequence_Of_Statements => |
926 | if Present (At_End_Proc (N)) | |
927 | and then Scope_Within (Entity (At_End_Proc (N)), Subp) | |
928 | and then not Is_Imported (Entity (At_End_Proc (N))) | |
929 | then | |
0c506265 HK |
930 | Append_Unique_Call |
931 | ((N, Current_Subprogram, Entity (At_End_Proc (N)))); | |
184a6ba6 ES |
932 | end if; |
933 | ||
e00ee732 ES |
934 | -- Similarly, the following constructs include a semantic |
935 | -- attribute Procedure_To_Call that must be handled like | |
fa42563a | 936 | -- other calls. Likewise for attribute Storage_Pool. |
e00ee732 ES |
937 | |
938 | when N_Allocator | |
e00ee732 | 939 | | N_Extended_Return_Statement |
07fb1ef4 | 940 | | N_Free_Statement |
e00ee732 ES |
941 | | N_Simple_Return_Statement |
942 | => | |
943 | declare | |
fa42563a | 944 | Pool : constant Entity_Id := Storage_Pool (N); |
e00ee732 | 945 | Proc : constant Entity_Id := Procedure_To_Call (N); |
fa42563a | 946 | |
e00ee732 ES |
947 | begin |
948 | if Present (Proc) | |
949 | and then Scope_Within (Proc, Subp) | |
950 | and then not Is_Imported (Proc) | |
951 | then | |
952 | Append_Unique_Call ((N, Current_Subprogram, Proc)); | |
953 | end if; | |
fa42563a ES |
954 | |
955 | if Present (Pool) | |
956 | and then not Is_Library_Level_Entity (Pool) | |
957 | and then Scope_Within_Or_Same (Scope (Pool), Subp) | |
958 | then | |
959 | Caller := Current_Subprogram; | |
960 | Callee := Enclosing_Subprogram (Pool); | |
961 | ||
962 | if Callee /= Caller then | |
963 | Note_Uplevel_Ref (Pool, Empty, Caller, Callee); | |
964 | end if; | |
965 | end if; | |
e00ee732 ES |
966 | end; |
967 | ||
ed6a6b4e GD |
968 | -- For an allocator with a qualified expression, check type |
969 | -- of expression being qualified. The explicit type name is | |
970 | -- handled as an entity reference. | |
fc0e632a ES |
971 | |
972 | if Nkind (N) = N_Allocator | |
1985767d | 973 | and then Nkind (Expression (N)) = N_Qualified_Expression |
fc0e632a ES |
974 | then |
975 | declare | |
976 | DT : Boolean := False; | |
977 | begin | |
978 | Check_Static_Type | |
979 | (Etype (Expression (Expression (N))), Empty, DT); | |
980 | end; | |
0d756922 ES |
981 | |
982 | -- For a Return or Free (all other nodes we handle here), | |
983 | -- we usually need the size of the object, so we need to be | |
984 | -- sure that any nonstatic bounds of the expression's type | |
985 | -- that are uplevel are handled. | |
986 | ||
987 | elsif Nkind (N) /= N_Allocator | |
988 | and then Present (Expression (N)) | |
989 | then | |
990 | declare | |
991 | DT : Boolean := False; | |
992 | begin | |
97c0b990 ES |
993 | Check_Static_Type |
994 | (Etype (Expression (N)), | |
995 | Empty, | |
996 | DT, | |
997 | Check_Designated => Nkind (N) = N_Free_Statement); | |
0d756922 | 998 | end; |
fc0e632a ES |
999 | end if; |
1000 | ||
4dd2ed14 ES |
1001 | -- A 'Access reference is a (potential) call. So is 'Address, |
1002 | -- in particular on imported subprograms. Other attributes | |
07fb1ef4 | 1003 | -- require special handling. |
184a6ba6 | 1004 | |
5d514884 ES |
1005 | when N_Attribute_Reference => |
1006 | declare | |
1007 | Attr : constant Attribute_Id := | |
1008 | Get_Attribute_Id (Attribute_Name (N)); | |
1009 | begin | |
1010 | case Attr is | |
1011 | when Attribute_Access | |
1012 | | Attribute_Unchecked_Access | |
1013 | | Attribute_Unrestricted_Access | |
4dd2ed14 | 1014 | | Attribute_Address |
5d514884 ES |
1015 | => |
1016 | if Nkind (Prefix (N)) in N_Has_Entity then | |
1017 | Ent := Entity (Prefix (N)); | |
1018 | ||
1019 | -- We only need to examine calls to subprograms | |
1020 | -- nested within current Subp. | |
1021 | ||
1022 | if Scope_Within (Ent, Subp) then | |
1023 | if Is_Imported (Ent) then | |
1024 | null; | |
1025 | ||
1026 | elsif Is_Subprogram (Ent) then | |
1027 | Append_Unique_Call | |
1028 | ((N, Current_Subprogram, Ent)); | |
1029 | end if; | |
1030 | end if; | |
1031 | end if; | |
184a6ba6 | 1032 | |
5d514884 ES |
1033 | -- References to bounds can be uplevel references if |
1034 | -- the type isn't static. | |
1035 | ||
1036 | when Attribute_First | |
1037 | | Attribute_Last | |
1038 | | Attribute_Length | |
1039 | => | |
1040 | -- Special-case attributes of objects whose bounds | |
1041 | -- may be uplevel references. More complex prefixes | |
1042 | -- handled during full traversal. Note that if the | |
1043 | -- nominal subtype of the prefix is unconstrained, | |
1044 | -- the bound must be obtained from the object, not | |
9b95ecdf GD |
1045 | -- from the (possibly) uplevel reference. We call |
1046 | -- Get_Referenced_Object to deal with prefixes that | |
1047 | -- are object renamings (prefixes that are types | |
1048 | -- can be passed and will simply be returned). | |
5d514884 | 1049 | |
9b95ecdf GD |
1050 | if Is_Constrained |
1051 | (Etype (Get_Referenced_Object (Prefix (N)))) | |
1052 | then | |
5d514884 ES |
1053 | declare |
1054 | DT : Boolean := False; | |
1055 | begin | |
0c506265 | 1056 | Check_Static_Type |
9b95ecdf GD |
1057 | (Etype (Get_Referenced_Object (Prefix (N))), |
1058 | Empty, | |
1059 | DT); | |
5d514884 ES |
1060 | end; |
1061 | ||
1062 | return OK; | |
1063 | end if; | |
999acab6 | 1064 | |
5d514884 ES |
1065 | when others => |
1066 | null; | |
1067 | end case; | |
1068 | end; | |
999acab6 | 1069 | |
07fb1ef4 HK |
1070 | -- Component associations in aggregates are either static or |
1071 | -- else the aggregate will be expanded into assignments, in | |
1072 | -- which case the expression is analyzed later and provides | |
392a7e19 ES |
1073 | -- no relevant code generation. |
1074 | ||
1075 | when N_Component_Association => | |
ccc2a613 ES |
1076 | if No (Expression (N)) |
1077 | or else No (Etype (Expression (N))) | |
1078 | then | |
392a7e19 ES |
1079 | return Skip; |
1080 | end if; | |
1081 | ||
d6cb7116 | 1082 | -- Generic associations are not analyzed: the actuals are |
3e6845df | 1083 | -- transferred to renaming and subtype declarations that |
d6cb7116 ES |
1084 | -- are the ones that must be examined. |
1085 | ||
1086 | when N_Generic_Association => | |
1087 | return Skip; | |
1088 | ||
5d514884 ES |
1089 | -- Indexed references can be uplevel if the type isn't static |
1090 | -- and if the lower bound (or an inner bound for a multi- | |
1091 | -- dimensional array) is uplevel. | |
40c21e91 | 1092 | |
400ad4e9 HK |
1093 | when N_Indexed_Component |
1094 | | N_Slice | |
1095 | => | |
5d514884 ES |
1096 | if Is_Constrained (Etype (Prefix (N))) then |
1097 | declare | |
1098 | DT : Boolean := False; | |
1099 | begin | |
1100 | Check_Static_Type (Etype (Prefix (N)), Empty, DT); | |
1101 | end; | |
1102 | end if; | |
f537fc00 | 1103 | |
5d514884 ES |
1104 | -- A selected component can have an implicit up-level |
1105 | -- reference due to the bounds of previous fields in the | |
1106 | -- record. We simplify the processing here by examining | |
1107 | -- all components of the record. | |
9ea43db6 | 1108 | |
5d514884 ES |
1109 | -- Selected components appear as unit names and end labels |
1110 | -- for child units. Prefixes of these nodes denote parent | |
1111 | -- units and carry no type information so they are skipped. | |
5fe0b8c3 | 1112 | |
5d514884 ES |
1113 | when N_Selected_Component => |
1114 | if Present (Etype (Prefix (N))) then | |
1115 | declare | |
1116 | DT : Boolean := False; | |
1117 | begin | |
1118 | Check_Static_Type (Etype (Prefix (N)), Empty, DT); | |
1119 | end; | |
1120 | end if; | |
40c21e91 | 1121 | |
ccc2a613 ES |
1122 | -- For EQ/NE comparisons, we need the type of the operands |
1123 | -- in order to do the comparison, which means we need the | |
1124 | -- bounds. | |
1125 | ||
400ad4e9 HK |
1126 | when N_Op_Eq |
1127 | | N_Op_Ne | |
1128 | => | |
ccc2a613 ES |
1129 | declare |
1130 | DT : Boolean := False; | |
1131 | begin | |
1132 | Check_Static_Type (Etype (Left_Opnd (N)), Empty, DT); | |
1133 | Check_Static_Type (Etype (Right_Opnd (N)), Empty, DT); | |
1134 | end; | |
1135 | ||
1136 | -- Likewise we need the sizes to compute how much to move in | |
1137 | -- an assignment. | |
1138 | ||
1139 | when N_Assignment_Statement => | |
1140 | declare | |
1141 | DT : Boolean := False; | |
1142 | begin | |
1143 | Check_Static_Type (Etype (Name (N)), Empty, DT); | |
1144 | Check_Static_Type (Etype (Expression (N)), Empty, DT); | |
1145 | end; | |
1146 | ||
5d514884 ES |
1147 | -- Record a subprogram. We record a subprogram body that acts |
1148 | -- as a spec. Otherwise we record a subprogram declaration, | |
1149 | -- providing that it has a corresponding body we can get hold | |
1150 | -- of. The case of no corresponding body being available is | |
1151 | -- ignored for now. | |
40c21e91 | 1152 | |
5d514884 ES |
1153 | when N_Subprogram_Body => |
1154 | Ent := Unique_Defining_Entity (N); | |
577ad216 | 1155 | |
5d514884 | 1156 | -- Ignore generic subprogram |
4fd9587f | 1157 | |
5d514884 ES |
1158 | if Is_Generic_Subprogram (Ent) then |
1159 | return Skip; | |
1160 | end if; | |
4fd9587f | 1161 | |
5d514884 | 1162 | -- Make new entry in subprogram table if not already made |
0c506265 | 1163 | |
5d514884 | 1164 | Register_Subprogram (Ent, N); |
14f8ba9a | 1165 | |
5d514884 ES |
1166 | -- We make a recursive call to scan the subprogram body, so |
1167 | -- that we can save and restore Current_Subprogram. | |
577ad216 | 1168 | |
5d514884 ES |
1169 | declare |
1170 | Save_CS : constant Entity_Id := Current_Subprogram; | |
1171 | Decl : Node_Id; | |
3830827c | 1172 | |
5d514884 ES |
1173 | begin |
1174 | Current_Subprogram := Ent; | |
f8dae9bb | 1175 | |
5d514884 | 1176 | -- Scan declarations |
f8dae9bb | 1177 | |
5d514884 ES |
1178 | Decl := First (Declarations (N)); |
1179 | while Present (Decl) loop | |
1180 | Visit (Decl); | |
1181 | Next (Decl); | |
1182 | end loop; | |
f8dae9bb | 1183 | |
5d514884 | 1184 | -- Scan statements |
f8dae9bb | 1185 | |
5d514884 | 1186 | Visit (Handled_Statement_Sequence (N)); |
f8dae9bb | 1187 | |
5d514884 | 1188 | -- Restore current subprogram setting |
3830827c | 1189 | |
5d514884 ES |
1190 | Current_Subprogram := Save_CS; |
1191 | end; | |
3830827c | 1192 | |
5d514884 ES |
1193 | -- Now at this level, return skipping the subprogram body |
1194 | -- descendants, since we already took care of them! | |
3830827c | 1195 | |
5d514884 | 1196 | return Skip; |
3830827c | 1197 | |
0c506265 HK |
1198 | -- If we have a body stub, visit the associated subunit, which |
1199 | -- is a semantic descendant of the stub. | |
3830827c | 1200 | |
5d514884 ES |
1201 | when N_Body_Stub => |
1202 | Visit (Library_Unit (N)); | |
3830827c | 1203 | |
5d514884 ES |
1204 | -- A declaration of a wrapper package indicates a subprogram |
1205 | -- instance for which there is no explicit body. Enter the | |
1206 | -- subprogram instance in the table. | |
f8dae9bb | 1207 | |
5d514884 ES |
1208 | when N_Package_Declaration => |
1209 | if Is_Wrapper_Package (Defining_Entity (N)) then | |
1210 | Register_Subprogram | |
1211 | (Related_Instance (Defining_Entity (N)), Empty); | |
1212 | end if; | |
f8dae9bb | 1213 | |
5d514884 | 1214 | -- Skip generic declarations |
f8dae9bb | 1215 | |
5d514884 ES |
1216 | when N_Generic_Declaration => |
1217 | return Skip; | |
1218 | ||
1219 | -- Skip generic package body | |
f8dae9bb | 1220 | |
5d514884 ES |
1221 | when N_Package_Body => |
1222 | if Present (Corresponding_Spec (N)) | |
1223 | and then Ekind (Corresponding_Spec (N)) = E_Generic_Package | |
1224 | then | |
1225 | return Skip; | |
1226 | end if; | |
f8dae9bb | 1227 | |
c7862167 HK |
1228 | -- Pragmas and component declarations are ignored. Quantified |
1229 | -- expressions are expanded into explicit loops and the | |
1230 | -- original epression must be ignored. | |
ccc2a613 | 1231 | |
400ad4e9 HK |
1232 | when N_Component_Declaration |
1233 | | N_Pragma | |
ef8f9700 | 1234 | | N_Quantified_Expression |
400ad4e9 | 1235 | => |
ccc2a613 ES |
1236 | return Skip; |
1237 | ||
ef8f9700 ES |
1238 | -- We want to skip the function spec for a generic function |
1239 | -- to avoid looking at any generic types that might be in | |
1240 | -- its formals. | |
1241 | ||
1242 | when N_Function_Specification => | |
1243 | if Is_Generic_Subprogram (Unique_Defining_Entity (N)) then | |
1244 | return Skip; | |
1245 | end if; | |
1246 | ||
400ad4e9 | 1247 | -- Otherwise record an uplevel reference in a local identifier |
f8dae9bb | 1248 | |
5d514884 | 1249 | when others => |
0c506265 HK |
1250 | if Nkind (N) in N_Has_Entity |
1251 | and then Present (Entity (N)) | |
5d514884 ES |
1252 | then |
1253 | Ent := Entity (N); | |
f8dae9bb | 1254 | |
5d514884 | 1255 | -- Only interested in entities declared within our nest |
f8dae9bb | 1256 | |
5d514884 ES |
1257 | if not Is_Library_Level_Entity (Ent) |
1258 | and then Scope_Within_Or_Same (Scope (Ent), Subp) | |
64f5d139 | 1259 | |
5d514884 | 1260 | -- Skip entities defined in inlined subprograms |
64f5d139 | 1261 | |
5d514884 ES |
1262 | and then |
1263 | Chars (Enclosing_Subprogram (Ent)) /= Name_uParent | |
f8dae9bb | 1264 | |
0c506265 HK |
1265 | -- Constants and variables are potentially uplevel |
1266 | -- references to global declarations. | |
f8dae9bb | 1267 | |
5d514884 | 1268 | and then |
400ad4e9 HK |
1269 | (Ekind_In (Ent, E_Constant, |
1270 | E_Loop_Parameter, | |
1271 | E_Variable) | |
f8dae9bb | 1272 | |
400ad4e9 HK |
1273 | -- Formals are interesting, but not if being used |
1274 | -- as mere names of parameters for name notation | |
1275 | -- calls. | |
f8dae9bb | 1276 | |
400ad4e9 HK |
1277 | or else |
1278 | (Is_Formal (Ent) | |
1279 | and then not | |
1280 | (Nkind (Parent (N)) = N_Parameter_Association | |
1281 | and then Selector_Name (Parent (N)) = N)) | |
f8dae9bb | 1282 | |
400ad4e9 HK |
1283 | -- Types other than known Is_Static types are |
1284 | -- potentially interesting. | |
f8dae9bb | 1285 | |
400ad4e9 HK |
1286 | or else |
1287 | (Is_Type (Ent) and then not Is_Static_Type (Ent))) | |
5d514884 ES |
1288 | then |
1289 | -- Here we have a potentially interesting uplevel | |
1290 | -- reference to examine. | |
f8dae9bb | 1291 | |
5d514884 ES |
1292 | if Is_Type (Ent) then |
1293 | declare | |
1294 | DT : Boolean := False; | |
f8dae9bb | 1295 | |
5d514884 ES |
1296 | begin |
1297 | Check_Static_Type (Ent, N, DT); | |
0d756922 | 1298 | return OK; |
5d514884 | 1299 | end; |
f8dae9bb | 1300 | end if; |
f8dae9bb | 1301 | |
5d514884 ES |
1302 | Caller := Current_Subprogram; |
1303 | Callee := Enclosing_Subprogram (Ent); | |
f8dae9bb | 1304 | |
5d514884 | 1305 | if Callee /= Caller |
ed6a6b4e GD |
1306 | and then (not Is_Static_Type (Ent) |
1307 | or else Needs_Fat_Pointer (Ent)) | |
5d514884 ES |
1308 | then |
1309 | Note_Uplevel_Ref (Ent, N, Caller, Callee); | |
b516a1a9 ES |
1310 | |
1311 | -- Check the type of a formal parameter of the current | |
1312 | -- subprogram, whose formal type may be an uplevel | |
1313 | -- reference. | |
1314 | ||
1315 | elsif Is_Formal (Ent) | |
1316 | and then Scope (Ent) = Current_Subprogram | |
1317 | then | |
1318 | declare | |
1319 | DT : Boolean := False; | |
1320 | ||
1321 | begin | |
1322 | Check_Static_Type (Etype (Ent), Empty, DT); | |
1323 | end; | |
5d514884 ES |
1324 | end if; |
1325 | end if; | |
f8dae9bb | 1326 | end if; |
5d514884 | 1327 | end case; |
5a271a7f | 1328 | |
f8dae9bb AC |
1329 | -- Fall through to continue scanning children of this node |
1330 | ||
5a271a7f RD |
1331 | return OK; |
1332 | end Visit_Node; | |
1333 | ||
89f0276a RD |
1334 | -- Start of processing for Build_Tables |
1335 | ||
5a271a7f | 1336 | begin |
f8dae9bb | 1337 | -- Traverse the body to get subprograms, calls and uplevel references |
89f0276a | 1338 | |
5a271a7f RD |
1339 | Visit (Subp_Body); |
1340 | end Build_Tables; | |
1341 | ||
f8dae9bb AC |
1342 | -- Now do the first transitive closure which determines which |
1343 | -- subprograms in the nest are actually reachable. | |
5a271a7f | 1344 | |
f8dae9bb | 1345 | Reachable_Closure : declare |
5a271a7f RD |
1346 | Modified : Boolean; |
1347 | ||
1348 | begin | |
3373589b | 1349 | Subps.Table (Subps_First).Reachable := True; |
f8dae9bb | 1350 | |
5a271a7f RD |
1351 | -- We use a simple minded algorithm as follows (obviously this can |
1352 | -- be done more efficiently, using one of the standard algorithms | |
1353 | -- for efficient transitive closure computation, but this is simple | |
1354 | -- and most likely fast enough that its speed does not matter). | |
1355 | ||
1356 | -- Repeatedly scan the list of calls. Any time we find a call from | |
f8dae9bb AC |
1357 | -- A to B, where A is reachable, but B is not, then B is reachable, |
1358 | -- and note that we have made a change by setting Modified True. We | |
1359 | -- repeat this until we make a pass with no modifications. | |
5a271a7f RD |
1360 | |
1361 | Outer : loop | |
1362 | Modified := False; | |
1363 | Inner : for J in Calls.First .. Calls.Last loop | |
f8dae9bb AC |
1364 | declare |
1365 | CTJ : Call_Entry renames Calls.Table (J); | |
1366 | ||
1367 | SINF : constant SI_Type := Subp_Index (CTJ.Caller); | |
1368 | SINT : constant SI_Type := Subp_Index (CTJ.Callee); | |
1369 | ||
1370 | SUBF : Subp_Entry renames Subps.Table (SINF); | |
1371 | SUBT : Subp_Entry renames Subps.Table (SINT); | |
1372 | ||
1373 | begin | |
1374 | if SUBF.Reachable and then not SUBT.Reachable then | |
1375 | SUBT.Reachable := True; | |
1376 | Modified := True; | |
1377 | end if; | |
1378 | end; | |
5a271a7f RD |
1379 | end loop Inner; |
1380 | ||
1381 | exit Outer when not Modified; | |
1382 | end loop Outer; | |
f8dae9bb AC |
1383 | end Reachable_Closure; |
1384 | ||
1385 | -- Remove calls from unreachable subprograms | |
1386 | ||
1387 | declare | |
1388 | New_Index : Nat; | |
1389 | ||
1390 | begin | |
1391 | New_Index := 0; | |
1392 | for J in Calls.First .. Calls.Last loop | |
1393 | declare | |
1394 | CTJ : Call_Entry renames Calls.Table (J); | |
1395 | ||
1396 | SINF : constant SI_Type := Subp_Index (CTJ.Caller); | |
1397 | SINT : constant SI_Type := Subp_Index (CTJ.Callee); | |
1398 | ||
1399 | SUBF : Subp_Entry renames Subps.Table (SINF); | |
1400 | SUBT : Subp_Entry renames Subps.Table (SINT); | |
1401 | ||
1402 | begin | |
1403 | if SUBF.Reachable then | |
1404 | pragma Assert (SUBT.Reachable); | |
1405 | New_Index := New_Index + 1; | |
1406 | Calls.Table (New_Index) := Calls.Table (J); | |
1407 | end if; | |
1408 | end; | |
1409 | end loop; | |
1410 | ||
1411 | Calls.Set_Last (New_Index); | |
1412 | end; | |
1413 | ||
1414 | -- Remove uplevel references from unreachable subprograms | |
1415 | ||
1416 | declare | |
1417 | New_Index : Nat; | |
1418 | ||
1419 | begin | |
1420 | New_Index := 0; | |
1421 | for J in Urefs.First .. Urefs.Last loop | |
1422 | declare | |
1423 | URJ : Uref_Entry renames Urefs.Table (J); | |
1424 | ||
1425 | SINF : constant SI_Type := Subp_Index (URJ.Caller); | |
1426 | SINT : constant SI_Type := Subp_Index (URJ.Callee); | |
1427 | ||
1428 | SUBF : Subp_Entry renames Subps.Table (SINF); | |
1429 | SUBT : Subp_Entry renames Subps.Table (SINT); | |
1430 | ||
1431 | S : Entity_Id; | |
1432 | ||
1433 | begin | |
1434 | -- Keep reachable reference | |
1435 | ||
1436 | if SUBF.Reachable then | |
1437 | New_Index := New_Index + 1; | |
1438 | Urefs.Table (New_Index) := Urefs.Table (J); | |
1439 | ||
1440 | -- And since we know we are keeping this one, this is a good | |
1441 | -- place to fill in information for a good reference. | |
1442 | ||
1443 | -- Mark all enclosing subprograms need to declare AREC | |
1444 | ||
1445 | S := URJ.Caller; | |
1446 | loop | |
1447 | S := Enclosing_Subprogram (S); | |
48bb06a7 | 1448 | |
400ad4e9 | 1449 | -- If we are at the top level, as can happen with |
48bb06a7 | 1450 | -- references to formals in aspects of nested subprogram |
400ad4e9 HK |
1451 | -- declarations, there are no further subprograms to mark |
1452 | -- as requiring activation records. | |
48bb06a7 AC |
1453 | |
1454 | exit when No (S); | |
ccc2a613 ES |
1455 | |
1456 | declare | |
1457 | SUBI : Subp_Entry renames Subps.Table (Subp_Index (S)); | |
1458 | begin | |
1459 | SUBI.Declares_AREC := True; | |
1460 | ||
1461 | -- If this entity was marked reachable because it is | |
1462 | -- in a task or protected type, there may not appear | |
c7862167 HK |
1463 | -- to be any calls to it, which would normally adjust |
1464 | -- the levels of the parent subprograms. So we need to | |
1465 | -- be sure that the uplevel reference of that entity | |
1466 | -- takes into account possible calls. | |
ccc2a613 ES |
1467 | |
1468 | if In_Synchronized_Unit (SUBF.Ent) | |
1469 | and then SUBT.Lev < SUBI.Uplevel_Ref | |
1470 | then | |
1471 | SUBI.Uplevel_Ref := SUBT.Lev; | |
1472 | end if; | |
1473 | end; | |
1474 | ||
f8dae9bb AC |
1475 | exit when S = URJ.Callee; |
1476 | end loop; | |
1477 | ||
1478 | -- Add to list of uplevel referenced entities for Callee. | |
1479 | -- We do not add types to this list, only actual references | |
1480 | -- to objects that will be referenced uplevel, and we use | |
1481 | -- the flag Is_Uplevel_Referenced_Entity to avoid making | |
c7862167 HK |
1482 | -- duplicate entries in the list. Discriminants are also |
1483 | -- excluded, only the enclosing object can appear in the | |
1484 | -- list. | |
f8dae9bb | 1485 | |
577ad216 RK |
1486 | if not Is_Uplevel_Referenced_Entity (URJ.Ent) |
1487 | and then Ekind (URJ.Ent) /= E_Discriminant | |
1488 | then | |
f8dae9bb | 1489 | Set_Is_Uplevel_Referenced_Entity (URJ.Ent); |
0d756922 | 1490 | Append_New_Elmt (URJ.Ent, SUBT.Uents); |
f8dae9bb AC |
1491 | end if; |
1492 | ||
1493 | -- And set uplevel indication for caller | |
1494 | ||
1495 | if SUBT.Lev < SUBF.Uplevel_Ref then | |
1496 | SUBF.Uplevel_Ref := SUBT.Lev; | |
1497 | end if; | |
1498 | end if; | |
1499 | end; | |
1500 | end loop; | |
1501 | ||
1502 | Urefs.Set_Last (New_Index); | |
1503 | end; | |
1504 | ||
1505 | -- Remove unreachable subprograms from Subps table. Note that we do | |
1506 | -- this after eliminating entries from the other two tables, since | |
3373589b | 1507 | -- those elimination steps depend on referencing the Subps table. |
f8dae9bb AC |
1508 | |
1509 | declare | |
1510 | New_SI : SI_Type; | |
1511 | ||
1512 | begin | |
3373589b | 1513 | New_SI := Subps_First - 1; |
ee935273 | 1514 | for J in Subps_First .. Subps.Last loop |
f8dae9bb AC |
1515 | declare |
1516 | STJ : Subp_Entry renames Subps.Table (J); | |
1517 | Spec : Node_Id; | |
1518 | Decl : Node_Id; | |
1519 | ||
1520 | begin | |
1521 | -- Subprogram is reachable, copy and reset index | |
1522 | ||
1523 | if STJ.Reachable then | |
1524 | New_SI := New_SI + 1; | |
1525 | Subps.Table (New_SI) := STJ; | |
1526 | Set_Subps_Index (STJ.Ent, UI_From_Int (New_SI)); | |
1527 | ||
1528 | -- Subprogram is not reachable | |
1529 | ||
1530 | else | |
1531 | -- Clear index, since no longer active | |
1532 | ||
1533 | Set_Subps_Index (Subps.Table (J).Ent, Uint_0); | |
1534 | ||
1535 | -- Output debug information if -gnatd.3 set | |
1536 | ||
1537 | if Debug_Flag_Dot_3 then | |
1538 | Write_Str ("Eliminate "); | |
1539 | Write_Name (Chars (Subps.Table (J).Ent)); | |
1540 | Write_Str (" at "); | |
1541 | Write_Location (Sloc (Subps.Table (J).Ent)); | |
1542 | Write_Str (" (not referenced)"); | |
1543 | Write_Eol; | |
1544 | end if; | |
1545 | ||
0d756922 ES |
1546 | -- Rewrite declaration, body, and corresponding freeze node |
1547 | -- to null statements. | |
f8dae9bb | 1548 | |
5d514884 ES |
1549 | -- A subprogram instantiation does not have an explicit |
1550 | -- body. If unused, we could remove the corresponding | |
1551 | -- wrapper package and its body (TBD). | |
f8dae9bb | 1552 | |
5d514884 ES |
1553 | if Present (STJ.Bod) then |
1554 | Spec := Corresponding_Spec (STJ.Bod); | |
f8dae9bb | 1555 | |
5d514884 ES |
1556 | if Present (Spec) then |
1557 | Decl := Parent (Declaration_Node (Spec)); | |
1558 | Rewrite (Decl, Make_Null_Statement (Sloc (Decl))); | |
0d756922 ES |
1559 | |
1560 | if Present (Freeze_Node (Spec)) then | |
1561 | Rewrite (Freeze_Node (Spec), | |
1562 | Make_Null_Statement (Sloc (Decl))); | |
1563 | end if; | |
5d514884 ES |
1564 | end if; |
1565 | ||
1566 | Rewrite (STJ.Bod, Make_Null_Statement (Sloc (STJ.Bod))); | |
1567 | end if; | |
f8dae9bb AC |
1568 | end if; |
1569 | end; | |
1570 | end loop; | |
1571 | ||
1572 | Subps.Set_Last (New_SI); | |
1573 | end; | |
1574 | ||
1575 | -- Now it is time for the second transitive closure, which follows calls | |
1576 | -- and makes sure that A calls B, and B has uplevel references, then A | |
1577 | -- is also marked as having uplevel references. | |
1578 | ||
1579 | Closure_Uplevel : declare | |
1580 | Modified : Boolean; | |
1581 | ||
1582 | begin | |
1583 | -- We use a simple minded algorithm as follows (obviously this can | |
1584 | -- be done more efficiently, using one of the standard algorithms | |
1585 | -- for efficient transitive closure computation, but this is simple | |
1586 | -- and most likely fast enough that its speed does not matter). | |
1587 | ||
1588 | -- Repeatedly scan the list of calls. Any time we find a call from | |
1589 | -- A to B, where B has uplevel references, make sure that A is marked | |
1590 | -- as having at least the same level of uplevel referencing. | |
1591 | ||
1592 | Outer2 : loop | |
1593 | Modified := False; | |
1594 | Inner2 : for J in Calls.First .. Calls.Last loop | |
1595 | declare | |
1596 | CTJ : Call_Entry renames Calls.Table (J); | |
1597 | SINF : constant SI_Type := Subp_Index (CTJ.Caller); | |
1598 | SINT : constant SI_Type := Subp_Index (CTJ.Callee); | |
1599 | SUBF : Subp_Entry renames Subps.Table (SINF); | |
1600 | SUBT : Subp_Entry renames Subps.Table (SINT); | |
1601 | begin | |
1602 | if SUBT.Lev > SUBT.Uplevel_Ref | |
1603 | and then SUBF.Uplevel_Ref > SUBT.Uplevel_Ref | |
1604 | then | |
1605 | SUBF.Uplevel_Ref := SUBT.Uplevel_Ref; | |
1606 | Modified := True; | |
1607 | end if; | |
1608 | end; | |
1609 | end loop Inner2; | |
1610 | ||
1611 | exit Outer2 when not Modified; | |
1612 | end loop Outer2; | |
1613 | end Closure_Uplevel; | |
1614 | ||
1615 | -- We have one more step before the tables are complete. An uplevel | |
1616 | -- call from subprogram A to subprogram B where subprogram B has uplevel | |
1617 | -- references is in effect an uplevel reference, and must arrange for | |
1618 | -- the proper activation link to be passed. | |
1619 | ||
1620 | for J in Calls.First .. Calls.Last loop | |
1621 | declare | |
1622 | CTJ : Call_Entry renames Calls.Table (J); | |
1623 | ||
1624 | SINF : constant SI_Type := Subp_Index (CTJ.Caller); | |
1625 | SINT : constant SI_Type := Subp_Index (CTJ.Callee); | |
1626 | ||
1627 | SUBF : Subp_Entry renames Subps.Table (SINF); | |
1628 | SUBT : Subp_Entry renames Subps.Table (SINT); | |
1629 | ||
1630 | A : Entity_Id; | |
1631 | ||
1632 | begin | |
1633 | -- If callee has uplevel references | |
1634 | ||
1635 | if SUBT.Uplevel_Ref < SUBT.Lev | |
1636 | ||
1637 | -- And this is an uplevel call | |
1638 | ||
1639 | and then SUBT.Lev < SUBF.Lev | |
1640 | then | |
1641 | -- We need to arrange for finding the uplink | |
1642 | ||
1643 | A := CTJ.Caller; | |
1644 | loop | |
1645 | A := Enclosing_Subprogram (A); | |
1646 | Subps.Table (Subp_Index (A)).Declares_AREC := True; | |
1647 | exit when A = CTJ.Callee; | |
1648 | ||
1649 | -- In any case exit when we get to the outer level. This | |
1650 | -- happens in some odd cases with generics (in particular | |
1651 | -- sem_ch3.adb does not compile without this kludge ???). | |
1652 | ||
1653 | exit when A = Subp; | |
1654 | end loop; | |
1655 | end if; | |
1656 | end; | |
1657 | end loop; | |
5a271a7f | 1658 | |
ee935273 AC |
1659 | -- The tables are now complete, so we can record the last index in the |
1660 | -- Subps table for later reference in Cprint. | |
1661 | ||
1662 | Subps.Table (Subps_First).Last := Subps.Last; | |
1663 | ||
3830827c AC |
1664 | -- Next step, create the entities for code we will insert. We do this |
1665 | -- at the start so that all the entities are defined, regardless of the | |
1666 | -- order in which we do the code insertions. | |
1667 | ||
ee935273 | 1668 | Create_Entities : for J in Subps_First .. Subps.Last loop |
3830827c AC |
1669 | declare |
1670 | STJ : Subp_Entry renames Subps.Table (J); | |
1671 | Loc : constant Source_Ptr := Sloc (STJ.Bod); | |
5a271a7f | 1672 | |
3830827c | 1673 | begin |
f8dae9bb AC |
1674 | -- First we create the ARECnF entity for the additional formal for |
1675 | -- all subprograms which need an activation record passed. | |
1676 | ||
1677 | if STJ.Uplevel_Ref < STJ.Lev then | |
3830827c | 1678 | STJ.ARECnF := |
551e1935 | 1679 | Make_Defining_Identifier (Loc, Chars => AREC_Name (J, "F")); |
3830827c AC |
1680 | end if; |
1681 | ||
f8dae9bb | 1682 | -- Define the AREC entities for the activation record if needed |
488f9623 | 1683 | |
f8dae9bb | 1684 | if STJ.Declares_AREC then |
3830827c | 1685 | STJ.ARECn := |
551e1935 | 1686 | Make_Defining_Identifier (Loc, AREC_Name (J, "")); |
3830827c | 1687 | STJ.ARECnT := |
551e1935 | 1688 | Make_Defining_Identifier (Loc, AREC_Name (J, "T")); |
3830827c | 1689 | STJ.ARECnPT := |
551e1935 | 1690 | Make_Defining_Identifier (Loc, AREC_Name (J, "PT")); |
3830827c | 1691 | STJ.ARECnP := |
551e1935 | 1692 | Make_Defining_Identifier (Loc, AREC_Name (J, "P")); |
3830827c | 1693 | |
f8dae9bb | 1694 | -- Define uplink component entity if inner nesting case |
3830827c | 1695 | |
f8dae9bb | 1696 | if Present (STJ.ARECnF) then |
551e1935 AC |
1697 | STJ.ARECnU := |
1698 | Make_Defining_Identifier (Loc, AREC_Name (J, "U")); | |
f8dae9bb | 1699 | end if; |
3830827c AC |
1700 | end if; |
1701 | end; | |
47a6f660 | 1702 | end loop Create_Entities; |
3830827c AC |
1703 | |
1704 | -- Loop through subprograms | |
1705 | ||
1706 | Subp_Loop : declare | |
73efc7ff | 1707 | Addr : Entity_Id := Empty; |
5a271a7f RD |
1708 | |
1709 | begin | |
ee935273 | 1710 | for J in Subps_First .. Subps.Last loop |
5a271a7f RD |
1711 | declare |
1712 | STJ : Subp_Entry renames Subps.Table (J); | |
1713 | ||
1714 | begin | |
3830827c | 1715 | -- First add the extra formal if needed. This applies to all |
488f9623 RD |
1716 | -- nested subprograms that require an activation record to be |
1717 | -- passed, as indicated by ARECnF being defined. | |
3830827c | 1718 | |
488f9623 | 1719 | if Present (STJ.ARECnF) then |
89f0276a RD |
1720 | |
1721 | -- Here we need the extra formal. We do the expansion and | |
1722 | -- analysis of this manually, since it is fairly simple, | |
1723 | -- and it is not obvious how we can get what we want if we | |
1724 | -- try to use the normal Analyze circuit. | |
1725 | ||
58009744 | 1726 | Add_Extra_Formal : declare |
89f0276a RD |
1727 | Encl : constant SI_Type := Enclosing_Subp (J); |
1728 | STJE : Subp_Entry renames Subps.Table (Encl); | |
1729 | -- Index and Subp_Entry for enclosing routine | |
1730 | ||
1731 | Form : constant Entity_Id := STJ.ARECnF; | |
1732 | -- The formal to be added. Note that n here is one less | |
1733 | -- than the level of the subprogram itself (STJ.Ent). | |
1734 | ||
89f0276a RD |
1735 | procedure Add_Form_To_Spec (F : Entity_Id; S : Node_Id); |
1736 | -- S is an N_Function/Procedure_Specification node, and F | |
58009744 AC |
1737 | -- is the new entity to add to this subprogramn spec as |
1738 | -- the last Extra_Formal. | |
89f0276a RD |
1739 | |
1740 | ---------------------- | |
1741 | -- Add_Form_To_Spec -- | |
1742 | ---------------------- | |
1743 | ||
1744 | procedure Add_Form_To_Spec (F : Entity_Id; S : Node_Id) is | |
d50a26f2 | 1745 | Sub : constant Entity_Id := Defining_Entity (S); |
58009744 | 1746 | Ent : Entity_Id; |
89f0276a RD |
1747 | |
1748 | begin | |
58009744 AC |
1749 | -- Case of at least one Extra_Formal is present, set |
1750 | -- ARECnF as the new last entry in the list. | |
1751 | ||
1752 | if Present (Extra_Formals (Sub)) then | |
1753 | Ent := Extra_Formals (Sub); | |
1754 | while Present (Extra_Formal (Ent)) loop | |
1755 | Ent := Extra_Formal (Ent); | |
1756 | end loop; | |
1757 | ||
1758 | Set_Extra_Formal (Ent, F); | |
1759 | ||
1760 | -- No Extra formals present | |
89f0276a RD |
1761 | |
1762 | else | |
58009744 AC |
1763 | Set_Extra_Formals (Sub, F); |
1764 | Ent := Last_Formal (Sub); | |
89f0276a | 1765 | |
58009744 AC |
1766 | if Present (Ent) then |
1767 | Set_Extra_Formal (Ent, F); | |
1768 | end if; | |
89f0276a | 1769 | end if; |
89f0276a RD |
1770 | end Add_Form_To_Spec; |
1771 | ||
58009744 | 1772 | -- Start of processing for Add_Extra_Formal |
89f0276a RD |
1773 | |
1774 | begin | |
1775 | -- Decorate the new formal entity | |
1776 | ||
7037d2bb ES |
1777 | Set_Scope (Form, STJ.Ent); |
1778 | Set_Ekind (Form, E_In_Parameter); | |
1779 | Set_Etype (Form, STJE.ARECnPT); | |
1780 | Set_Mechanism (Form, By_Copy); | |
1781 | Set_Never_Set_In_Source (Form, True); | |
1782 | Set_Analyzed (Form, True); | |
1783 | Set_Comes_From_Source (Form, False); | |
1784 | Set_Is_Activation_Record (Form, True); | |
89f0276a RD |
1785 | |
1786 | -- Case of only body present | |
1787 | ||
1788 | if Acts_As_Spec (STJ.Bod) then | |
1789 | Add_Form_To_Spec (Form, Specification (STJ.Bod)); | |
1790 | ||
1791 | -- Case of separate spec | |
1792 | ||
1793 | else | |
89f0276a | 1794 | Add_Form_To_Spec (Form, Parent (STJ.Ent)); |
89f0276a | 1795 | end if; |
58009744 | 1796 | end Add_Extra_Formal; |
3830827c AC |
1797 | end if; |
1798 | ||
f8dae9bb AC |
1799 | -- Processing for subprograms that declare an activation record |
1800 | ||
1801 | if Present (STJ.ARECn) then | |
5a271a7f | 1802 | |
3830827c AC |
1803 | -- Local declarations for one such subprogram |
1804 | ||
1805 | declare | |
1985767d HK |
1806 | Loc : constant Source_Ptr := Sloc (STJ.Bod); |
1807 | ||
1808 | Decls : constant List_Id := New_List; | |
1809 | -- List of new declarations we create | |
1810 | ||
5a271a7f | 1811 | Clist : List_Id; |
3830827c | 1812 | Comp : Entity_Id; |
5a271a7f | 1813 | |
1985767d | 1814 | Decl_Assign : Node_Id; |
8973b987 | 1815 | -- Assignment to set uplink, Empty if none |
1985767d | 1816 | |
89f0276a | 1817 | Decl_ARECnT : Node_Id; |
89f0276a | 1818 | Decl_ARECnPT : Node_Id; |
ee935273 | 1819 | Decl_ARECn : Node_Id; |
89f0276a RD |
1820 | Decl_ARECnP : Node_Id; |
1821 | -- Declaration nodes for the AREC entities we build | |
1822 | ||
5a271a7f | 1823 | begin |
c7862167 HK |
1824 | -- Build list of component declarations for ARECnT and |
1825 | -- load System.Address. | |
5a271a7f RD |
1826 | |
1827 | Clist := Empty_List; | |
1828 | ||
73efc7ff ES |
1829 | if No (Addr) then |
1830 | Addr := RTE (RE_Address); | |
1831 | end if; | |
1832 | ||
488f9623 | 1833 | -- If we are in a subprogram that has a static link that |
f8dae9bb | 1834 | -- is passed in (as indicated by ARECnF being defined), |
551e1935 AC |
1835 | -- then include ARECnU : ARECmPT where ARECmPT comes from |
1836 | -- the level one higher than the current level, and the | |
1837 | -- entity ARECnPT comes from the enclosing subprogram. | |
5a271a7f | 1838 | |
488f9623 | 1839 | if Present (STJ.ARECnF) then |
3830827c AC |
1840 | declare |
1841 | STJE : Subp_Entry | |
89f0276a | 1842 | renames Subps.Table (Enclosing_Subp (J)); |
3830827c AC |
1843 | begin |
1844 | Append_To (Clist, | |
1845 | Make_Component_Declaration (Loc, | |
1846 | Defining_Identifier => STJ.ARECnU, | |
1847 | Component_Definition => | |
1848 | Make_Component_Definition (Loc, | |
1849 | Subtype_Indication => | |
ee935273 | 1850 | New_Occurrence_Of (STJE.ARECnPT, Loc)))); |
3830827c | 1851 | end; |
5a271a7f RD |
1852 | end if; |
1853 | ||
1854 | -- Add components for uplevel referenced entities | |
1855 | ||
f8dae9bb AC |
1856 | if Present (STJ.Uents) then |
1857 | declare | |
fc0e632a ES |
1858 | Elmt : Elmt_Id; |
1859 | Ptr_Decl : Node_Id; | |
1860 | Uent : Entity_Id; | |
f8dae9bb | 1861 | |
551e1935 AC |
1862 | Indx : Nat; |
1863 | -- 1's origin of index in list of elements. This is | |
1864 | -- used to uniquify names if needed in Upref_Name. | |
1865 | ||
f8dae9bb AC |
1866 | begin |
1867 | Elmt := First_Elmt (STJ.Uents); | |
551e1935 | 1868 | Indx := 0; |
f8dae9bb AC |
1869 | while Present (Elmt) loop |
1870 | Uent := Node (Elmt); | |
551e1935 | 1871 | Indx := Indx + 1; |
f8dae9bb AC |
1872 | |
1873 | Comp := | |
1874 | Make_Defining_Identifier (Loc, | |
551e1935 | 1875 | Chars => Upref_Name (Uent, Indx, Clist)); |
f8dae9bb AC |
1876 | |
1877 | Set_Activation_Record_Component | |
1878 | (Uent, Comp); | |
1879 | ||
fc0e632a ES |
1880 | if Needs_Fat_Pointer (Uent) then |
1881 | ||
1882 | -- Build corresponding access type | |
f8dae9bb | 1883 | |
fc0e632a ES |
1884 | Ptr_Decl := |
1885 | Build_Access_Type_Decl | |
1886 | (Etype (Uent), STJ.Ent); | |
1887 | Append_To (Decls, Ptr_Decl); | |
1888 | ||
1889 | -- And use its type in the corresponding | |
1890 | -- component. | |
1891 | ||
1892 | Append_To (Clist, | |
1893 | Make_Component_Declaration (Loc, | |
1894 | Defining_Identifier => Comp, | |
1895 | Component_Definition => | |
1896 | Make_Component_Definition (Loc, | |
1897 | Subtype_Indication => | |
1898 | New_Occurrence_Of | |
1899 | (Defining_Identifier (Ptr_Decl), | |
1985767d | 1900 | Loc)))); |
fc0e632a ES |
1901 | else |
1902 | Append_To (Clist, | |
1903 | Make_Component_Declaration (Loc, | |
1904 | Defining_Identifier => Comp, | |
1905 | Component_Definition => | |
1906 | Make_Component_Definition (Loc, | |
1907 | Subtype_Indication => | |
1908 | New_Occurrence_Of (Addr, Loc)))); | |
1909 | end if; | |
f8dae9bb AC |
1910 | Next_Elmt (Elmt); |
1911 | end loop; | |
1912 | end; | |
1913 | end if; | |
5a271a7f RD |
1914 | |
1915 | -- Now we can insert the AREC declarations into the body | |
356ffab8 AC |
1916 | -- type ARECnT is record .. end record; |
1917 | -- pragma Suppress_Initialization (ARECnT); | |
1918 | ||
45fbea4f AC |
1919 | -- Note that we need to set the Suppress_Initialization |
1920 | -- flag after Decl_ARECnT has been analyzed. | |
89f0276a RD |
1921 | |
1922 | Decl_ARECnT := | |
1923 | Make_Full_Type_Declaration (Loc, | |
1924 | Defining_Identifier => STJ.ARECnT, | |
1925 | Type_Definition => | |
1926 | Make_Record_Definition (Loc, | |
1927 | Component_List => | |
1928 | Make_Component_List (Loc, | |
1929 | Component_Items => Clist))); | |
fc0e632a | 1930 | Append_To (Decls, Decl_ARECnT); |
89f0276a RD |
1931 | |
1932 | -- type ARECnPT is access all ARECnT; | |
1933 | ||
1934 | Decl_ARECnPT := | |
1935 | Make_Full_Type_Declaration (Loc, | |
1936 | Defining_Identifier => STJ.ARECnPT, | |
1937 | Type_Definition => | |
1938 | Make_Access_To_Object_Definition (Loc, | |
1939 | All_Present => True, | |
1940 | Subtype_Indication => | |
1941 | New_Occurrence_Of (STJ.ARECnT, Loc))); | |
ee935273 AC |
1942 | Append_To (Decls, Decl_ARECnPT); |
1943 | ||
1944 | -- ARECn : aliased ARECnT; | |
1945 | ||
1946 | Decl_ARECn := | |
1947 | Make_Object_Declaration (Loc, | |
1948 | Defining_Identifier => STJ.ARECn, | |
1949 | Aliased_Present => True, | |
1950 | Object_Definition => | |
1951 | New_Occurrence_Of (STJ.ARECnT, Loc)); | |
1952 | Append_To (Decls, Decl_ARECn); | |
89f0276a RD |
1953 | |
1954 | -- ARECnP : constant ARECnPT := ARECn'Access; | |
1955 | ||
1956 | Decl_ARECnP := | |
1957 | Make_Object_Declaration (Loc, | |
1958 | Defining_Identifier => STJ.ARECnP, | |
1959 | Constant_Present => True, | |
1960 | Object_Definition => | |
1961 | New_Occurrence_Of (STJ.ARECnPT, Loc), | |
1962 | Expression => | |
1963 | Make_Attribute_Reference (Loc, | |
1985767d | 1964 | Prefix => |
89f0276a RD |
1965 | New_Occurrence_Of (STJ.ARECn, Loc), |
1966 | Attribute_Name => Name_Access)); | |
ee935273 | 1967 | Append_To (Decls, Decl_ARECnP); |
89f0276a | 1968 | |
ee935273 AC |
1969 | -- If we are in a subprogram that has a static link that |
1970 | -- is passed in (as indicated by ARECnF being defined), | |
1971 | -- then generate ARECn.ARECmU := ARECmF where m is | |
1972 | -- one less than the current level to set the uplink. | |
1973 | ||
1974 | if Present (STJ.ARECnF) then | |
1975 | Decl_Assign := | |
1976 | Make_Assignment_Statement (Loc, | |
1977 | Name => | |
1978 | Make_Selected_Component (Loc, | |
1979 | Prefix => | |
1980 | New_Occurrence_Of (STJ.ARECn, Loc), | |
1981 | Selector_Name => | |
1982 | New_Occurrence_Of (STJ.ARECnU, Loc)), | |
1983 | Expression => | |
1984 | New_Occurrence_Of (STJ.ARECnF, Loc)); | |
1985 | Append_To (Decls, Decl_Assign); | |
1986 | ||
1987 | else | |
1988 | Decl_Assign := Empty; | |
1989 | end if; | |
1990 | ||
0d756922 ES |
1991 | if No (Declarations (STJ.Bod)) then |
1992 | Set_Declarations (STJ.Bod, Decls); | |
1993 | else | |
1994 | Prepend_List_To (Declarations (STJ.Bod), Decls); | |
1995 | end if; | |
89f0276a | 1996 | |
488f9623 RD |
1997 | -- Analyze the newly inserted declarations. Note that we |
1998 | -- do not need to establish the whole scope stack, since | |
1999 | -- we have already set all entity fields (so there will | |
2000 | -- be no searching of upper scopes to resolve names). But | |
2001 | -- we do set the scope of the current subprogram, so that | |
2002 | -- newly created entities go in the right entity chain. | |
89f0276a RD |
2003 | |
2004 | -- We analyze with all checks suppressed (since we do | |
f8dae9bb | 2005 | -- not expect any exceptions). |
89f0276a | 2006 | |
488f9623 | 2007 | Push_Scope (STJ.Ent); |
89f0276a | 2008 | Analyze (Decl_ARECnT, Suppress => All_Checks); |
90e7b558 AC |
2009 | |
2010 | -- Note that we need to call Set_Suppress_Initialization | |
2011 | -- after Decl_ARECnT has been analyzed, but before | |
2012 | -- analyzing Decl_ARECnP so that the flag is properly | |
2013 | -- taking into account. | |
2014 | ||
2015 | Set_Suppress_Initialization (STJ.ARECnT); | |
2016 | ||
89f0276a | 2017 | Analyze (Decl_ARECnPT, Suppress => All_Checks); |
ee935273 | 2018 | Analyze (Decl_ARECn, Suppress => All_Checks); |
89f0276a | 2019 | Analyze (Decl_ARECnP, Suppress => All_Checks); |
ee935273 AC |
2020 | |
2021 | if Present (Decl_Assign) then | |
90e7b558 | 2022 | Analyze (Decl_Assign, Suppress => All_Checks); |
ee935273 AC |
2023 | end if; |
2024 | ||
488f9623 | 2025 | Pop_Scope; |
3830827c AC |
2026 | |
2027 | -- Next step, for each uplevel referenced entity, add | |
f8dae9bb | 2028 | -- assignment operations to set the component in the |
3830827c AC |
2029 | -- activation record. |
2030 | ||
f8dae9bb | 2031 | if Present (STJ.Uents) then |
3830827c | 2032 | declare |
f8dae9bb | 2033 | Elmt : Elmt_Id; |
3830827c AC |
2034 | |
2035 | begin | |
f8dae9bb AC |
2036 | Elmt := First_Elmt (STJ.Uents); |
2037 | while Present (Elmt) loop | |
2038 | declare | |
2039 | Ent : constant Entity_Id := Node (Elmt); | |
2040 | Loc : constant Source_Ptr := Sloc (Ent); | |
2041 | Dec : constant Node_Id := | |
2042 | Declaration_Node (Ent); | |
1985767d | 2043 | |
fc0e632a ES |
2044 | Asn : Node_Id; |
2045 | Attr : Name_Id; | |
9e25affd | 2046 | Comp : Entity_Id; |
1985767d | 2047 | Ins : Node_Id; |
9e25affd | 2048 | Rhs : Node_Id; |
f8dae9bb AC |
2049 | |
2050 | begin | |
2051 | -- For parameters, we insert the assignment | |
2052 | -- right after the declaration of ARECnP. | |
400ad4e9 HK |
2053 | -- For all other entities, we insert the |
2054 | -- assignment immediately after the | |
2055 | -- declaration of the entity or after the | |
2056 | -- freeze node if present. | |
f8dae9bb AC |
2057 | |
2058 | -- Note: we don't need to mark the entity | |
2059 | -- as being aliased, because the address | |
2060 | -- attribute will mark it as Address_Taken, | |
2061 | -- and that is good enough. | |
2062 | ||
2063 | if Is_Formal (Ent) then | |
2064 | Ins := Decl_ARECnP; | |
ccc2a613 ES |
2065 | |
2066 | elsif Has_Delayed_Freeze (Ent) then | |
2067 | Ins := Freeze_Node (Ent); | |
2068 | ||
f8dae9bb AC |
2069 | else |
2070 | Ins := Dec; | |
2071 | end if; | |
2072 | ||
2073 | -- Build and insert the assignment: | |
2074 | -- ARECn.nam := nam'Address | |
fc0e632a ES |
2075 | -- or else 'Access for unconstrained array |
2076 | ||
2077 | if Needs_Fat_Pointer (Ent) then | |
2078 | Attr := Name_Access; | |
2079 | else | |
2080 | Attr := Name_Address; | |
2081 | end if; | |
f8dae9bb | 2082 | |
c7862167 HK |
2083 | Rhs := |
2084 | Make_Attribute_Reference (Loc, | |
2085 | Prefix => | |
2086 | New_Occurrence_Of (Ent, Loc), | |
2087 | Attribute_Name => Attr); | |
9e25affd ES |
2088 | |
2089 | -- If the entity is an unconstrained formal | |
2090 | -- we wrap the attribute reference in an | |
2091 | -- unchecked conversion to the type of the | |
2092 | -- activation record component, to prevent | |
2093 | -- spurious subtype conformance errors within | |
2094 | -- instances. | |
2095 | ||
2096 | if Is_Formal (Ent) | |
2097 | and then not Is_Constrained (Etype (Ent)) | |
2098 | then | |
c7862167 | 2099 | -- Find target component and its type |
9e25affd ES |
2100 | |
2101 | Comp := First_Component (STJ.ARECnT); | |
2102 | while Chars (Comp) /= Chars (Ent) loop | |
2103 | Comp := Next_Component (Comp); | |
2104 | end loop; | |
2105 | ||
c7862167 HK |
2106 | Rhs := |
2107 | Unchecked_Convert_To (Etype (Comp), Rhs); | |
9e25affd ES |
2108 | end if; |
2109 | ||
f8dae9bb AC |
2110 | Asn := |
2111 | Make_Assignment_Statement (Loc, | |
2112 | Name => | |
2113 | Make_Selected_Component (Loc, | |
2114 | Prefix => | |
2115 | New_Occurrence_Of (STJ.ARECn, Loc), | |
2116 | Selector_Name => | |
2117 | New_Occurrence_Of | |
2118 | (Activation_Record_Component | |
2119 | (Ent), | |
2120 | Loc)), | |
9e25affd | 2121 | Expression => Rhs); |
f8dae9bb | 2122 | |
ccc2a613 ES |
2123 | -- If we have a loop parameter, we have |
2124 | -- to insert before the first statement | |
2125 | -- of the loop. Ins points to the | |
ef8f9700 ES |
2126 | -- N_Loop_Parameter_Specification or to |
2127 | -- an N_Iterator_Specification. | |
2128 | ||
dd81163f HK |
2129 | if Nkind_In |
2130 | (Ins, N_Iterator_Specification, | |
2131 | N_Loop_Parameter_Specification) | |
ef8f9700 | 2132 | then |
dd81163f HK |
2133 | -- Quantified expression are rewritten as |
2134 | -- loops during expansion. | |
ef8f9700 ES |
2135 | |
2136 | if Nkind (Parent (Ins)) = | |
dd81163f | 2137 | N_Quantified_Expression |
ef8f9700 ES |
2138 | then |
2139 | null; | |
2140 | ||
2141 | else | |
2142 | Ins := | |
2143 | First | |
dd81163f HK |
2144 | (Statements |
2145 | (Parent (Parent (Ins)))); | |
ef8f9700 ES |
2146 | Insert_Before (Ins, Asn); |
2147 | end if; | |
ccc2a613 ES |
2148 | |
2149 | else | |
2150 | Insert_After (Ins, Asn); | |
2151 | end if; | |
f8dae9bb AC |
2152 | |
2153 | -- Analyze the assignment statement. We do | |
2154 | -- not need to establish the relevant scope | |
2155 | -- stack entries here, because we have | |
2156 | -- already set the correct entity references, | |
2157 | -- so no name resolution is required, and no | |
2158 | -- new entities are created, so we don't even | |
2159 | -- need to set the current scope. | |
2160 | ||
2161 | -- We analyze with all checks suppressed | |
2162 | -- (since we do not expect any exceptions). | |
2163 | ||
2164 | Analyze (Asn, Suppress => All_Checks); | |
2165 | end; | |
2166 | ||
2167 | Next_Elmt (Elmt); | |
2168 | end loop; | |
3830827c | 2169 | end; |
f8dae9bb | 2170 | end if; |
89f0276a RD |
2171 | end; |
2172 | end if; | |
2173 | end; | |
2174 | end loop; | |
2175 | end Subp_Loop; | |
3830827c | 2176 | |
89f0276a RD |
2177 | -- Next step, process uplevel references. This has to be done in a |
2178 | -- separate pass, after completing the processing in Sub_Loop because we | |
2179 | -- need all the AREC declarations generated, inserted, and analyzed so | |
2180 | -- that the uplevel references can be successfully analyzed. | |
3830827c | 2181 | |
f8dae9bb | 2182 | Uplev_Refs : for J in Urefs.First .. Urefs.Last loop |
89f0276a | 2183 | declare |
f8dae9bb | 2184 | UPJ : Uref_Entry renames Urefs.Table (J); |
3830827c | 2185 | |
89f0276a | 2186 | begin |
f8dae9bb AC |
2187 | -- Ignore type references, these are implicit references that do |
2188 | -- not need rewriting (e.g. the appearence in a conversion). | |
17d65c91 ES |
2189 | -- Also ignore if no reference was specified or if the rewriting |
2190 | -- has already been done (this can happen if the N_Identifier | |
143df1f9 GD |
2191 | -- occurs more than one time in the tree). Also ignore references |
2192 | -- when not generating C code (in particular for the case of LLVM, | |
2193 | -- since GNAT-LLVM will handle the processing for up-level refs). | |
17d65c91 | 2194 | |
0d756922 | 2195 | if No (UPJ.Ref) |
17d65c91 ES |
2196 | or else not Is_Entity_Name (UPJ.Ref) |
2197 | or else not Present (Entity (UPJ.Ref)) | |
143df1f9 | 2198 | or else not Opt.Generate_C_Code |
fed8bd87 RD |
2199 | then |
2200 | goto Continue; | |
2201 | end if; | |
2202 | ||
f8dae9bb | 2203 | -- Rewrite one reference |
3830827c | 2204 | |
f8dae9bb AC |
2205 | Rewrite_One_Ref : declare |
2206 | Loc : constant Source_Ptr := Sloc (UPJ.Ref); | |
2207 | -- Source location for the reference | |
3830827c | 2208 | |
f8dae9bb AC |
2209 | Typ : constant Entity_Id := Etype (UPJ.Ent); |
2210 | -- The type of the referenced entity | |
3830827c | 2211 | |
17d65c91 | 2212 | Atyp : Entity_Id; |
f8dae9bb | 2213 | -- The actual subtype of the reference |
84dad556 | 2214 | |
f8dae9bb AC |
2215 | RS_Caller : constant SI_Type := Subp_Index (UPJ.Caller); |
2216 | -- Subp_Index for caller containing reference | |
3830827c | 2217 | |
f8dae9bb AC |
2218 | STJR : Subp_Entry renames Subps.Table (RS_Caller); |
2219 | -- Subp_Entry for subprogram containing reference | |
3830827c | 2220 | |
f8dae9bb AC |
2221 | RS_Callee : constant SI_Type := Subp_Index (UPJ.Callee); |
2222 | -- Subp_Index for subprogram containing referenced entity | |
3830827c | 2223 | |
f8dae9bb AC |
2224 | STJE : Subp_Entry renames Subps.Table (RS_Callee); |
2225 | -- Subp_Entry for subprogram containing referenced entity | |
3830827c | 2226 | |
f8dae9bb AC |
2227 | Pfx : Node_Id; |
2228 | Comp : Entity_Id; | |
2229 | SI : SI_Type; | |
84dad556 | 2230 | |
f8dae9bb | 2231 | begin |
17d65c91 ES |
2232 | Atyp := Etype (UPJ.Ref); |
2233 | ||
2234 | if Ekind (Atyp) /= E_Record_Subtype then | |
2235 | Atyp := Get_Actual_Subtype (UPJ.Ref); | |
2236 | end if; | |
2237 | ||
f8dae9bb AC |
2238 | -- Ignore if no ARECnF entity for enclosing subprogram which |
2239 | -- probably happens as a result of not properly treating | |
2240 | -- instance bodies. To be examined ??? | |
84dad556 | 2241 | |
356ffab8 AC |
2242 | -- If this test is omitted, then the compilation of freeze.adb |
2243 | -- and inline.adb fail in unnesting mode. | |
84dad556 | 2244 | |
f8dae9bb AC |
2245 | if No (STJR.ARECnF) then |
2246 | goto Continue; | |
2247 | end if; | |
488f9623 | 2248 | |
1d499c15 ES |
2249 | -- If this is a reference to a global constant, use its value |
2250 | -- rather than create a reference. It is more efficient and | |
2251 | -- furthermore indispensable if the context requires a | |
2252 | -- constant, such as a branch of a case statement. | |
2253 | ||
2254 | if Ekind (UPJ.Ent) = E_Constant | |
2255 | and then Is_True_Constant (UPJ.Ent) | |
2256 | and then Present (Constant_Value (UPJ.Ent)) | |
2257 | and then Is_Static_Expression (Constant_Value (UPJ.Ent)) | |
2258 | then | |
68f27c97 | 2259 | Rewrite (UPJ.Ref, New_Copy_Tree (Constant_Value (UPJ.Ent))); |
1d499c15 ES |
2260 | goto Continue; |
2261 | end if; | |
2262 | ||
f8dae9bb AC |
2263 | -- Push the current scope, so that the pointer type Tnn, and |
2264 | -- any subsidiary entities resulting from the analysis of the | |
2265 | -- rewritten reference, go in the right entity chain. | |
488f9623 | 2266 | |
f8dae9bb | 2267 | Push_Scope (STJR.Ent); |
3830827c | 2268 | |
356ffab8 AC |
2269 | -- Now we need to rewrite the reference. We have a reference |
2270 | -- from level STJR.Lev to level STJE.Lev. The general form of | |
2271 | -- the rewritten reference for entity X is: | |
3830827c | 2272 | |
3ae9d953 | 2273 | -- Typ'Deref (ARECaF.ARECbU.ARECcU.ARECdU....ARECmU.X) |
3830827c | 2274 | |
f8dae9bb AC |
2275 | -- where a,b,c,d .. m = |
2276 | -- STJR.Lev - 1, STJR.Lev - 2, .. STJE.Lev | |
3830827c | 2277 | |
f8dae9bb | 2278 | pragma Assert (STJR.Lev > STJE.Lev); |
3830827c | 2279 | |
f8dae9bb AC |
2280 | -- Compute the prefix of X. Here are examples to make things |
2281 | -- clear (with parens to show groupings, the prefix is | |
2282 | -- everything except the .X at the end). | |
3830827c | 2283 | |
f8dae9bb | 2284 | -- level 2 to level 1 |
3830827c | 2285 | |
f8dae9bb | 2286 | -- AREC1F.X |
3830827c | 2287 | |
f8dae9bb | 2288 | -- level 3 to level 1 |
3830827c | 2289 | |
f8dae9bb | 2290 | -- (AREC2F.AREC1U).X |
3830827c | 2291 | |
f8dae9bb | 2292 | -- level 4 to level 1 |
3830827c | 2293 | |
f8dae9bb | 2294 | -- ((AREC3F.AREC2U).AREC1U).X |
3830827c | 2295 | |
f8dae9bb | 2296 | -- level 6 to level 2 |
89f0276a | 2297 | |
f8dae9bb | 2298 | -- (((AREC5F.AREC4U).AREC3U).AREC2U).X |
89f0276a | 2299 | |
ee935273 AC |
2300 | -- In the above, ARECnF and ARECnU are pointers, so there are |
2301 | -- explicit dereferences required for these occurrences. | |
2302 | ||
2303 | Pfx := | |
2304 | Make_Explicit_Dereference (Loc, | |
2305 | Prefix => New_Occurrence_Of (STJR.ARECnF, Loc)); | |
f8dae9bb AC |
2306 | SI := RS_Caller; |
2307 | for L in STJE.Lev .. STJR.Lev - 2 loop | |
2308 | SI := Enclosing_Subp (SI); | |
2309 | Pfx := | |
ee935273 AC |
2310 | Make_Explicit_Dereference (Loc, |
2311 | Prefix => | |
2312 | Make_Selected_Component (Loc, | |
2313 | Prefix => Pfx, | |
2314 | Selector_Name => | |
2315 | New_Occurrence_Of (Subps.Table (SI).ARECnU, Loc))); | |
f8dae9bb | 2316 | end loop; |
89f0276a | 2317 | |
f8dae9bb | 2318 | -- Get activation record component (must exist) |
89f0276a | 2319 | |
f8dae9bb AC |
2320 | Comp := Activation_Record_Component (UPJ.Ent); |
2321 | pragma Assert (Present (Comp)); | |
89f0276a | 2322 | |
ed6a6b4e GD |
2323 | -- Do the replacement. If the component type is an access type, |
2324 | -- this is an uplevel reference for an entity that requires a | |
2325 | -- fat pointer, so dereference the component. | |
fc0e632a ES |
2326 | |
2327 | if Is_Access_Type (Etype (Comp)) then | |
2328 | Rewrite (UPJ.Ref, | |
2329 | Make_Explicit_Dereference (Loc, | |
2330 | Prefix => | |
2331 | Make_Selected_Component (Loc, | |
2332 | Prefix => Pfx, | |
2333 | Selector_Name => | |
2334 | New_Occurrence_Of (Comp, Loc)))); | |
2335 | ||
2336 | else | |
2337 | Rewrite (UPJ.Ref, | |
2338 | Make_Attribute_Reference (Loc, | |
2339 | Prefix => New_Occurrence_Of (Atyp, Loc), | |
2340 | Attribute_Name => Name_Deref, | |
2341 | Expressions => New_List ( | |
2342 | Make_Selected_Component (Loc, | |
2343 | Prefix => Pfx, | |
2344 | Selector_Name => | |
2345 | New_Occurrence_Of (Comp, Loc))))); | |
2346 | end if; | |
89f0276a | 2347 | |
f8dae9bb AC |
2348 | -- Analyze and resolve the new expression. We do not need to |
2349 | -- establish the relevant scope stack entries here, because we | |
2350 | -- have already set all the correct entity references, so no | |
2351 | -- name resolution is needed. We have already set the current | |
2352 | -- scope, so that any new entities created will be in the right | |
2353 | -- scope. | |
89f0276a | 2354 | |
f8dae9bb AC |
2355 | -- We analyze with all checks suppressed (since we do not |
2356 | -- expect any exceptions) | |
89f0276a | 2357 | |
f8dae9bb | 2358 | Analyze_And_Resolve (UPJ.Ref, Typ, Suppress => All_Checks); |
3af796b5 JM |
2359 | |
2360 | -- Generate an extra temporary to facilitate the C backend | |
2361 | -- processing this dereference | |
2362 | ||
2363 | if Opt.Modify_Tree_For_C | |
2364 | and then Nkind_In (Parent (UPJ.Ref), | |
2365 | N_Type_Conversion, | |
2366 | N_Unchecked_Type_Conversion) | |
2367 | then | |
2368 | Force_Evaluation (UPJ.Ref, Mode => Strict); | |
2369 | end if; | |
2370 | ||
f8dae9bb AC |
2371 | Pop_Scope; |
2372 | end Rewrite_One_Ref; | |
89f0276a | 2373 | end; |
f8dae9bb AC |
2374 | |
2375 | <<Continue>> | |
2376 | null; | |
89f0276a | 2377 | end loop Uplev_Refs; |
3830827c AC |
2378 | |
2379 | -- Finally, loop through all calls adding extra actual for the | |
2380 | -- activation record where it is required. | |
5a271a7f | 2381 | |
89f0276a RD |
2382 | Adjust_Calls : for J in Calls.First .. Calls.Last loop |
2383 | ||
2384 | -- Process a single call, we are only interested in a call to a | |
488f9623 | 2385 | -- subprogram that actually needs a pointer to an activation record, |
89f0276a RD |
2386 | -- as indicated by the ARECnF entity being set. This excludes the |
2387 | -- top level subprogram, and any subprogram not having uplevel refs. | |
2388 | ||
488f9623 | 2389 | Adjust_One_Call : declare |
89f0276a | 2390 | CTJ : Call_Entry renames Calls.Table (J); |
f8dae9bb AC |
2391 | STF : Subp_Entry renames Subps.Table (Subp_Index (CTJ.Caller)); |
2392 | STT : Subp_Entry renames Subps.Table (Subp_Index (CTJ.Callee)); | |
488f9623 RD |
2393 | |
2394 | Loc : constant Source_Ptr := Sloc (CTJ.N); | |
2395 | ||
2396 | Extra : Node_Id; | |
2397 | ExtraP : Node_Id; | |
2398 | SubX : SI_Type; | |
2399 | Act : Node_Id; | |
89f0276a RD |
2400 | |
2401 | begin | |
40c21e91 | 2402 | if Present (STT.ARECnF) |
392a7e19 | 2403 | and then Nkind (CTJ.N) in N_Subprogram_Call |
40c21e91 | 2404 | then |
356ffab8 AC |
2405 | -- CTJ.N is a call to a subprogram which may require a pointer |
2406 | -- to an activation record. The subprogram containing the call | |
2407 | -- is CTJ.From and the subprogram being called is CTJ.To, so we | |
2408 | -- have a call from level STF.Lev to level STT.Lev. | |
89f0276a | 2409 | |
488f9623 | 2410 | -- There are three possibilities: |
89f0276a | 2411 | |
488f9623 RD |
2412 | -- For a call to the same level, we just pass the activation |
2413 | -- record passed to the calling subprogram. | |
89f0276a | 2414 | |
488f9623 RD |
2415 | if STF.Lev = STT.Lev then |
2416 | Extra := New_Occurrence_Of (STF.ARECnF, Loc); | |
89f0276a | 2417 | |
356ffab8 AC |
2418 | -- For a call that goes down a level, we pass a pointer to the |
2419 | -- activation record constructed within the caller (which may | |
2420 | -- be the outer-level subprogram, but also may be a more deeply | |
2421 | -- nested caller). | |
89f0276a | 2422 | |
488f9623 RD |
2423 | elsif STT.Lev = STF.Lev + 1 then |
2424 | Extra := New_Occurrence_Of (STF.ARECnP, Loc); | |
89f0276a | 2425 | |
488f9623 RD |
2426 | -- Otherwise we must have an upcall (STT.Lev < STF.LEV), |
2427 | -- since it is not possible to do a downcall of more than | |
2428 | -- one level. | |
89f0276a | 2429 | |
488f9623 RD |
2430 | -- For a call from level STF.Lev to level STT.Lev, we |
2431 | -- have to find the activation record needed by the | |
2432 | -- callee. This is as follows: | |
89f0276a | 2433 | |
7ddbf09d | 2434 | -- ARECaF.ARECbU.ARECcU....ARECmU |
89f0276a | 2435 | |
488f9623 RD |
2436 | -- where a,b,c .. m = |
2437 | -- STF.Lev - 1, STF.Lev - 2, STF.Lev - 3 .. STT.Lev | |
89f0276a | 2438 | |
488f9623 RD |
2439 | else |
2440 | pragma Assert (STT.Lev < STF.Lev); | |
89f0276a | 2441 | |
488f9623 | 2442 | Extra := New_Occurrence_Of (STF.ARECnF, Loc); |
356ffab8 | 2443 | SubX := Subp_Index (CTJ.Caller); |
488f9623 | 2444 | for K in reverse STT.Lev .. STF.Lev - 1 loop |
356ffab8 | 2445 | SubX := Enclosing_Subp (SubX); |
488f9623 RD |
2446 | Extra := |
2447 | Make_Selected_Component (Loc, | |
2448 | Prefix => Extra, | |
2449 | Selector_Name => | |
2450 | New_Occurrence_Of | |
2451 | (Subps.Table (SubX).ARECnU, Loc)); | |
2452 | end loop; | |
2453 | end if; | |
89f0276a | 2454 | |
488f9623 RD |
2455 | -- Extra is the additional parameter to be added. Build a |
2456 | -- parameter association that we can append to the actuals. | |
89f0276a | 2457 | |
488f9623 RD |
2458 | ExtraP := |
2459 | Make_Parameter_Association (Loc, | |
2460 | Selector_Name => | |
2461 | New_Occurrence_Of (STT.ARECnF, Loc), | |
2462 | Explicit_Actual_Parameter => Extra); | |
89f0276a | 2463 | |
488f9623 RD |
2464 | if No (Parameter_Associations (CTJ.N)) then |
2465 | Set_Parameter_Associations (CTJ.N, Empty_List); | |
2466 | end if; | |
89f0276a | 2467 | |
488f9623 | 2468 | Append (ExtraP, Parameter_Associations (CTJ.N)); |
89f0276a | 2469 | |
356ffab8 AC |
2470 | -- We need to deal with the actual parameter chain as well. The |
2471 | -- newly added parameter is always the last actual. | |
89f0276a | 2472 | |
488f9623 | 2473 | Act := First_Named_Actual (CTJ.N); |
89f0276a | 2474 | |
488f9623 RD |
2475 | if No (Act) then |
2476 | Set_First_Named_Actual (CTJ.N, Extra); | |
89f0276a | 2477 | |
577ad216 RK |
2478 | -- If call has been relocated (as with an expression in |
2479 | -- an aggregate), set First_Named pointer in original node | |
2480 | -- as well, because that's the parent of the parameter list. | |
2481 | ||
2482 | Set_First_Named_Actual | |
2483 | (Parent (List_Containing (ExtraP)), Extra); | |
2484 | ||
488f9623 | 2485 | -- Here we must follow the chain and append the new entry |
89f0276a | 2486 | |
488f9623 RD |
2487 | else |
2488 | loop | |
2489 | declare | |
2490 | PAN : Node_Id; | |
2491 | NNA : Node_Id; | |
89f0276a | 2492 | |
488f9623 RD |
2493 | begin |
2494 | PAN := Parent (Act); | |
2495 | pragma Assert (Nkind (PAN) = N_Parameter_Association); | |
2496 | NNA := Next_Named_Actual (PAN); | |
89f0276a | 2497 | |
488f9623 RD |
2498 | if No (NNA) then |
2499 | Set_Next_Named_Actual (PAN, Extra); | |
2500 | exit; | |
2501 | end if; | |
89f0276a | 2502 | |
488f9623 RD |
2503 | Act := NNA; |
2504 | end; | |
2505 | end loop; | |
2506 | end if; | |
2507 | ||
2508 | -- Analyze and resolve the new actual. We do not need to | |
2509 | -- establish the relevant scope stack entries here, because | |
2510 | -- we have already set all the correct entity references, so | |
2511 | -- no name resolution is needed. | |
2512 | ||
2513 | -- We analyze with all checks suppressed (since we do not | |
2514 | -- expect any exceptions, and also we temporarily turn off | |
2515 | -- Unested_Subprogram_Mode to avoid trying to mark uplevel | |
2516 | -- references (not needed at this stage, and in fact causes | |
2517 | -- a bit of recursive chaos). | |
2518 | ||
2519 | Opt.Unnest_Subprogram_Mode := False; | |
2520 | Analyze_And_Resolve | |
2521 | (Extra, Etype (STT.ARECnF), Suppress => All_Checks); | |
2522 | Opt.Unnest_Subprogram_Mode := True; | |
89f0276a | 2523 | end if; |
488f9623 | 2524 | end Adjust_One_Call; |
89f0276a | 2525 | end loop Adjust_Calls; |
5a271a7f RD |
2526 | |
2527 | return; | |
2528 | end Unnest_Subprogram; | |
2529 | ||
29a56f61 JM |
2530 | ------------------------ |
2531 | -- Unnest_Subprograms -- | |
2532 | ------------------------ | |
2533 | ||
2534 | procedure Unnest_Subprograms (N : Node_Id) is | |
29a56f61 JM |
2535 | function Search_Subprograms (N : Node_Id) return Traverse_Result; |
2536 | -- Tree visitor that search for outer level procedures with nested | |
2537 | -- subprograms and invokes Unnest_Subprogram() | |
2538 | ||
345bb755 ES |
2539 | --------------- |
2540 | -- Do_Search -- | |
2541 | --------------- | |
2542 | ||
2543 | procedure Do_Search is new Traverse_Proc (Search_Subprograms); | |
2544 | -- Subtree visitor instantiation | |
2545 | ||
29a56f61 JM |
2546 | ------------------------ |
2547 | -- Search_Subprograms -- | |
2548 | ------------------------ | |
2549 | ||
2550 | function Search_Subprograms (N : Node_Id) return Traverse_Result is | |
2551 | begin | |
2cc7967f | 2552 | if Nkind_In (N, N_Subprogram_Body, N_Subprogram_Body_Stub) then |
29a56f61 JM |
2553 | declare |
2554 | Spec_Id : constant Entity_Id := Unique_Defining_Entity (N); | |
2555 | ||
2556 | begin | |
2557 | -- We are only interested in subprograms (not generic | |
2558 | -- subprograms), that have nested subprograms. | |
2559 | ||
2560 | if Is_Subprogram (Spec_Id) | |
2561 | and then Has_Nested_Subprogram (Spec_Id) | |
2562 | and then Is_Library_Level_Entity (Spec_Id) | |
2563 | then | |
2564 | Unnest_Subprogram (Spec_Id, N); | |
2565 | end if; | |
2566 | end; | |
29a56f61 | 2567 | |
1985767d HK |
2568 | -- The proper body of a stub may contain nested subprograms, and |
2569 | -- therefore must be visited explicitly. Nested stubs are examined | |
2570 | -- recursively in Visit_Node. | |
29a56f61 | 2571 | |
0d756922 | 2572 | elsif Nkind (N) in N_Body_Stub then |
345bb755 | 2573 | Do_Search (Library_Unit (N)); |
ef8f9700 ES |
2574 | |
2575 | -- Skip generic packages | |
2576 | ||
2577 | elsif Nkind (N) = N_Package_Body | |
2578 | and then Ekind (Corresponding_Spec (N)) = E_Generic_Package | |
2579 | then | |
2580 | return Skip; | |
345bb755 | 2581 | end if; |
29a56f61 | 2582 | |
345bb755 ES |
2583 | return OK; |
2584 | end Search_Subprograms; | |
29a56f61 | 2585 | |
dd241b94 AC |
2586 | Subp : Entity_Id; |
2587 | Subp_Body : Node_Id; | |
2588 | ||
29a56f61 JM |
2589 | -- Start of processing for Unnest_Subprograms |
2590 | ||
2591 | begin | |
17d65c91 | 2592 | if not Opt.Unnest_Subprogram_Mode or not Opt.Expander_Active then |
29a56f61 JM |
2593 | return; |
2594 | end if; | |
2595 | ||
0c506265 HK |
2596 | -- A specification will contain bodies if it contains instantiations so |
2597 | -- examine package or subprogram declaration of the main unit, when it | |
2598 | -- is present. | |
8ed508fe ES |
2599 | |
2600 | if Nkind (Unit (N)) = N_Package_Body | |
0c506265 HK |
2601 | or else (Nkind (Unit (N)) = N_Subprogram_Body |
2602 | and then not Acts_As_Spec (N)) | |
8ed508fe ES |
2603 | then |
2604 | Do_Search (Library_Unit (N)); | |
2605 | end if; | |
2606 | ||
29a56f61 | 2607 | Do_Search (N); |
dd241b94 AC |
2608 | |
2609 | -- Unnest any subprograms passed on the list of inlined subprograms | |
2610 | ||
2611 | Subp := First_Inlined_Subprogram (N); | |
2612 | ||
2613 | while Present (Subp) loop | |
2614 | Subp_Body := Parent (Declaration_Node (Subp)); | |
2615 | ||
2616 | if Nkind (Subp_Body) = N_Subprogram_Declaration | |
2617 | and then Present (Corresponding_Body (Subp_Body)) | |
2618 | then | |
2619 | Subp_Body := Parent (Declaration_Node | |
2620 | (Corresponding_Body (Subp_Body))); | |
dd241b94 AC |
2621 | end if; |
2622 | ||
27785539 | 2623 | Unnest_Subprogram (Subp, Subp_Body, For_Inline => True); |
dd241b94 AC |
2624 | Next_Inlined_Subprogram (Subp); |
2625 | end loop; | |
29a56f61 JM |
2626 | end Unnest_Subprograms; |
2627 | ||
5a271a7f | 2628 | end Exp_Unst; |