111
|
1 ------------------------------------------------------------------------------
|
|
2 -- --
|
|
3 -- GNAT COMPILER COMPONENTS --
|
|
4 -- --
|
|
5 -- F R O N T E N D --
|
|
6 -- --
|
|
7 -- B o d y --
|
|
8 -- --
|
145
|
9 -- Copyright (C) 1992-2019, Free Software Foundation, Inc. --
|
111
|
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 System.Strings; use System.Strings;
|
|
27
|
|
28 with Atree; use Atree;
|
|
29 with Checks;
|
|
30 with CStand;
|
|
31 with Debug; use Debug;
|
|
32 with Elists;
|
|
33 with Exp_Dbug;
|
|
34 with Exp_Unst;
|
|
35 with Fmap;
|
|
36 with Fname.UF;
|
|
37 with Ghost; use Ghost;
|
|
38 with Inline; use Inline;
|
|
39 with Lib; use Lib;
|
|
40 with Lib.Load; use Lib.Load;
|
|
41 with Lib.Xref;
|
|
42 with Live; use Live;
|
|
43 with Namet; use Namet;
|
|
44 with Nlists; use Nlists;
|
|
45 with Opt; use Opt;
|
|
46 with Osint;
|
|
47 with Par;
|
|
48 with Prep;
|
|
49 with Prepcomp;
|
|
50 with Restrict; use Restrict;
|
|
51 with Rident; use Rident;
|
|
52 with Rtsfind;
|
|
53 with Snames; use Snames;
|
|
54 with Sprint;
|
|
55 with Scn; use Scn;
|
|
56 with Sem; use Sem;
|
|
57 with Sem_Aux;
|
|
58 with Sem_Ch8;
|
|
59 with Sem_SCIL;
|
|
60 with Sem_Elab; use Sem_Elab;
|
|
61 with Sem_Prag; use Sem_Prag;
|
|
62 with Sem_Warn;
|
|
63 with Sinfo; use Sinfo;
|
|
64 with Sinput; use Sinput;
|
|
65 with Sinput.L; use Sinput.L;
|
|
66 with SCIL_LL;
|
|
67 with Tbuild; use Tbuild;
|
|
68 with Types; use Types;
|
|
69
|
|
70 procedure Frontend is
|
|
71 begin
|
|
72 -- Carry out package initializations. These are initializations which might
|
|
73 -- logically be performed at elaboration time, were it not for the fact
|
|
74 -- that we may be doing things more than once in the big loop over files.
|
|
75 -- Like elaboration, the order in which these calls are made is in some
|
|
76 -- cases important. For example, Lib cannot be initialized before Namet,
|
|
77 -- since it uses names table entries.
|
|
78
|
|
79 Rtsfind.Initialize;
|
|
80 Nlists.Initialize;
|
|
81 Elists.Initialize;
|
|
82 Lib.Load.Initialize;
|
|
83 Sem_Aux.Initialize;
|
|
84 Sem_Ch8.Initialize;
|
|
85 Sem_Prag.Initialize;
|
|
86 Fname.UF.Initialize;
|
|
87 Checks.Initialize;
|
|
88 Sem_Warn.Initialize;
|
|
89 Prep.Initialize;
|
|
90 Sem_Elab.Initialize;
|
|
91
|
|
92 if Generate_SCIL then
|
|
93 SCIL_LL.Initialize;
|
|
94 end if;
|
|
95
|
|
96 -- Create package Standard
|
|
97
|
|
98 CStand.Create_Standard;
|
|
99
|
|
100 -- Check possible symbol definitions specified by -gnateD switches
|
|
101
|
|
102 Prepcomp.Process_Command_Line_Symbol_Definitions;
|
|
103
|
|
104 -- If -gnatep= was specified, parse the preprocessing data file
|
|
105
|
|
106 if Preprocessing_Data_File /= null then
|
|
107 Name_Len := Preprocessing_Data_File'Length;
|
|
108 Name_Buffer (1 .. Name_Len) := Preprocessing_Data_File.all;
|
|
109 Prepcomp.Parse_Preprocessing_Data_File (Name_Find);
|
|
110
|
|
111 -- Otherwise, check if there were preprocessing symbols on the command
|
|
112 -- line and set preprocessing if there are.
|
|
113
|
|
114 else
|
|
115 Prepcomp.Check_Symbols;
|
|
116 end if;
|
|
117
|
|
118 -- We set Parsing_Main_Extended_Source true here to cover processing of all
|
|
119 -- the configuration pragma files, as well as the main source unit itself.
|
|
120
|
|
121 Parsing_Main_Extended_Source := True;
|
|
122
|
|
123 -- Now that the preprocessing situation is established, we are able to
|
|
124 -- load the main source (this is no longer done by Lib.Load.Initialize).
|
|
125
|
|
126 Lib.Load.Load_Main_Source;
|
|
127
|
|
128 -- Return immediately if the main source could not be found
|
|
129
|
|
130 if Sinput.Main_Source_File <= No_Source_File then
|
|
131 return;
|
|
132 end if;
|
|
133
|
|
134 -- Read and process configuration pragma files if present
|
|
135
|
|
136 declare
|
|
137 Dot_Gnat_Adc : constant File_Name_Type := Name_Find ("./gnat.adc");
|
|
138 Gnat_Adc : constant File_Name_Type := Name_Find ("gnat.adc");
|
|
139
|
|
140 Save_Style_Check : constant Boolean := Opt.Style_Check;
|
|
141 -- Save style check mode so it can be restored later
|
|
142
|
|
143 Config_Pragmas : List_Id := Empty_List;
|
|
144 -- Gather configuration pragmas
|
|
145
|
|
146 Source_Config_File : Source_File_Index;
|
|
147 -- Source reference for -gnatec configuration file
|
|
148
|
|
149 Prag : Node_Id;
|
|
150
|
|
151 begin
|
|
152 -- We always analyze config files with style checks off, since we
|
|
153 -- don't want a miscellaneous gnat.adc that is around to discombobulate
|
|
154 -- intended -gnatg or -gnaty compilations. We also disconnect checking
|
|
155 -- for maximum line length.
|
|
156
|
|
157 Opt.Style_Check := False;
|
|
158 Style_Check := False;
|
|
159
|
|
160 -- Capture current suppress options, which may get modified
|
|
161
|
|
162 Scope_Suppress := Opt.Suppress_Options;
|
|
163
|
|
164 -- First deal with gnat.adc file
|
|
165
|
|
166 if Opt.Config_File then
|
|
167 Source_gnat_adc := Load_Config_File (Gnat_Adc);
|
|
168
|
|
169 -- Case of gnat.adc file present
|
|
170
|
|
171 if Source_gnat_adc > No_Source_File then
|
|
172
|
|
173 -- Parse the gnat.adc file for configuration pragmas
|
|
174
|
|
175 Initialize_Scanner (No_Unit, Source_gnat_adc);
|
|
176 Config_Pragmas := Par (Configuration_Pragmas => True);
|
|
177
|
|
178 -- We add a compilation dependency for gnat.adc so that if it
|
|
179 -- changes, we force a recompilation.
|
|
180
|
|
181 Prepcomp.Add_Dependency (Source_gnat_adc);
|
|
182 end if;
|
|
183 end if;
|
|
184
|
|
185 -- Now deal with specified config pragmas files if there are any
|
|
186
|
|
187 if Opt.Config_File_Names /= null then
|
|
188
|
|
189 -- Loop through config pragmas files
|
|
190
|
|
191 for Index in Opt.Config_File_Names'Range loop
|
|
192 declare
|
|
193 Len : constant Natural := Config_File_Names (Index)'Length;
|
|
194 Str : constant String (1 .. Len) :=
|
|
195 Config_File_Names (Index).all;
|
|
196
|
|
197 Config_Name : constant File_Name_Type := Name_Find (Str);
|
|
198 Temp_File : constant Boolean :=
|
|
199 Len > 4
|
|
200 and then
|
|
201 (Str (Len - 3 .. Len) = ".TMP"
|
|
202 or else
|
|
203 Str (Len - 3 .. Len) = ".tmp");
|
|
204 -- Extension indicating a temporary config file?
|
|
205
|
|
206 begin
|
|
207 -- Skip it if it's the default name, already loaded above.
|
|
208 -- Otherwise, we get confusing warning messages about seeing
|
|
209 -- the same thing twice.
|
|
210
|
|
211 if Config_Name /= Gnat_Adc
|
|
212 and then Config_Name /= Dot_Gnat_Adc
|
|
213 then
|
|
214 -- Load the file, error if we did not find it
|
|
215
|
|
216 Source_Config_File := Load_Config_File (Config_Name);
|
|
217
|
|
218 if Source_Config_File <= No_Source_File then
|
|
219 Osint.Fail
|
|
220 ("cannot find configuration pragmas file "
|
|
221 & Config_File_Names (Index).all);
|
|
222
|
|
223 -- If we did find the file, and it is not a temporary file,
|
|
224 -- then we add a compilation dependency for it so that if it
|
|
225 -- changes, we force a recompilation.
|
|
226
|
|
227 elsif not Temp_File then
|
|
228 Prepcomp.Add_Dependency (Source_Config_File);
|
|
229 end if;
|
|
230
|
|
231 -- Parse the config pragmas file, and accumulate results
|
|
232
|
|
233 Initialize_Scanner (No_Unit, Source_Config_File);
|
|
234 Append_List_To
|
|
235 (Config_Pragmas, Par (Configuration_Pragmas => True));
|
|
236 end if;
|
|
237 end;
|
|
238 end loop;
|
|
239 end if;
|
|
240
|
|
241 -- Now analyze all pragmas except those whose analysis must be
|
|
242 -- deferred till after the main unit is analyzed.
|
|
243
|
|
244 if Config_Pragmas /= Error_List
|
|
245 and then Operating_Mode /= Check_Syntax
|
|
246 then
|
|
247 Prag := First (Config_Pragmas);
|
|
248 while Present (Prag) loop
|
|
249 if not Delay_Config_Pragma_Analyze (Prag) then
|
|
250 Analyze_Pragma (Prag);
|
|
251 end if;
|
|
252
|
|
253 Next (Prag);
|
|
254 end loop;
|
|
255 end if;
|
|
256
|
|
257 -- Restore style check, but if config file turned on checks, leave on
|
|
258
|
|
259 Opt.Style_Check := Save_Style_Check or Style_Check;
|
|
260
|
|
261 -- Capture any modifications to suppress options from config pragmas
|
|
262
|
|
263 Opt.Suppress_Options := Scope_Suppress;
|
|
264
|
|
265 -- If a target dependency info file has been read through switch
|
|
266 -- -gnateT=, add it to the dependencies.
|
|
267
|
|
268 if Target_Dependent_Info_Read_Name /= null then
|
|
269 declare
|
|
270 Index : Source_File_Index;
|
|
271 begin
|
|
272 Name_Len := 0;
|
|
273 Add_Str_To_Name_Buffer (Target_Dependent_Info_Read_Name.all);
|
|
274 Index := Load_Config_File (Name_Enter);
|
|
275 Prepcomp.Add_Dependency (Index);
|
|
276 end;
|
|
277 end if;
|
|
278
|
|
279 -- This is where we can capture the value of the compilation unit
|
|
280 -- specific restrictions that have been set by the config pragma
|
|
281 -- files (or from Targparm), for later restoration when processing
|
|
282 -- e.g. subunits.
|
|
283
|
|
284 Save_Config_Cunit_Boolean_Restrictions;
|
|
285
|
|
286 -- If there was a -gnatem switch, initialize the mappings of unit names
|
|
287 -- to file names and of file names to path names from the mapping file.
|
|
288
|
|
289 if Mapping_File_Name /= null then
|
|
290 Fmap.Initialize (Mapping_File_Name.all);
|
|
291 end if;
|
|
292
|
|
293 -- Adjust Optimize_Alignment mode from debug switches if necessary
|
|
294
|
|
295 if Debug_Flag_Dot_SS then
|
|
296 Optimize_Alignment := 'S';
|
|
297 elsif Debug_Flag_Dot_TT then
|
|
298 Optimize_Alignment := 'T';
|
|
299 end if;
|
|
300
|
|
301 -- We have now processed the command line switches, and the
|
|
302 -- configuration pragma files, so this is the point at which we want to
|
|
303 -- capture the values of the configuration switches (see Opt for further
|
|
304 -- details).
|
|
305
|
131
|
306 Register_Config_Switches;
|
111
|
307
|
|
308 -- Check for file which contains No_Body pragma
|
|
309
|
|
310 if Source_File_Is_No_Body (Source_Index (Main_Unit)) then
|
|
311 Change_Main_Unit_To_Spec;
|
|
312 end if;
|
|
313
|
|
314 -- Initialize the scanner. Note that we do this after the call to
|
|
315 -- Create_Standard, which uses the scanner in its processing of
|
|
316 -- floating-point bounds.
|
|
317
|
|
318 Initialize_Scanner (Main_Unit, Source_Index (Main_Unit));
|
|
319
|
|
320 -- Here we call the parser to parse the compilation unit (or units in
|
|
321 -- the check syntax mode, but in that case we won't go on to the
|
|
322 -- semantics in any case).
|
|
323
|
|
324 Discard_List (Par (Configuration_Pragmas => False));
|
|
325 Parsing_Main_Extended_Source := False;
|
|
326
|
|
327 -- The main unit is now loaded, and subunits of it can be loaded,
|
|
328 -- without reporting spurious loading circularities.
|
|
329
|
|
330 Set_Loading (Main_Unit, False);
|
|
331
|
|
332 -- Now that the main unit is installed, we can complete the analysis
|
|
333 -- of the pragmas in gnat.adc and the configuration file, that require
|
|
334 -- a context for their semantic processing.
|
|
335
|
|
336 if Config_Pragmas /= Error_List
|
|
337 and then Operating_Mode /= Check_Syntax
|
|
338
|
|
339 -- Do not attempt to process deferred configuration pragmas if the
|
|
340 -- main unit failed to load, to avoid cascaded inconsistencies that
|
|
341 -- can lead to a compiler crash.
|
|
342
|
|
343 and then Fatal_Error (Main_Unit) /= Error_Detected
|
|
344 then
|
|
345 -- Pragmas that require some semantic activity, such as
|
|
346 -- Interrupt_State, cannot be processed until the main unit is
|
|
347 -- installed, because they require a compilation unit on which to
|
|
348 -- attach with_clauses, etc. So analyze them now.
|
|
349
|
|
350 declare
|
|
351 Prag : Node_Id;
|
|
352
|
|
353 begin
|
|
354 Prag := First (Config_Pragmas);
|
|
355 while Present (Prag) loop
|
|
356
|
|
357 -- Guard against the case where a configuration pragma may be
|
|
358 -- split into multiple pragmas and the original rewritten as a
|
|
359 -- null statement.
|
|
360
|
|
361 if Nkind (Prag) = N_Pragma
|
|
362 and then Delay_Config_Pragma_Analyze (Prag)
|
|
363 then
|
|
364 Analyze_Pragma (Prag);
|
|
365 end if;
|
|
366
|
|
367 Next (Prag);
|
|
368 end loop;
|
|
369 end;
|
|
370 end if;
|
|
371
|
|
372 -- If we have restriction No_Exception_Propagation, and we did not have
|
|
373 -- an explicit switch turning off Warn_On_Non_Local_Exception, then turn
|
|
374 -- on this warning by default if we have encountered an exception
|
|
375 -- handler.
|
|
376
|
|
377 if Restriction_Check_Required (No_Exception_Propagation)
|
|
378 and then not No_Warn_On_Non_Local_Exception
|
|
379 and then Exception_Handler_Encountered
|
|
380 then
|
|
381 Warn_On_Non_Local_Exception := True;
|
|
382 end if;
|
|
383
|
|
384 -- Now on to the semantics. Skip if in syntax only mode
|
|
385
|
|
386 if Operating_Mode /= Check_Syntax then
|
|
387
|
|
388 -- Install the configuration pragmas in the tree
|
|
389
|
|
390 Set_Config_Pragmas
|
|
391 (Aux_Decls_Node (Cunit (Main_Unit)), Config_Pragmas);
|
|
392
|
|
393 -- Following steps are skipped if we had a fatal error during parsing
|
|
394
|
|
395 if Fatal_Error (Main_Unit) /= Error_Detected then
|
|
396
|
|
397 -- Reset Operating_Mode to Check_Semantics for subunits. We cannot
|
|
398 -- actually generate code for subunits, so we suppress expansion.
|
|
399 -- This also corrects certain problems that occur if we try to
|
|
400 -- incorporate subunits at a lower level.
|
|
401
|
|
402 if Operating_Mode = Generate_Code
|
|
403 and then Nkind (Unit (Cunit (Main_Unit))) = N_Subunit
|
|
404 then
|
|
405 Operating_Mode := Check_Semantics;
|
|
406 end if;
|
|
407
|
|
408 -- Analyze (and possibly expand) main unit
|
|
409
|
|
410 Scope_Suppress := Suppress_Options;
|
|
411 Semantics (Cunit (Main_Unit));
|
|
412
|
|
413 -- Cleanup processing after completing main analysis
|
|
414
|
|
415 -- Comment needed for ASIS mode test and GNATprove mode test???
|
|
416
|
|
417 pragma Assert
|
|
418 (Operating_Mode = Generate_Code
|
|
419 or else Operating_Mode = Check_Semantics);
|
|
420
|
|
421 if Operating_Mode = Generate_Code
|
|
422 or else (ASIS_Mode or GNATprove_Mode)
|
|
423 then
|
|
424 Instantiate_Bodies;
|
|
425 end if;
|
|
426
|
|
427 -- Analyze all inlined bodies, check access-before-elaboration
|
|
428 -- rules, and remove ignored Ghost code when generating code or
|
|
429 -- compiling for GNATprove.
|
|
430
|
|
431 if Operating_Mode = Generate_Code or else GNATprove_Mode then
|
|
432 if Inline_Processing_Required then
|
|
433 Analyze_Inlined_Bodies;
|
|
434 end if;
|
|
435
|
|
436 -- Remove entities from program that do not have any execution
|
|
437 -- time references.
|
|
438
|
|
439 if Debug_Flag_UU then
|
|
440 Collect_Garbage_Entities;
|
|
441 end if;
|
|
442
|
131
|
443 if Legacy_Elaboration_Checks then
|
|
444 Check_Elab_Calls;
|
|
445 end if;
|
|
446
|
111
|
447 -- Examine all top level scenarios collected during analysis
|
131
|
448 -- and resolution. Diagnose conditional ABEs, install run-time
|
|
449 -- checks to catch conditional ABEs, and guarantee the prior
|
|
450 -- elaboration of external units.
|
111
|
451
|
|
452 Check_Elaboration_Scenarios;
|
|
453
|
131
|
454 -- Examine all top level scenarios collected during analysis and
|
|
455 -- resolution in order to diagnose conditional ABEs, even in the
|
|
456 -- presence of serious errors.
|
111
|
457
|
|
458 else
|
|
459 Check_Elaboration_Scenarios;
|
|
460 end if;
|
|
461
|
|
462 -- At this stage we can unnest subprogram bodies if required
|
|
463
|
131
|
464 if Total_Errors_Detected = 0 then
|
|
465 Exp_Unst.Unnest_Subprograms (Cunit (Main_Unit));
|
|
466 end if;
|
111
|
467
|
|
468 -- List library units if requested
|
|
469
|
|
470 if List_Units then
|
|
471 Lib.List;
|
|
472 end if;
|
|
473
|
|
474 -- Output waiting warning messages
|
|
475
|
|
476 Lib.Xref.Process_Deferred_References;
|
|
477 Sem_Warn.Output_Non_Modified_In_Out_Warnings;
|
|
478 Sem_Warn.Output_Unreferenced_Messages;
|
|
479 Sem_Warn.Check_Unused_Withs;
|
|
480 Sem_Warn.Output_Unused_Warnings_Off_Warnings;
|
131
|
481
|
|
482 -- Remove any ignored Ghost code as it must not appear in the
|
|
483 -- executable. This action must be performed last because it
|
|
484 -- heavily alters the tree.
|
|
485
|
|
486 if Operating_Mode = Generate_Code or else GNATprove_Mode then
|
|
487 Remove_Ignored_Ghost_Code;
|
|
488 end if;
|
111
|
489 end if;
|
|
490 end if;
|
|
491 end;
|
|
492
|
|
493 -- Qualify all entity names in inner packages, package bodies, etc
|
|
494
|
145
|
495 if not GNATprove_Mode then
|
|
496 Exp_Dbug.Qualify_All_Entity_Names;
|
|
497 end if;
|
111
|
498
|
|
499 -- SCIL backend requirement. Check that SCIL nodes associated with
|
|
500 -- dispatching calls reference subprogram calls.
|
|
501
|
|
502 if Generate_SCIL then
|
|
503 pragma Debug (Sem_SCIL.Check_SCIL_Nodes (Cunit (Main_Unit)));
|
|
504 null;
|
|
505 end if;
|
|
506
|
|
507 -- Dump the source now. Note that we do this as soon as the analysis
|
|
508 -- of the tree is complete, because it is not just a dump in the case
|
|
509 -- of -gnatD, where it rewrites all source locations in the tree.
|
|
510
|
|
511 Sprint.Source_Dump;
|
|
512
|
|
513 -- Check again for configuration pragmas that appear in the context
|
|
514 -- of the main unit. These pragmas only affect the main unit, and the
|
|
515 -- corresponding flag is reset after each call to Semantics, but they
|
|
516 -- may affect the generated ali for the unit, and therefore the flag
|
|
517 -- must be set properly after compilation. Currently we only check for
|
|
518 -- Initialize_Scalars, but others should be checked: as well???
|
|
519
|
|
520 declare
|
|
521 Item : Node_Id;
|
|
522
|
|
523 begin
|
|
524 Item := First (Context_Items (Cunit (Main_Unit)));
|
|
525 while Present (Item) loop
|
|
526 if Nkind (Item) = N_Pragma
|
|
527 and then Pragma_Name (Item) = Name_Initialize_Scalars
|
|
528 then
|
|
529 Initialize_Scalars := True;
|
|
530 end if;
|
|
531
|
|
532 Next (Item);
|
|
533 end loop;
|
|
534 end;
|
|
535
|
|
536 -- If a mapping file has been specified by a -gnatem switch, update
|
|
537 -- it if there has been some sources that were not in the mappings.
|
|
538
|
|
539 if Mapping_File_Name /= null then
|
|
540 Fmap.Update_Mapping_File (Mapping_File_Name.all);
|
|
541 end if;
|
|
542
|
|
543 return;
|
|
544 end Frontend;
|