1------------------------------------------------------------------------------ 2-- -- 3-- GNAT COMPILER COMPONENTS -- 4-- -- 5-- F R O N T E N D -- 6-- -- 7-- B o d y -- 8-- -- 9-- Copyright (C) 1992-2019, Free Software Foundation, Inc. -- 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 26with System.Strings; use System.Strings; 27 28with Atree; use Atree; 29with Checks; 30with CStand; 31with Debug; use Debug; 32with Elists; 33with Exp_Dbug; 34with Exp_Unst; 35with Fmap; 36with Fname.UF; 37with Ghost; use Ghost; 38with Inline; use Inline; 39with Lib; use Lib; 40with Lib.Load; use Lib.Load; 41with Lib.Xref; 42with Live; use Live; 43with Namet; use Namet; 44with Nlists; use Nlists; 45with Opt; use Opt; 46with Osint; 47with Par; 48with Prep; 49with Prepcomp; 50with Restrict; use Restrict; 51with Rident; use Rident; 52with Rtsfind; 53with Snames; use Snames; 54with Sprint; 55with Scn; use Scn; 56with Sem; use Sem; 57with Sem_Aux; 58with Sem_Ch8; 59with Sem_SCIL; 60with Sem_Elab; use Sem_Elab; 61with Sem_Prag; use Sem_Prag; 62with Sem_Warn; 63with Sinfo; use Sinfo; 64with Sinput; use Sinput; 65with Sinput.L; use Sinput.L; 66with SCIL_LL; 67with Tbuild; use Tbuild; 68with Types; use Types; 69 70procedure Frontend is 71begin 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 306 Register_Config_Switches; 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 443 if Legacy_Elaboration_Checks then 444 Check_Elab_Calls; 445 end if; 446 447 -- Examine all top level scenarios collected during analysis 448 -- and resolution. Diagnose conditional ABEs, install run-time 449 -- checks to catch conditional ABEs, and guarantee the prior 450 -- elaboration of external units. 451 452 Check_Elaboration_Scenarios; 453 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. 457 458 else 459 Check_Elaboration_Scenarios; 460 end if; 461 462 -- At this stage we can unnest subprogram bodies if required 463 464 if Total_Errors_Detected = 0 then 465 Exp_Unst.Unnest_Subprograms (Cunit (Main_Unit)); 466 end if; 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; 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; 489 end if; 490 end if; 491 end; 492 493 -- Qualify all entity names in inner packages, package bodies, etc 494 495 Exp_Dbug.Qualify_All_Entity_Names; 496 497 -- SCIL backend requirement. Check that SCIL nodes associated with 498 -- dispatching calls reference subprogram calls. 499 500 if Generate_SCIL then 501 pragma Debug (Sem_SCIL.Check_SCIL_Nodes (Cunit (Main_Unit))); 502 null; 503 end if; 504 505 -- Dump the source now. Note that we do this as soon as the analysis 506 -- of the tree is complete, because it is not just a dump in the case 507 -- of -gnatD, where it rewrites all source locations in the tree. 508 509 Sprint.Source_Dump; 510 511 -- Check again for configuration pragmas that appear in the context 512 -- of the main unit. These pragmas only affect the main unit, and the 513 -- corresponding flag is reset after each call to Semantics, but they 514 -- may affect the generated ali for the unit, and therefore the flag 515 -- must be set properly after compilation. Currently we only check for 516 -- Initialize_Scalars, but others should be checked: as well??? 517 518 declare 519 Item : Node_Id; 520 521 begin 522 Item := First (Context_Items (Cunit (Main_Unit))); 523 while Present (Item) loop 524 if Nkind (Item) = N_Pragma 525 and then Pragma_Name (Item) = Name_Initialize_Scalars 526 then 527 Initialize_Scalars := True; 528 end if; 529 530 Next (Item); 531 end loop; 532 end; 533 534 -- If a mapping file has been specified by a -gnatem switch, update 535 -- it if there has been some sources that were not in the mappings. 536 537 if Mapping_File_Name /= null then 538 Fmap.Update_Mapping_File (Mapping_File_Name.all); 539 end if; 540 541 return; 542end Frontend; 543