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