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-2015, 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_Ch6; 34with Exp_Dbug; 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; use 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; use Rtsfind; 53with Snames; use Snames; 54with Sprint; 55with Scn; use Scn; 56with Sem; use Sem; 57with Sem_Aux; 58with Sem_Ch8; use Sem_Ch8; 59with Sem_SCIL; 60with Sem_Elab; use Sem_Elab; 61with Sem_Prag; use Sem_Prag; 62with Sem_Warn; use Sem_Warn; 63with Sinfo; use Sinfo; 64with Sinput; use Sinput; 65with Sinput.L; use Sinput.L; 66with SCIL_LL; use SCIL_LL; 67with Tbuild; use Tbuild; 68with Types; use Types; 69 70procedure Frontend is 71 Config_Pragmas : List_Id; 72 -- Gather configuration pragmas 73 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 Exp_Ch6.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 Save_Style_Check : constant Boolean := Opt.Style_Check; 141 -- Save style check mode so it can be restored later 142 143 Source_Config_File : Source_File_Index; 144 -- Source reference for -gnatec configuration file 145 146 Prag : Node_Id; 147 148 Temp_File : Boolean; 149 150 begin 151 -- We always analyze config files with style checks off, since we 152 -- don't want a miscellaneous gnat.adc that is around to discombobulate 153 -- intended -gnatg or -gnaty compilations. We also disconnect checking 154 -- for maximum line length. 155 156 Opt.Style_Check := False; 157 Style_Check := False; 158 159 -- Capture current suppress options, which may get modified 160 161 Scope_Suppress := Opt.Suppress_Options; 162 163 -- First deal with gnat.adc file 164 165 if Opt.Config_File then 166 Name_Buffer (1 .. 8) := "gnat.adc"; 167 Name_Len := 8; 168 Source_gnat_adc := Load_Config_File (Name_Enter); 169 170 -- Case of gnat.adc file present 171 172 if Source_gnat_adc /= No_Source_File then 173 174 -- Parse the gnat.adc file for configuration pragmas 175 176 Initialize_Scanner (No_Unit, Source_gnat_adc); 177 Config_Pragmas := Par (Configuration_Pragmas => True); 178 179 -- We unconditionally add a compilation dependency for gnat.adc 180 -- so that if it changes, we force a recompilation. This is a 181 -- fairly recent (2014-03-28) change. 182 183 Prepcomp.Add_Dependency (Source_gnat_adc); 184 185 -- Case of no gnat.adc file present 186 187 else 188 Config_Pragmas := Empty_List; 189 end if; 190 191 else 192 Config_Pragmas := Empty_List; 193 end if; 194 195 -- Now deal with specified config pragmas files if there are any 196 197 if Opt.Config_File_Names /= null then 198 199 -- Loop through config pragmas files 200 201 for Index in Opt.Config_File_Names'Range loop 202 203 -- See if extension is .TMP/.tmp indicating a temporary config 204 -- file (which we ignore from the dependency point of view). 205 206 Name_Len := Config_File_Names (Index)'Length; 207 Name_Buffer (1 .. Name_Len) := Config_File_Names (Index).all; 208 Temp_File := 209 Name_Len > 4 210 and then 211 (Name_Buffer (Name_Len - 3 .. Name_Len) = ".TMP" 212 or else 213 Name_Buffer (Name_Len - 3 .. Name_Len) = ".tmp"); 214 215 -- Load the file, error if we did not find it 216 217 Source_Config_File := Load_Config_File (Name_Enter); 218 219 if Source_Config_File = No_Source_File then 220 Osint.Fail 221 ("cannot find configuration pragmas file " 222 & Config_File_Names (Index).all); 223 224 -- If we did find the file, and it is not a temporary file, then 225 -- we unconditionally add a compilation dependency for it so 226 -- that if it changes, we force a recompilation. This is a 227 -- fairly recent (2014-03-28) change. 228 229 elsif not Temp_File then 230 Prepcomp.Add_Dependency (Source_Config_File); 231 end if; 232 233 -- Parse the config pragmas file, and accumulate results 234 235 Initialize_Scanner (No_Unit, Source_Config_File); 236 Append_List_To 237 (Config_Pragmas, Par (Configuration_Pragmas => True)); 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 end; 265 266 -- If a target dependency info file has been read through switch -gnateT=, 267 -- add it to the dependencies. 268 269 if Target_Dependent_Info_Read_Name /= null then 270 declare 271 Index : Source_File_Index; 272 begin 273 Name_Len := 0; 274 Add_Str_To_Name_Buffer (Target_Dependent_Info_Read_Name.all); 275 Index := Load_Config_File (Name_Enter); 276 Prepcomp.Add_Dependency (Index); 277 end; 278 end if; 279 280 -- This is where we can capture the value of the compilation unit specific 281 -- restrictions that have been set by the config pragma files (or from 282 -- Targparm), for later restoration when processing e.g. subunits. 283 284 Save_Config_Cunit_Boolean_Restrictions; 285 286 -- If there was a -gnatem switch, initialize the mappings of unit names to 287 -- 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 configuration 302 -- pragma files, so this is the point at which we want to capture the 303 -- values of the configuration switches (see Opt for further details). 304 305 Opt.Register_Opt_Config_Switches; 306 307 -- Check for file which contains No_Body pragma 308 309 if Source_File_Is_No_Body (Source_Index (Main_Unit)) then 310 Change_Main_Unit_To_Spec; 311 end if; 312 313 -- Initialize the scanner. Note that we do this after the call to 314 -- Create_Standard, which uses the scanner in its processing of 315 -- floating-point bounds. 316 317 Initialize_Scanner (Main_Unit, Source_Index (Main_Unit)); 318 319 -- Here we call the parser to parse the compilation unit (or units in 320 -- the check syntax mode, but in that case we won't go on to the 321 -- semantics in any case). 322 323 Discard_List (Par (Configuration_Pragmas => False)); 324 Parsing_Main_Extended_Source := False; 325 326 -- The main unit is now loaded, and subunits of it can be loaded, 327 -- without reporting spurious loading circularities. 328 329 Set_Loading (Main_Unit, False); 330 331 -- Now that the main unit is installed, we can complete the analysis 332 -- of the pragmas in gnat.adc and the configuration file, that require 333 -- a context for their semantic processing. 334 335 if Config_Pragmas /= Error_List 336 and then Operating_Mode /= Check_Syntax 337 338 -- Do not attempt to process deferred configuration pragmas if the main 339 -- unit failed to load, to avoid cascaded inconsistencies that can lead 340 -- to a compiler crash. 341 342 and then Fatal_Error (Main_Unit) /= Error_Detected 343 then 344 -- Pragmas that require some semantic activity, such as Interrupt_State, 345 -- cannot be processed until the main unit is installed, because they 346 -- require a compilation unit on which to attach with_clauses, etc. So 347 -- analyze them now. 348 349 declare 350 Prag : Node_Id; 351 352 begin 353 Prag := First (Config_Pragmas); 354 while Present (Prag) loop 355 356 -- Guard against the case where a configuration pragma may be 357 -- split into multiple pragmas and the original rewritten as a 358 -- null statement. 359 360 if Nkind (Prag) = N_Pragma 361 and then Delay_Config_Pragma_Analyze (Prag) 362 then 363 Analyze_Pragma (Prag); 364 end if; 365 366 Next (Prag); 367 end loop; 368 end; 369 end if; 370 371 -- If we have restriction No_Exception_Propagation, and we did not have an 372 -- explicit switch turning off Warn_On_Non_Local_Exception, then turn on 373 -- this warning by default if we have encountered an exception handler. 374 375 if Restriction_Check_Required (No_Exception_Propagation) 376 and then not No_Warn_On_Non_Local_Exception 377 and then Exception_Handler_Encountered 378 then 379 Warn_On_Non_Local_Exception := True; 380 end if; 381 382 -- Now on to the semantics. Skip if in syntax only mode 383 384 if Operating_Mode /= Check_Syntax then 385 386 -- Install the configuration pragmas in the tree 387 388 Set_Config_Pragmas (Aux_Decls_Node (Cunit (Main_Unit)), Config_Pragmas); 389 390 -- Following steps are skipped if we had a fatal error during parsing 391 392 if Fatal_Error (Main_Unit) /= Error_Detected then 393 394 -- Reset Operating_Mode to Check_Semantics for subunits. We cannot 395 -- actually generate code for subunits, so we suppress expansion. 396 -- This also corrects certain problems that occur if we try to 397 -- incorporate subunits at a lower level. 398 399 if Operating_Mode = Generate_Code 400 and then Nkind (Unit (Cunit (Main_Unit))) = N_Subunit 401 then 402 Operating_Mode := Check_Semantics; 403 end if; 404 405 -- Analyze (and possibly expand) main unit 406 407 Scope_Suppress := Suppress_Options; 408 Semantics (Cunit (Main_Unit)); 409 410 -- Cleanup processing after completing main analysis 411 412 -- Comment needed for ASIS mode test and GNATprove mode test??? 413 414 if Operating_Mode = Generate_Code 415 or else (Operating_Mode = Check_Semantics 416 and then (ASIS_Mode or GNATprove_Mode)) 417 then 418 Instantiate_Bodies; 419 end if; 420 421 if Operating_Mode = Generate_Code then 422 if Inline_Processing_Required then 423 Analyze_Inlined_Bodies; 424 end if; 425 426 -- Remove entities from program that do not have any execution 427 -- time references. 428 429 if Debug_Flag_UU then 430 Collect_Garbage_Entities; 431 end if; 432 433 Check_Elab_Calls; 434 435 -- Remove any ignored Ghost code as it must not appear in the 436 -- executable. 437 438 Remove_Ignored_Ghost_Code; 439 end if; 440 441 -- At this stage we can unnest subprogram bodies if required 442 443 Exp_Ch6.Unnest_Subprograms; 444 445 -- List library units if requested 446 447 if List_Units then 448 Lib.List; 449 end if; 450 451 -- Output waiting warning messages 452 453 Lib.Xref.Process_Deferred_References; 454 Sem_Warn.Output_Non_Modified_In_Out_Warnings; 455 Sem_Warn.Output_Unreferenced_Messages; 456 Sem_Warn.Check_Unused_Withs; 457 Sem_Warn.Output_Unused_Warnings_Off_Warnings; 458 end if; 459 end if; 460 461 -- Qualify all entity names in inner packages, package bodies, etc. 462 463 Exp_Dbug.Qualify_All_Entity_Names; 464 465 -- SCIL backend requirement. Check that SCIL nodes associated with 466 -- dispatching calls reference subprogram calls. 467 468 if Generate_SCIL then 469 pragma Debug (Sem_SCIL.Check_SCIL_Nodes (Cunit (Main_Unit))); 470 null; 471 end if; 472 473 -- Dump the source now. Note that we do this as soon as the analysis 474 -- of the tree is complete, because it is not just a dump in the case 475 -- of -gnatD, where it rewrites all source locations in the tree. 476 477 Sprint.Source_Dump; 478 479 -- Check again for configuration pragmas that appear in the context 480 -- of the main unit. These pragmas only affect the main unit, and the 481 -- corresponding flag is reset after each call to Semantics, but they 482 -- may affect the generated ali for the unit, and therefore the flag 483 -- must be set properly after compilation. Currently we only check for 484 -- Initialize_Scalars, but others should be checked: as well??? 485 486 declare 487 Item : Node_Id; 488 489 begin 490 Item := First (Context_Items (Cunit (Main_Unit))); 491 while Present (Item) loop 492 if Nkind (Item) = N_Pragma 493 and then Pragma_Name (Item) = Name_Initialize_Scalars 494 then 495 Initialize_Scalars := True; 496 end if; 497 498 Next (Item); 499 end loop; 500 end; 501 502 -- If a mapping file has been specified by a -gnatem switch, update 503 -- it if there has been some sources that were not in the mappings. 504 505 if Mapping_File_Name /= null then 506 Fmap.Update_Mapping_File (Mapping_File_Name.all); 507 end if; 508 509 return; 510end Frontend; 511