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