]>
Commit | Line | Data |
---|---|---|
19235870 RK |
1 | ------------------------------------------------------------------------------ |
2 | -- -- | |
3 | -- GNAT COMPILER COMPONENTS -- | |
4 | -- -- | |
5 | -- R T S F I N D -- | |
6 | -- -- | |
7 | -- B o d y -- | |
8 | -- -- | |
fbf5a39b | 9 | -- Copyright (C) 1992-2003, Free Software Foundation, Inc. -- |
19235870 RK |
10 | -- -- |
11 | -- GNAT is free software; you can redistribute it and/or modify it under -- | |
12 | -- terms of the GNU General Public License as published by the Free Soft- -- | |
13 | -- ware Foundation; either version 2, or (at your option) any later ver- -- | |
14 | -- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- | |
15 | -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- | |
16 | -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- | |
17 | -- for more details. You should have received a copy of the GNU General -- | |
18 | -- Public License distributed with GNAT; see file COPYING. If not, write -- | |
19 | -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, -- | |
20 | -- MA 02111-1307, USA. -- | |
21 | -- -- | |
22 | -- GNAT was originally developed by the GNAT team at New York University. -- | |
71ff80dc | 23 | -- Extensive contributions were provided by Ada Core Technologies Inc. -- |
19235870 RK |
24 | -- -- |
25 | ------------------------------------------------------------------------------ | |
26 | ||
fbf5a39b AC |
27 | with Atree; use Atree; |
28 | with Casing; use Casing; | |
29 | with Csets; use Csets; | |
30 | with Debug; use Debug; | |
31 | with Einfo; use Einfo; | |
32 | with Elists; use Elists; | |
33 | with Errout; use Errout; | |
34 | with Fname; use Fname; | |
35 | with Fname.UF; use Fname.UF; | |
36 | with Lib; use Lib; | |
37 | with Lib.Load; use Lib.Load; | |
38 | with Namet; use Namet; | |
39 | with Nlists; use Nlists; | |
40 | with Nmake; use Nmake; | |
41 | with Output; use Output; | |
42 | with Opt; use Opt; | |
43 | with Sem; use Sem; | |
44 | with Sem_Ch7; use Sem_Ch7; | |
45 | with Sem_Util; use Sem_Util; | |
46 | with Sinfo; use Sinfo; | |
47 | with Stand; use Stand; | |
48 | with Snames; use Snames; | |
49 | with Tbuild; use Tbuild; | |
50 | with Uname; use Uname; | |
19235870 RK |
51 | |
52 | package body Rtsfind is | |
53 | ||
fbf5a39b AC |
54 | RTE_Available_Call : Boolean := False; |
55 | -- Set True during call to RTE from RTE_Available. Tells RTE to set | |
56 | -- RTE_Is_Available to False rather than generating an error message. | |
57 | ||
58 | RTE_Is_Available : Boolean; | |
59 | -- Set True by RTE_Available on entry. When RTE_Available_Call is set | |
60 | -- True, set False if RTE would otherwise generate an error message. | |
61 | ||
19235870 RK |
62 | ---------------- |
63 | -- Unit table -- | |
64 | ---------------- | |
65 | ||
66 | -- The unit table has one entry for each unit included in the definition | |
67 | -- of the type RTU_Id in the spec. The table entries are initialized in | |
68 | -- Initialize to set the Entity field to Empty, indicating that the | |
69 | -- corresponding unit has not yet been loaded. The fields are set when | |
70 | -- a unit is loaded to contain the defining entity for the unit, the | |
71 | -- unit name, and the unit number. | |
72 | ||
73 | type RT_Unit_Table_Record is record | |
74 | Entity : Entity_Id; | |
75 | Uname : Unit_Name_Type; | |
76 | Unum : Unit_Number_Type; | |
77 | Withed : Boolean; | |
78 | end record; | |
79 | ||
80 | RT_Unit_Table : array (RTU_Id) of RT_Unit_Table_Record; | |
81 | ||
82 | -------------------------- | |
83 | -- Runtime Entity Table -- | |
84 | -------------------------- | |
85 | ||
86 | -- There is one entry in the runtime entity table for each entity that is | |
87 | -- included in the definition of the RE_Id type in the spec. The entries | |
88 | -- are set by Initialize_Rtsfind to contain Empty, indicating that the | |
89 | -- entity has not yet been located. Once the entity is located for the | |
90 | -- first time, its ID is stored in this array, so that subsequent calls | |
91 | -- for the same entity can be satisfied immediately. | |
92 | ||
93 | RE_Table : array (RE_Id) of Entity_Id; | |
94 | ||
95 | -------------------------- | |
96 | -- Generation of WITH's -- | |
97 | -------------------------- | |
98 | ||
99 | -- When a unit is implicitly loaded as a result of a call to RTE, it | |
fbf5a39b AC |
100 | -- is necessary to create an implicit WITH to ensure that the object |
101 | -- is correctly loaded by the binder. Such WITH statements are only | |
19235870 | 102 | -- required when the request is from the extended main unit (if a |
fbf5a39b AC |
103 | -- client needs a WITH, that will be taken care of when the client |
104 | -- is compiled). | |
19235870 | 105 | |
fbf5a39b | 106 | -- We always attach the WITH to the main unit. This is not perfectly |
19235870 RK |
107 | -- accurate in terms of elaboration requirements, but it is close |
108 | -- enough, since the units that are accessed using rtsfind do not | |
109 | -- have delicate elaboration requirements. | |
110 | ||
111 | -- The flag Withed in the unit table record is initially set to False. | |
fbf5a39b | 112 | -- It is set True if a WITH has been generated for the main unit for |
19235870 RK |
113 | -- the corresponding unit. |
114 | ||
115 | ----------------------- | |
116 | -- Local Subprograms -- | |
117 | ----------------------- | |
118 | ||
fbf5a39b AC |
119 | procedure Entity_Not_Defined (Id : RE_Id); |
120 | -- Outputs error messages for an entity that is not defined in the | |
121 | -- run-time library (the form of the error message is tailored for | |
122 | -- no run time/configurable run time mode as required). | |
123 | ||
124 | procedure Load_Fail (S : String; U_Id : RTU_Id; Id : RE_Id); | |
125 | -- Internal procedure called if we can't sucessfully locate or | |
126 | -- process a run-time unit. The parameters give information about | |
127 | -- the error message to be given. S is a reason for failing to | |
128 | -- compile the file and U_Id is the unit id. RE_Id is the RE_Id | |
129 | -- originally passed to RTE. The message in S is one of the | |
130 | -- following: | |
131 | -- | |
132 | -- "not found" | |
133 | -- "had parser errors" | |
134 | -- "had semantic errors" | |
135 | -- | |
136 | -- The "not found" case is treated specially in that it is considered | |
137 | -- a normal situation in configurable run-time mode (and the message in | |
138 | -- this case is suppressed unless we are operating in All_Errors_Mode). | |
19235870 RK |
139 | |
140 | function Get_Unit_Name (U_Id : RTU_Id) return Unit_Name_Type; | |
141 | -- Retrieves the Unit Name given a unit id represented by its | |
142 | -- enumaration value in RTU_Id. | |
143 | ||
fbf5a39b AC |
144 | procedure Load_RTU |
145 | (U_Id : RTU_Id; | |
146 | Id : RE_Id := RE_Null; | |
147 | Use_Setting : Boolean := False); | |
19235870 | 148 | -- Load the unit whose Id is given if not already loaded. The unit is |
fbf5a39b | 149 | -- loaded, analyzed, and added to the WITH list, and the entry in |
19235870 RK |
150 | -- RT_Unit_Table is updated to reflect the load. The second parameter |
151 | -- indicates the initial setting for the Is_Potentially_Use_Visible | |
152 | -- flag of the entity for the loaded unit (if it is indeed loaded). | |
153 | -- A value of False means nothing special need be done. A value of | |
154 | -- True indicates that this flag must be set to True. It is needed | |
155 | -- only in the Text_IO_Kludge procedure, which may materialize an | |
156 | -- entity of Text_IO (or Wide_Text_IO) that was previously unknown. | |
fbf5a39b AC |
157 | -- Id is the RE_Id value of the entity which was originally requested. |
158 | -- Id is used only for error message detail, and if it is RE_Null, then | |
159 | -- the attempt to output the entity name is ignored. | |
160 | ||
161 | procedure Output_Entity_Name (Id : RE_Id; Msg : String); | |
162 | -- Output continuation error message giving qualified name of entity | |
163 | -- corresponding to Id, appending the string given by Msg. This call | |
164 | -- is only effective in All_Errors mode. | |
19235870 RK |
165 | |
166 | function RE_Chars (E : RE_Id) return Name_Id; | |
167 | -- Given a RE_Id value returns the Chars of the corresponding entity. | |
168 | ||
fbf5a39b AC |
169 | procedure RTE_Error_Msg (Msg : String); |
170 | -- Generates a message by calling Error_Msg_N specifying Current_Error_Node | |
171 | -- as the node location using the given Msg text. Special processing in the | |
172 | -- case where RTE_Available_Call is set. In this case, no message is output | |
173 | -- and instead RTE_Is_Available is set to False. Note that this can only be | |
174 | -- used if you are sure that the message comes directly or indirectly from | |
175 | -- a call to the RTE function. | |
176 | ||
19235870 RK |
177 | ------------------- |
178 | -- Get_Unit_Name -- | |
179 | ------------------- | |
180 | ||
181 | function Get_Unit_Name (U_Id : RTU_Id) return Unit_Name_Type is | |
182 | Uname_Chars : constant String := RTU_Id'Image (U_Id); | |
183 | ||
184 | begin | |
185 | Name_Len := Uname_Chars'Length; | |
186 | Name_Buffer (1 .. Name_Len) := Uname_Chars; | |
187 | Set_Casing (All_Lower_Case); | |
188 | ||
189 | if U_Id in Ada_Child then | |
190 | Name_Buffer (4) := '.'; | |
191 | ||
192 | if U_Id in Ada_Calendar_Child then | |
193 | Name_Buffer (13) := '.'; | |
194 | ||
195 | elsif U_Id in Ada_Finalization_Child then | |
196 | Name_Buffer (17) := '.'; | |
197 | ||
fbf5a39b AC |
198 | elsif U_Id in Ada_Interrupts_Child then |
199 | Name_Buffer (15) := '.'; | |
200 | ||
19235870 RK |
201 | elsif U_Id in Ada_Real_Time_Child then |
202 | Name_Buffer (14) := '.'; | |
203 | ||
204 | elsif U_Id in Ada_Streams_Child then | |
205 | Name_Buffer (12) := '.'; | |
206 | ||
207 | elsif U_Id in Ada_Text_IO_Child then | |
208 | Name_Buffer (12) := '.'; | |
209 | ||
210 | elsif U_Id in Ada_Wide_Text_IO_Child then | |
211 | Name_Buffer (17) := '.'; | |
212 | end if; | |
213 | ||
214 | elsif U_Id in Interfaces_Child then | |
215 | Name_Buffer (11) := '.'; | |
216 | ||
217 | elsif U_Id in System_Child then | |
218 | Name_Buffer (7) := '.'; | |
219 | ||
220 | if U_Id in System_Tasking_Child then | |
221 | Name_Buffer (15) := '.'; | |
222 | end if; | |
223 | ||
224 | if U_Id in System_Tasking_Restricted_Child then | |
225 | Name_Buffer (26) := '.'; | |
226 | end if; | |
227 | ||
228 | if U_Id in System_Tasking_Protected_Objects_Child then | |
229 | Name_Buffer (33) := '.'; | |
230 | end if; | |
231 | ||
232 | if U_Id in System_Tasking_Async_Delays_Child then | |
233 | Name_Buffer (28) := '.'; | |
234 | end if; | |
235 | end if; | |
236 | ||
237 | -- Add %s at end for spec | |
238 | ||
239 | Name_Buffer (Name_Len + 1) := '%'; | |
240 | Name_Buffer (Name_Len + 2) := 's'; | |
241 | Name_Len := Name_Len + 2; | |
242 | ||
243 | return Name_Find; | |
244 | end Get_Unit_Name; | |
245 | ||
246 | ---------------- | |
247 | -- Initialize -- | |
248 | ---------------- | |
249 | ||
250 | procedure Initialize is | |
251 | begin | |
252 | -- Initialize the unit table | |
253 | ||
254 | for J in RTU_Id loop | |
255 | RT_Unit_Table (J).Entity := Empty; | |
256 | end loop; | |
257 | ||
258 | for J in RE_Id loop | |
259 | RE_Table (J) := Empty; | |
260 | end loop; | |
261 | end Initialize; | |
262 | ||
263 | ------------ | |
264 | -- Is_RTE -- | |
265 | ------------ | |
266 | ||
267 | function Is_RTE (Ent : Entity_Id; E : RE_Id) return Boolean is | |
268 | E_Unit_Name : Unit_Name_Type; | |
269 | Ent_Unit_Name : Unit_Name_Type; | |
270 | ||
271 | S : Entity_Id; | |
272 | E1 : Entity_Id; | |
273 | E2 : Entity_Id; | |
274 | ||
275 | begin | |
276 | if No (Ent) then | |
277 | return False; | |
278 | ||
279 | -- If E has already a corresponding entity, check it directly, | |
280 | -- going to full views if they exist to deal with the incomplete | |
281 | -- and private type cases properly. | |
282 | ||
283 | elsif Present (RE_Table (E)) then | |
284 | E1 := Ent; | |
285 | ||
286 | if Is_Type (E1) and then Present (Full_View (E1)) then | |
287 | E1 := Full_View (E1); | |
288 | end if; | |
289 | ||
290 | E2 := RE_Table (E); | |
291 | ||
292 | if Is_Type (E2) and then Present (Full_View (E2)) then | |
293 | E2 := Full_View (E2); | |
294 | end if; | |
295 | ||
296 | return E1 = E2; | |
297 | end if; | |
298 | ||
299 | -- If the unit containing E is not loaded, we already know that | |
300 | -- the entity we have cannot have come from this unit. | |
301 | ||
302 | E_Unit_Name := Get_Unit_Name (RE_Unit_Table (E)); | |
303 | ||
304 | if not Is_Loaded (E_Unit_Name) then | |
305 | return False; | |
306 | end if; | |
307 | ||
308 | -- Here the unit containing the entity is loaded. We have not made | |
309 | -- an explicit call to RTE to get the entity in question, but we may | |
310 | -- have obtained a reference to it indirectly from some other entity | |
311 | -- in the same unit, or some other unit that references it. | |
312 | ||
313 | -- Get the defining unit of the entity | |
314 | ||
315 | S := Scope (Ent); | |
316 | ||
317 | if Ekind (S) /= E_Package then | |
318 | return False; | |
319 | end if; | |
320 | ||
321 | Ent_Unit_Name := Get_Unit_Name (Unit_Declaration_Node (S)); | |
322 | ||
323 | -- If the defining unit of the entity we are testing is not the | |
324 | -- unit containing E, then they cannot possibly match. | |
325 | ||
326 | if Ent_Unit_Name /= E_Unit_Name then | |
327 | return False; | |
328 | end if; | |
329 | ||
330 | -- If the units match, then compare the names (remember that no | |
331 | -- overloading is permitted in entities fetched using Rtsfind). | |
332 | ||
333 | if RE_Chars (E) = Chars (Ent) then | |
334 | RE_Table (E) := Ent; | |
335 | ||
336 | -- If front-end inlining is enabled, we may be within a body that | |
337 | -- contains inlined functions, which has not been retrieved through | |
338 | -- rtsfind, and therefore is not yet recorded in the RT_Unit_Table. | |
339 | -- Add the unit information now, it must be fully available. | |
340 | ||
341 | declare | |
342 | U : RT_Unit_Table_Record | |
343 | renames RT_Unit_Table (RE_Unit_Table (E)); | |
344 | begin | |
345 | if No (U.Entity) then | |
346 | U.Entity := S; | |
347 | U.Uname := E_Unit_Name; | |
348 | U.Unum := Get_Source_Unit (S); | |
349 | end if; | |
350 | end; | |
351 | ||
352 | return True; | |
353 | else | |
354 | return False; | |
355 | end if; | |
356 | end Is_RTE; | |
357 | ||
fbf5a39b AC |
358 | ------------ |
359 | -- Is_RTU -- | |
360 | ------------ | |
361 | ||
362 | function Is_RTU (Ent : Entity_Id; U : RTU_Id) return Boolean is | |
363 | E : constant Entity_Id := RT_Unit_Table (U).Entity; | |
364 | begin | |
365 | return Present (E) and then E = Ent; | |
366 | end Is_RTU; | |
367 | ||
19235870 RK |
368 | ---------------------------- |
369 | -- Is_Text_IO_Kludge_Unit -- | |
370 | ---------------------------- | |
371 | ||
372 | function Is_Text_IO_Kludge_Unit (Nam : Node_Id) return Boolean is | |
373 | Prf : Node_Id; | |
374 | Sel : Node_Id; | |
375 | ||
376 | begin | |
377 | if Nkind (Nam) /= N_Expanded_Name then | |
378 | return False; | |
379 | end if; | |
380 | ||
381 | Prf := Prefix (Nam); | |
382 | Sel := Selector_Name (Nam); | |
383 | ||
384 | if Nkind (Sel) /= N_Expanded_Name | |
385 | or else Nkind (Prf) /= N_Identifier | |
386 | or else Chars (Prf) /= Name_Ada | |
387 | then | |
388 | return False; | |
389 | end if; | |
390 | ||
391 | Prf := Prefix (Sel); | |
392 | Sel := Selector_Name (Sel); | |
393 | ||
394 | return | |
395 | Nkind (Prf) = N_Identifier | |
396 | and then | |
397 | (Chars (Prf) = Name_Text_IO or else Chars (Prf) = Name_Wide_Text_IO) | |
398 | and then | |
399 | Nkind (Sel) = N_Identifier | |
400 | and then | |
401 | Chars (Sel) in Text_IO_Package_Name; | |
19235870 RK |
402 | end Is_Text_IO_Kludge_Unit; |
403 | ||
fbf5a39b AC |
404 | ------------------------ |
405 | -- Entity_Not_Defined -- | |
406 | ------------------------ | |
407 | ||
408 | procedure Entity_Not_Defined (Id : RE_Id) is | |
409 | begin | |
410 | if No_Run_Time_Mode then | |
411 | RTE_Error_Msg ("|construct not allowed in no run time mode"); | |
412 | elsif Configurable_Run_Time_Mode then | |
413 | RTE_Error_Msg ("|construct not allowed in this configuration>"); | |
414 | else | |
415 | RTE_Error_Msg ("run-time configuration error"); | |
416 | end if; | |
417 | ||
418 | Output_Entity_Name (Id, "not defined"); | |
419 | end Entity_Not_Defined; | |
420 | ||
19235870 RK |
421 | --------------- |
422 | -- Load_Fail -- | |
423 | --------------- | |
424 | ||
fbf5a39b AC |
425 | procedure Load_Fail (S : String; U_Id : RTU_Id; Id : RE_Id) is |
426 | M : String (1 .. 100); | |
427 | P : Natural := 0; | |
428 | ||
19235870 | 429 | begin |
fbf5a39b | 430 | -- Output header message |
19235870 | 431 | |
fbf5a39b AC |
432 | if Configurable_Run_Time_Mode then |
433 | RTE_Error_Msg ("construct not allowed in configurable run-time mode"); | |
434 | else | |
435 | RTE_Error_Msg ("run-time library configuration error"); | |
436 | end if; | |
19235870 | 437 | |
fbf5a39b | 438 | -- Output file name and reason string |
19235870 | 439 | |
fbf5a39b AC |
440 | if S /= "not found" |
441 | or else not Configurable_Run_Time_Mode | |
442 | then | |
443 | M (1 .. 6) := "\file "; | |
444 | P := 6; | |
19235870 | 445 | |
fbf5a39b AC |
446 | Get_Name_String |
447 | (Get_File_Name (RT_Unit_Table (U_Id).Uname, Subunit => False)); | |
448 | M (P + 1 .. P + Name_Len) := Name_Buffer (1 .. Name_Len); | |
449 | P := P + Name_Len; | |
19235870 | 450 | |
fbf5a39b AC |
451 | M (P + 1) := ' '; |
452 | P := P + 1; | |
19235870 | 453 | |
fbf5a39b AC |
454 | M (P + 1 .. P + S'Length) := S; |
455 | P := P + S'Length; | |
456 | ||
457 | RTE_Error_Msg (M (1 .. P)); | |
458 | ||
459 | -- Output entity name | |
460 | ||
461 | Output_Entity_Name (Id, "not available"); | |
19235870 RK |
462 | end if; |
463 | ||
fbf5a39b | 464 | raise RE_Not_Available; |
19235870 RK |
465 | end Load_Fail; |
466 | ||
467 | -------------- | |
468 | -- Load_RTU -- | |
469 | -------------- | |
470 | ||
fbf5a39b AC |
471 | procedure Load_RTU |
472 | (U_Id : RTU_Id; | |
473 | Id : RE_Id := RE_Null; | |
474 | Use_Setting : Boolean := False) | |
475 | is | |
19235870 | 476 | U : RT_Unit_Table_Record renames RT_Unit_Table (U_Id); |
fbf5a39b | 477 | Priv_Par : constant Elist_Id := New_Elmt_List; |
19235870 RK |
478 | Lib_Unit : Node_Id; |
479 | ||
480 | procedure Save_Private_Visibility; | |
481 | -- If the current unit is the body of child unit or the spec of a | |
482 | -- private child unit, the private declarations of the parent (s) | |
483 | -- are visible. If the unit to be loaded is another public sibling, | |
484 | -- its compilation will affect the visibility of the common ancestors. | |
485 | -- Indicate those that must be restored. | |
486 | ||
487 | procedure Restore_Private_Visibility; | |
488 | -- Restore the visibility of ancestors after compiling RTU. | |
489 | ||
490 | -------------------------------- | |
491 | -- Restore_Private_Visibility -- | |
492 | -------------------------------- | |
493 | ||
494 | procedure Restore_Private_Visibility is | |
495 | E_Par : Elmt_Id; | |
496 | ||
497 | begin | |
498 | E_Par := First_Elmt (Priv_Par); | |
499 | ||
500 | while Present (E_Par) loop | |
501 | if not In_Private_Part (Node (E_Par)) then | |
502 | Install_Private_Declarations (Node (E_Par)); | |
503 | end if; | |
504 | ||
505 | Next_Elmt (E_Par); | |
506 | end loop; | |
507 | end Restore_Private_Visibility; | |
508 | ||
509 | ----------------------------- | |
510 | -- Save_Private_Visibility -- | |
511 | ----------------------------- | |
512 | ||
513 | procedure Save_Private_Visibility is | |
514 | Par : Entity_Id; | |
515 | ||
516 | begin | |
517 | Par := Scope (Current_Scope); | |
518 | ||
519 | while Present (Par) | |
520 | and then Par /= Standard_Standard | |
521 | loop | |
522 | if Ekind (Par) = E_Package | |
523 | and then Is_Compilation_Unit (Par) | |
524 | and then In_Private_Part (Par) | |
525 | then | |
526 | Append_Elmt (Par, Priv_Par); | |
527 | end if; | |
528 | ||
529 | Par := Scope (Par); | |
530 | end loop; | |
531 | end Save_Private_Visibility; | |
532 | ||
533 | -- Start of processing for Load_RTU | |
534 | ||
535 | begin | |
536 | -- Nothing to do if unit is already loaded | |
537 | ||
538 | if Present (U.Entity) then | |
539 | return; | |
540 | end if; | |
541 | ||
542 | -- Otherwise we need to load the unit, First build unit name | |
543 | -- from the enumeration literal name in type RTU_Id. | |
544 | ||
545 | U.Uname := Get_Unit_Name (U_Id); | |
546 | U.Withed := False; | |
fbf5a39b AC |
547 | |
548 | declare | |
549 | Loaded : Boolean; | |
550 | pragma Warnings (Off, Loaded); | |
551 | ||
552 | begin | |
553 | Loaded := Is_Loaded (U.Uname); | |
554 | end; | |
19235870 RK |
555 | |
556 | -- Now do the load call, note that setting Error_Node to Empty is | |
557 | -- a signal to Load_Unit that we will regard a failure to find the | |
558 | -- file as a fatal error, and that it should not output any kind | |
559 | -- of diagnostics, since we will take care of it here. | |
560 | ||
561 | U.Unum := | |
562 | Load_Unit | |
563 | (Load_Name => U.Uname, | |
564 | Required => False, | |
565 | Subunit => False, | |
566 | Error_Node => Empty); | |
567 | ||
568 | if U.Unum = No_Unit then | |
fbf5a39b | 569 | Load_Fail ("not found", U_Id, Id); |
19235870 RK |
570 | |
571 | elsif Fatal_Error (U.Unum) then | |
fbf5a39b | 572 | Load_Fail ("had parser errors", U_Id, Id); |
19235870 RK |
573 | end if; |
574 | ||
575 | -- Make sure that the unit is analyzed | |
576 | ||
577 | declare | |
fbf5a39b AC |
578 | Was_Analyzed : constant Boolean := |
579 | Analyzed (Cunit (Current_Sem_Unit)); | |
19235870 RK |
580 | |
581 | begin | |
fbf5a39b AC |
582 | -- Pretend that the current unit is analyzed, in case it is System |
583 | -- or some such. This allows us to put some declarations, such as | |
584 | -- exceptions and packed arrays of Boolean, into System even though | |
585 | -- expanding them requires System... | |
19235870 RK |
586 | |
587 | -- This is a bit odd but works fine. If the RTS unit does not depend | |
588 | -- in any way on the current unit, then it never gets back into the | |
589 | -- current unit's tree, and the change we make to the current unit | |
590 | -- tree is never noticed by anyone (it is undone in a moment). That | |
591 | -- is the normal situation. | |
592 | ||
593 | -- If the RTS Unit *does* depend on the current unit, for instance, | |
594 | -- when you are compiling System, then you had better have finished | |
fbf5a39b | 595 | -- analyzing the part of System that is depended on before you try |
19235870 RK |
596 | -- to load the RTS Unit. This means having the System ordered in an |
597 | -- appropriate manner. | |
598 | ||
599 | Set_Analyzed (Cunit (Current_Sem_Unit), True); | |
600 | ||
601 | if not Analyzed (Cunit (U.Unum)) then | |
602 | ||
603 | Save_Private_Visibility; | |
604 | Semantics (Cunit (U.Unum)); | |
605 | Restore_Private_Visibility; | |
606 | ||
607 | if Fatal_Error (U.Unum) then | |
fbf5a39b | 608 | Load_Fail ("had semantic errors", U_Id, Id); |
19235870 RK |
609 | end if; |
610 | end if; | |
611 | ||
612 | -- Undo the pretence | |
613 | ||
614 | Set_Analyzed (Cunit (Current_Sem_Unit), Was_Analyzed); | |
615 | end; | |
616 | ||
617 | Lib_Unit := Unit (Cunit (U.Unum)); | |
618 | U.Entity := Defining_Entity (Lib_Unit); | |
619 | ||
620 | if Use_Setting then | |
621 | Set_Is_Potentially_Use_Visible (U.Entity, True); | |
622 | end if; | |
623 | end Load_RTU; | |
624 | ||
fbf5a39b AC |
625 | ----------------------- |
626 | -- Output_Entity_Name -- | |
627 | ------------------------ | |
628 | ||
629 | procedure Output_Entity_Name (Id : RE_Id; Msg : String) is | |
630 | M : String (1 .. 2048); | |
631 | P : Natural := 0; | |
632 | -- M (1 .. P) is current message to be output | |
633 | ||
634 | RE_Image : constant String := RE_Id'Image (Id); | |
635 | ||
636 | begin | |
637 | if Id = RE_Null or else not All_Errors_Mode then | |
638 | return; | |
639 | end if; | |
640 | ||
641 | M (1 .. 9) := "\entity """; | |
642 | P := 9; | |
643 | ||
644 | -- Add unit name to message, excluding %s or %b at end | |
645 | ||
646 | Get_Name_String (Get_Unit_Name (RE_Unit_Table (Id))); | |
647 | Name_Len := Name_Len - 2; | |
648 | Set_Casing (Mixed_Case); | |
649 | M (P + 1 .. P + Name_Len) := Name_Buffer (1 .. Name_Len); | |
650 | P := P + Name_Len; | |
651 | ||
652 | -- Add a qualifying period | |
653 | ||
654 | M (P + 1) := '.'; | |
655 | P := P + 1; | |
656 | ||
657 | -- Add entity name and closing quote to message | |
658 | ||
659 | Name_Len := RE_Image'Length - 3; | |
660 | Name_Buffer (1 .. Name_Len) := RE_Image (4 .. RE_Image'Length); | |
661 | Set_Casing (Mixed_Case); | |
662 | M (P + 1 .. P + Name_Len) := Name_Buffer (1 .. Name_Len); | |
663 | P := P + Name_Len; | |
664 | M (P + 1) := '"'; | |
665 | P := P + 1; | |
666 | ||
667 | -- Add message | |
668 | ||
669 | M (P + 1) := ' '; | |
670 | P := P + 1; | |
671 | M (P + 1 .. P + Msg'Length) := Msg; | |
672 | P := P + Msg'Length; | |
673 | ||
674 | -- Output message at current error node location | |
675 | ||
676 | RTE_Error_Msg (M (1 .. P)); | |
677 | end Output_Entity_Name; | |
678 | ||
19235870 RK |
679 | -------------- |
680 | -- RE_Chars -- | |
681 | -------------- | |
682 | ||
683 | function RE_Chars (E : RE_Id) return Name_Id is | |
684 | RE_Name_Chars : constant String := RE_Id'Image (E); | |
685 | ||
686 | begin | |
687 | -- Copy name skipping initial RE_ or RO_XX characters | |
688 | ||
689 | if RE_Name_Chars (1 .. 2) = "RE" then | |
690 | for J in 4 .. RE_Name_Chars'Last loop | |
691 | Name_Buffer (J - 3) := Fold_Lower (RE_Name_Chars (J)); | |
692 | end loop; | |
693 | ||
694 | Name_Len := RE_Name_Chars'Length - 3; | |
695 | ||
696 | else | |
697 | for J in 7 .. RE_Name_Chars'Last loop | |
698 | Name_Buffer (J - 6) := Fold_Lower (RE_Name_Chars (J)); | |
699 | end loop; | |
700 | ||
701 | Name_Len := RE_Name_Chars'Length - 6; | |
702 | end if; | |
703 | ||
704 | return Name_Find; | |
705 | end RE_Chars; | |
706 | ||
707 | --------- | |
708 | -- RTE -- | |
709 | --------- | |
710 | ||
711 | function RTE (E : RE_Id) return Entity_Id is | |
712 | U_Id : constant RTU_Id := RE_Unit_Table (E); | |
713 | U : RT_Unit_Table_Record renames RT_Unit_Table (U_Id); | |
714 | ||
19235870 RK |
715 | Lib_Unit : Node_Id; |
716 | Pkg_Ent : Entity_Id; | |
717 | Ename : Name_Id; | |
19235870 | 718 | |
07fc65c4 GB |
719 | -- The following flag is used to disable front-end inlining when RTE |
720 | -- is invoked. This prevents the analysis of other runtime bodies when | |
721 | -- a particular spec is loaded through Rtsfind. This is both efficient, | |
722 | -- and it prevents spurious visibility conflicts between use-visible | |
723 | -- user entities, and entities in run-time packages. | |
724 | ||
fbf5a39b AC |
725 | -- In configurable run-time mode, subprograms marked Inlined_Always must |
726 | -- be inlined, so in the case we retain the Front_End_Inlining mode. | |
07fc65c4 GB |
727 | |
728 | Save_Front_End_Inlining : Boolean; | |
729 | ||
fbf5a39b AC |
730 | function Check_CRT (Eid : Entity_Id) return Entity_Id; |
731 | -- Check entity Eid to ensure that configurable run-time restrictions | |
732 | -- are met. May generate an error message and raise RE_Not_Available | |
733 | -- if the entity E does not exist (i.e. Eid is Empty) | |
734 | ||
19235870 RK |
735 | procedure Check_RPC; |
736 | -- Reject programs that make use of distribution features not supported | |
737 | -- on the current target. On such targets (VMS, Vxworks, others?) we | |
738 | -- only provide a minimal body for System.Rpc that only supplies an | |
739 | -- implementation of partition_id. | |
740 | ||
741 | function Find_Local_Entity (E : RE_Id) return Entity_Id; | |
742 | -- This function is used when entity E is in this compilation's main | |
743 | -- unit. It gets the value from the already compiled declaration. | |
744 | ||
745 | function Make_Unit_Name (N : Node_Id) return Node_Id; | |
746 | -- If the unit is a child unit, build fully qualified name for use | |
fbf5a39b AC |
747 | -- in With_Clause. |
748 | ||
749 | --------------- | |
750 | -- Check_CRT -- | |
751 | --------------- | |
752 | ||
753 | function Check_CRT (Eid : Entity_Id) return Entity_Id is | |
754 | begin | |
755 | if No (Eid) then | |
756 | Entity_Not_Defined (E); | |
757 | raise RE_Not_Available; | |
758 | ||
759 | -- Entity is available | |
760 | ||
761 | else | |
762 | -- If in No_Run_Time mode and entity is not in one of the | |
763 | -- specially permitted units, raise the exception. | |
764 | ||
765 | if No_Run_Time_Mode | |
766 | and then not OK_No_Run_Time_Unit (U_Id) | |
767 | then | |
768 | Entity_Not_Defined (E); | |
769 | raise RE_Not_Available; | |
770 | end if; | |
771 | ||
772 | -- Otherwise entity is accessible | |
773 | ||
774 | return Eid; | |
775 | end if; | |
776 | end Check_CRT; | |
19235870 RK |
777 | |
778 | --------------- | |
779 | -- Check_RPC -- | |
780 | --------------- | |
781 | ||
782 | procedure Check_RPC is | |
783 | Body_Name : Unit_Name_Type; | |
784 | Unum : Unit_Number_Type; | |
785 | ||
786 | begin | |
787 | -- Bypass this check if debug flag -gnatdR set | |
788 | ||
789 | if Debug_Flag_RR then | |
790 | return; | |
791 | end if; | |
792 | ||
793 | -- Otherwise we need the check if we are going after one of | |
794 | -- the critical entities in System.RPC in stubs mode. | |
795 | ||
796 | if (Distribution_Stub_Mode = Generate_Receiver_Stub_Body | |
797 | or else | |
798 | Distribution_Stub_Mode = Generate_Caller_Stub_Body) | |
799 | and then (E = RE_Do_Rpc | |
800 | or else E = RE_Do_Apc | |
801 | or else E = RE_Params_Stream_Type | |
802 | or else E = RE_RPC_Receiver) | |
803 | then | |
804 | -- Load body of System.Rpc, and abort if this is the body that is | |
805 | -- provided by GNAT, for which these features are not supported | |
806 | -- on current target. We identify the gnat body by the presence | |
807 | -- of a local entity called Gnat in the first declaration. | |
808 | ||
809 | Lib_Unit := Unit (Cunit (U.Unum)); | |
810 | Body_Name := Get_Body_Name (Get_Unit_Name (Lib_Unit)); | |
811 | Unum := | |
812 | Load_Unit | |
813 | (Load_Name => Body_Name, | |
814 | Required => False, | |
815 | Subunit => False, | |
816 | Error_Node => Empty, | |
817 | Renamings => True); | |
818 | ||
819 | if Unum /= No_Unit then | |
820 | declare | |
fbf5a39b AC |
821 | Decls : constant List_Id := |
822 | Declarations (Unit (Cunit (Unum))); | |
19235870 RK |
823 | |
824 | begin | |
825 | if Present (Decls) | |
826 | and then Nkind (First (Decls)) = N_Object_Declaration | |
827 | and then | |
828 | Chars (Defining_Identifier (First (Decls))) = Name_Gnat | |
829 | then | |
830 | Set_Standard_Error; | |
831 | Write_Str ("distribution feature not supported"); | |
832 | Write_Eol; | |
833 | raise Unrecoverable_Error; | |
834 | end if; | |
835 | end; | |
836 | end if; | |
837 | end if; | |
838 | end Check_RPC; | |
839 | ||
840 | ------------------------ | |
841 | -- Find_System_Entity -- | |
842 | ------------------------ | |
843 | ||
844 | function Find_Local_Entity (E : RE_Id) return Entity_Id is | |
845 | RE_Str : String renames RE_Id'Image (E); | |
846 | Ent : Entity_Id; | |
847 | ||
848 | Save_Nam : constant String := Name_Buffer (1 .. Name_Len); | |
849 | -- Save name buffer and length over call | |
850 | ||
851 | begin | |
852 | Name_Len := Natural'Max (0, RE_Str'Length - 3); | |
853 | Name_Buffer (1 .. Name_Len) := | |
854 | RE_Str (RE_Str'First + 3 .. RE_Str'Last); | |
855 | ||
856 | Ent := Entity_Id (Get_Name_Table_Info (Name_Find)); | |
857 | ||
858 | Name_Len := Save_Nam'Length; | |
859 | Name_Buffer (1 .. Name_Len) := Save_Nam; | |
860 | ||
861 | return Ent; | |
862 | end Find_Local_Entity; | |
863 | ||
864 | -------------------- | |
865 | -- Make_Unit_Name -- | |
866 | -------------------- | |
867 | ||
868 | function Make_Unit_Name (N : Node_Id) return Node_Id is | |
869 | Nam : Node_Id; | |
870 | Scop : Entity_Id; | |
871 | ||
872 | begin | |
873 | Nam := New_Reference_To (U.Entity, Standard_Location); | |
874 | Scop := Scope (U.Entity); | |
875 | ||
876 | if Nkind (N) = N_Defining_Program_Unit_Name then | |
877 | while Scop /= Standard_Standard loop | |
878 | Nam := | |
879 | Make_Expanded_Name (Standard_Location, | |
880 | Chars => Chars (U.Entity), | |
881 | Prefix => New_Reference_To (Scop, Standard_Location), | |
882 | Selector_Name => Nam); | |
883 | Set_Entity (Nam, U.Entity); | |
884 | ||
885 | Scop := Scope (Scop); | |
886 | end loop; | |
887 | end if; | |
888 | ||
889 | return Nam; | |
890 | end Make_Unit_Name; | |
891 | ||
892 | -- Start of processing for RTE | |
893 | ||
894 | begin | |
895 | -- Doing a rtsfind in system.ads is special, as we cannot do this | |
896 | -- when compiling System itself. So if we are compiling system then | |
897 | -- we should already have acquired and processed the declaration | |
898 | -- of the entity. The test is to see if this compilation's main unit | |
899 | -- is System. If so, return the value from the already compiled | |
900 | -- declaration and otherwise do a regular find. | |
901 | ||
902 | -- Not pleasant, but these kinds of annoying recursion when | |
903 | -- writing an Ada compiler in Ada have to be broken somewhere! | |
904 | ||
905 | if Present (Main_Unit_Entity) | |
906 | and then Chars (Main_Unit_Entity) = Name_System | |
907 | and then Analyzed (Main_Unit_Entity) | |
908 | and then not Is_Child_Unit (Main_Unit_Entity) | |
909 | then | |
fbf5a39b | 910 | return Check_CRT (Find_Local_Entity (E)); |
19235870 RK |
911 | end if; |
912 | ||
07fc65c4 | 913 | Save_Front_End_Inlining := Front_End_Inlining; |
fbf5a39b | 914 | Front_End_Inlining := Configurable_Run_Time_Mode; |
07fc65c4 | 915 | |
19235870 RK |
916 | -- Load unit if unit not previously loaded |
917 | ||
918 | if No (RE_Table (E)) then | |
fbf5a39b | 919 | Load_RTU (U_Id, Id => E); |
19235870 RK |
920 | Lib_Unit := Unit (Cunit (U.Unum)); |
921 | ||
922 | -- In the subprogram case, we are all done, the entity we want | |
923 | -- is the entity for the subprogram itself. Note that we do not | |
924 | -- bother to check that it is the entity that was requested. | |
925 | -- the only way that could fail to be the case is if runtime is | |
926 | -- hopelessly misconfigured, and it isn't worth testing for this. | |
927 | ||
928 | if Nkind (Lib_Unit) = N_Subprogram_Declaration then | |
929 | RE_Table (E) := U.Entity; | |
930 | ||
fbf5a39b AC |
931 | -- Otherwise we must have the package case. First check package |
932 | -- entity itself (e.g. RTE_Name for System.Interrupts.Name) | |
19235870 RK |
933 | |
934 | else | |
935 | pragma Assert (Nkind (Lib_Unit) = N_Package_Declaration); | |
936 | Ename := RE_Chars (E); | |
937 | ||
fbf5a39b | 938 | -- First we search the package entity chain |
19235870 | 939 | |
fbf5a39b AC |
940 | Pkg_Ent := First_Entity (U.Entity); |
941 | while Present (Pkg_Ent) loop | |
942 | if Ename = Chars (Pkg_Ent) then | |
943 | RE_Table (E) := Pkg_Ent; | |
944 | Check_RPC; | |
945 | goto Found; | |
946 | end if; | |
19235870 | 947 | |
fbf5a39b AC |
948 | Next_Entity (Pkg_Ent); |
949 | end loop; | |
0868e09c | 950 | |
fbf5a39b AC |
951 | -- If we did not find the entity in the package entity chain, |
952 | -- then check if the package entity itself matches. Note that | |
953 | -- we do this check after searching the entity chain, since | |
954 | -- the rule is that in case of ambiguity, we prefer the entity | |
955 | -- defined within the package, rather than the package itself. | |
19235870 | 956 | |
fbf5a39b AC |
957 | if Ename = Chars (U.Entity) then |
958 | RE_Table (E) := U.Entity; | |
0868e09c | 959 | end if; |
fbf5a39b AC |
960 | |
961 | -- If we didn't find the entity we want, something is wrong. | |
962 | -- We just leave RE_Table (E) set to Empty and the appropriate | |
963 | -- action will be taken by Check_CRT when we exit. | |
964 | ||
19235870 RK |
965 | end if; |
966 | end if; | |
967 | ||
fbf5a39b AC |
968 | -- See if we have to generate a WITH for this entity. We generate |
969 | -- a WITH if the current unit is part of the extended main code | |
970 | -- unit, and if we have not already added the with. The WITH is | |
971 | -- added to the appropriate unit (the current one). We do not need | |
972 | -- to generate a WITH for an | |
19235870 RK |
973 | |
974 | <<Found>> | |
975 | if (not U.Withed) | |
976 | and then | |
977 | In_Extended_Main_Code_Unit (Cunit_Entity (Current_Sem_Unit)) | |
fbf5a39b | 978 | and then not RTE_Available_Call |
19235870 RK |
979 | then |
980 | U.Withed := True; | |
981 | ||
982 | declare | |
983 | Withn : Node_Id; | |
984 | Lib_Unit : Node_Id; | |
985 | ||
986 | begin | |
987 | Lib_Unit := Unit (Cunit (U.Unum)); | |
988 | Withn := | |
989 | Make_With_Clause (Standard_Location, | |
990 | Name => | |
991 | Make_Unit_Name | |
992 | (Defining_Unit_Name (Specification (Lib_Unit)))); | |
993 | Set_Library_Unit (Withn, Cunit (U.Unum)); | |
994 | Set_Corresponding_Spec (Withn, U.Entity); | |
995 | Set_First_Name (Withn, True); | |
996 | Set_Implicit_With (Withn, True); | |
997 | ||
998 | Mark_Rewrite_Insertion (Withn); | |
999 | Append (Withn, Context_Items (Cunit (Current_Sem_Unit))); | |
1000 | end; | |
1001 | end if; | |
1002 | ||
07fc65c4 | 1003 | Front_End_Inlining := Save_Front_End_Inlining; |
fbf5a39b | 1004 | return Check_CRT (RE_Table (E)); |
19235870 RK |
1005 | end RTE; |
1006 | ||
fbf5a39b AC |
1007 | ------------------- |
1008 | -- RTE_Available -- | |
1009 | ------------------- | |
1010 | ||
1011 | function RTE_Available (E : RE_Id) return Boolean is | |
1012 | Dummy : Entity_Id; | |
1013 | pragma Warnings (Off, Dummy); | |
1014 | ||
1015 | Result : Boolean; | |
1016 | ||
1017 | Save_RTE_Available_Call : constant Boolean := RTE_Available_Call; | |
1018 | Save_RTE_Is_Available : constant Boolean := RTE_Is_Available; | |
1019 | -- These are saved recursively because the call to load a unit | |
1020 | -- caused by an upper level call may perform a recursive call | |
1021 | -- to this routine during analysis of the corresponding unit. | |
1022 | ||
1023 | begin | |
1024 | RTE_Available_Call := True; | |
1025 | RTE_Is_Available := True; | |
1026 | Dummy := RTE (E); | |
1027 | Result := RTE_Is_Available; | |
1028 | RTE_Available_Call := Save_RTE_Available_Call; | |
1029 | RTE_Is_Available := Save_RTE_Is_Available; | |
1030 | return Result; | |
1031 | ||
1032 | exception | |
1033 | when RE_Not_Available => | |
1034 | RTE_Available_Call := Save_RTE_Available_Call; | |
1035 | RTE_Is_Available := Save_RTE_Is_Available; | |
1036 | return False; | |
1037 | end RTE_Available; | |
1038 | ||
1039 | ------------------- | |
1040 | -- RTE_Error_Msg -- | |
1041 | ------------------- | |
1042 | ||
1043 | procedure RTE_Error_Msg (Msg : String) is | |
1044 | begin | |
1045 | if RTE_Available_Call then | |
1046 | RTE_Is_Available := False; | |
1047 | else | |
1048 | Error_Msg_N (Msg, Current_Error_Node); | |
1049 | ||
1050 | -- Bump count of violations if we are in configurable run-time | |
1051 | -- mode and this is not a continuation message. | |
1052 | ||
1053 | if Configurable_Run_Time_Mode and then Msg (1) /= '\' then | |
1054 | Configurable_Run_Time_Violations := | |
1055 | Configurable_Run_Time_Violations + 1; | |
1056 | end if; | |
1057 | end if; | |
1058 | end RTE_Error_Msg; | |
1059 | ||
19235870 RK |
1060 | -------------------- |
1061 | -- Text_IO_Kludge -- | |
1062 | -------------------- | |
1063 | ||
1064 | procedure Text_IO_Kludge (Nam : Node_Id) is | |
1065 | Chrs : Name_Id; | |
1066 | ||
1067 | type Name_Map_Type is array (Text_IO_Package_Name) of RTU_Id; | |
1068 | ||
fbf5a39b | 1069 | Name_Map : constant Name_Map_Type := Name_Map_Type'( |
19235870 RK |
1070 | Name_Decimal_IO => Ada_Text_IO_Decimal_IO, |
1071 | Name_Enumeration_IO => Ada_Text_IO_Enumeration_IO, | |
1072 | Name_Fixed_IO => Ada_Text_IO_Fixed_IO, | |
1073 | Name_Float_IO => Ada_Text_IO_Float_IO, | |
1074 | Name_Integer_IO => Ada_Text_IO_Integer_IO, | |
1075 | Name_Modular_IO => Ada_Text_IO_Modular_IO); | |
1076 | ||
fbf5a39b | 1077 | Wide_Name_Map : constant Name_Map_Type := Name_Map_Type'( |
19235870 RK |
1078 | Name_Decimal_IO => Ada_Wide_Text_IO_Decimal_IO, |
1079 | Name_Enumeration_IO => Ada_Wide_Text_IO_Enumeration_IO, | |
1080 | Name_Fixed_IO => Ada_Wide_Text_IO_Fixed_IO, | |
1081 | Name_Float_IO => Ada_Wide_Text_IO_Float_IO, | |
1082 | Name_Integer_IO => Ada_Wide_Text_IO_Integer_IO, | |
1083 | Name_Modular_IO => Ada_Wide_Text_IO_Modular_IO); | |
1084 | ||
1085 | begin | |
1086 | -- Nothing to do if name is not identifier or a selected component | |
1087 | -- whose selector_name is not an identifier. | |
1088 | ||
1089 | if Nkind (Nam) = N_Identifier then | |
1090 | Chrs := Chars (Nam); | |
1091 | ||
1092 | elsif Nkind (Nam) = N_Selected_Component | |
1093 | and then Nkind (Selector_Name (Nam)) = N_Identifier | |
1094 | then | |
1095 | Chrs := Chars (Selector_Name (Nam)); | |
1096 | ||
1097 | else | |
1098 | return; | |
1099 | end if; | |
1100 | ||
1101 | -- Nothing to do if name is not one of the Text_IO subpackages | |
1102 | -- Otherwise look through loaded units, and if we find Text_IO | |
1103 | -- or Wide_Text_IO already loaded, then load the proper child. | |
1104 | ||
1105 | if Chrs in Text_IO_Package_Name then | |
1106 | for U in Main_Unit .. Last_Unit loop | |
1107 | Get_Name_String (Unit_File_Name (U)); | |
1108 | ||
1109 | if Name_Len = 12 then | |
1110 | ||
1111 | -- Here is where we do the loads if we find one of the | |
1112 | -- units Ada.Text_IO or Ada.Wide_Text_IO. An interesting | |
1113 | -- detail is that these units may already be used (i.e. | |
1114 | -- their In_Use flags may be set). Normally when the In_Use | |
1115 | -- flag is set, the Is_Potentially_Use_Visible flag of all | |
1116 | -- entities in the package is set, but the new entity we | |
1117 | -- are mysteriously adding was not there to have its flag | |
1118 | -- set at the time. So that's why we pass the extra parameter | |
1119 | -- to RTU_Find, to make sure the flag does get set now. | |
1120 | -- Given that those generic packages are in fact child units, | |
1121 | -- we must indicate that they are visible. | |
1122 | ||
1123 | if Name_Buffer (1 .. 12) = "a-textio.ads" then | |
fbf5a39b AC |
1124 | Load_RTU |
1125 | (Name_Map (Chrs), | |
1126 | Use_Setting => In_Use (Cunit_Entity (U))); | |
19235870 RK |
1127 | Set_Is_Visible_Child_Unit |
1128 | (RT_Unit_Table (Name_Map (Chrs)).Entity); | |
1129 | ||
1130 | elsif Name_Buffer (1 .. 12) = "a-witeio.ads" then | |
fbf5a39b AC |
1131 | Load_RTU |
1132 | (Wide_Name_Map (Chrs), | |
1133 | Use_Setting => In_Use (Cunit_Entity (U))); | |
19235870 RK |
1134 | Set_Is_Visible_Child_Unit |
1135 | (RT_Unit_Table (Wide_Name_Map (Chrs)).Entity); | |
1136 | end if; | |
1137 | end if; | |
1138 | end loop; | |
1139 | end if; | |
1140 | end Text_IO_Kludge; | |
1141 | ||
1142 | end Rtsfind; |