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-2012, 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 Fmap; 35with Fname.UF; 36with Inline; use Inline; 37with Lib; use Lib; 38with Lib.Load; use Lib.Load; 39with Live; use Live; 40with Namet; use Namet; 41with Nlists; use Nlists; 42with Opt; use Opt; 43with Osint; 44with Par; 45with Prep; 46with Prepcomp; 47with Restrict; use Restrict; 48with Rident; use Rident; 49with Rtsfind; use Rtsfind; 50with Snames; use Snames; 51with Sprint; 52with Scn; use Scn; 53with Sem; use Sem; 54with Sem_Aux; 55with Sem_Ch8; use Sem_Ch8; 56with Sem_SCIL; 57with Sem_Elab; use Sem_Elab; 58with Sem_Prag; use Sem_Prag; 59with Sem_Warn; use Sem_Warn; 60with Sinfo; use Sinfo; 61with Sinput; use Sinput; 62with Sinput.L; use Sinput.L; 63with SCIL_LL; use SCIL_LL; 64with Targparm; use Targparm; 65with Tbuild; use Tbuild; 66with Types; use Types; 67 68procedure Frontend is 69 Config_Pragmas : List_Id; 70 -- Gather configuration pragmas 71 72begin 73 -- Carry out package initializations. These are initializations which might 74 -- logically be performed at elaboration time, were it not for the fact 75 -- that we may be doing things more than once in the big loop over files. 76 -- Like elaboration, the order in which these calls are made is in some 77 -- cases important. For example, Lib cannot be initialized before Namet, 78 -- since it uses names table entries. 79 80 Rtsfind.Initialize; 81 Atree.Initialize; 82 Nlists.Initialize; 83 Elists.Initialize; 84 Lib.Load.Initialize; 85 Sem_Aux.Initialize; 86 Sem_Ch8.Initialize; 87 Sem_Prag.Initialize; 88 Fname.UF.Initialize; 89 Checks.Initialize; 90 Sem_Warn.Initialize; 91 Prep.Initialize; 92 93 if Generate_SCIL then 94 SCIL_LL.Initialize; 95 end if; 96 97 -- Create package Standard 98 99 CStand.Create_Standard; 100 101 -- If the -gnatd.H flag is present, we are only interested in the Standard 102 -- package, so the frontend has done its job here. 103 104 if Debug_Flag_Dot_HH then 105 return; 106 end if; 107 108 -- Check possible symbol definitions specified by -gnateD switches 109 110 Prepcomp.Process_Command_Line_Symbol_Definitions; 111 112 -- If -gnatep= was specified, parse the preprocessing data file 113 114 if Preprocessing_Data_File /= null then 115 Name_Len := Preprocessing_Data_File'Length; 116 Name_Buffer (1 .. Name_Len) := Preprocessing_Data_File.all; 117 Prepcomp.Parse_Preprocessing_Data_File (Name_Find); 118 119 -- Otherwise, check if there were preprocessing symbols on the command 120 -- line and set preprocessing if there are. 121 122 else 123 Prepcomp.Check_Symbols; 124 end if; 125 126 -- We set Parsing_Main_Extended_Source true here to cover processing of all 127 -- the configuration pragma files, as well as the main source unit itself. 128 129 Parsing_Main_Extended_Source := True; 130 131 -- Now that the preprocessing situation is established, we are able to 132 -- load the main source (this is no longer done by Lib.Load.Initialize). 133 134 Lib.Load.Load_Main_Source; 135 136 -- Return immediately if the main source could not be found 137 138 if Sinput.Main_Source_File = No_Source_File then 139 return; 140 end if; 141 142 -- Read and process configuration pragma files if present 143 144 declare 145 Save_Style_Check : constant Boolean := Opt.Style_Check; 146 -- Save style check mode so it can be restored later 147 148 Source_Config_File : Source_File_Index; 149 -- Source reference for -gnatec configuration file 150 151 Prag : Node_Id; 152 153 begin 154 -- We always analyze config files with style checks off, since 155 -- we don't want a miscellaneous gnat.adc that is around to 156 -- discombobulate intended -gnatg or -gnaty compilations. We 157 -- also disconnect checking for maximum line length. 158 159 Opt.Style_Check := False; 160 Style_Check := False; 161 162 -- Capture current suppress options, which may get modified 163 164 Scope_Suppress := Opt.Suppress_Options; 165 166 -- First deal with gnat.adc file 167 168 if Opt.Config_File then 169 Name_Buffer (1 .. 8) := "gnat.adc"; 170 Name_Len := 8; 171 Source_gnat_adc := Load_Config_File (Name_Enter); 172 173 if Source_gnat_adc /= No_Source_File then 174 Initialize_Scanner (No_Unit, Source_gnat_adc); 175 Config_Pragmas := Par (Configuration_Pragmas => True); 176 else 177 Config_Pragmas := Empty_List; 178 end if; 179 180 else 181 Config_Pragmas := Empty_List; 182 end if; 183 184 -- Now deal with specified config pragmas files if there are any 185 186 if Opt.Config_File_Names /= null then 187 for Index in Opt.Config_File_Names'Range loop 188 Name_Len := Config_File_Names (Index)'Length; 189 Name_Buffer (1 .. Name_Len) := Config_File_Names (Index).all; 190 Source_Config_File := Load_Config_File (Name_Enter); 191 192 if Source_Config_File = No_Source_File then 193 Osint.Fail 194 ("cannot find configuration pragmas file " 195 & Config_File_Names (Index).all); 196 end if; 197 198 Initialize_Scanner (No_Unit, Source_Config_File); 199 Append_List_To 200 (Config_Pragmas, Par (Configuration_Pragmas => True)); 201 end loop; 202 end if; 203 204 -- Now analyze all pragmas except those whose analysis must be 205 -- deferred till after the main unit is analyzed. 206 207 if Config_Pragmas /= Error_List 208 and then Operating_Mode /= Check_Syntax 209 then 210 Prag := First (Config_Pragmas); 211 while Present (Prag) loop 212 if not Delay_Config_Pragma_Analyze (Prag) then 213 Analyze_Pragma (Prag); 214 end if; 215 216 Next (Prag); 217 end loop; 218 end if; 219 220 -- Restore style check, but if config file turned on checks, leave on! 221 222 Opt.Style_Check := Save_Style_Check or Style_Check; 223 224 -- Capture any modifications to suppress options from config pragmas 225 226 Opt.Suppress_Options := Scope_Suppress; 227 end; 228 229 -- This is where we can capture the value of the compilation unit specific 230 -- restrictions that have been set by the config pragma files (or from 231 -- Targparm), for later restoration when processing e.g. subunits. 232 233 Save_Config_Cunit_Boolean_Restrictions; 234 235 -- If there was a -gnatem switch, initialize the mappings of unit names to 236 -- file names and of file names to path names from the mapping file. 237 238 if Mapping_File_Name /= null then 239 Fmap.Initialize (Mapping_File_Name.all); 240 end if; 241 242 -- Adjust Optimize_Alignment mode from debug switches if necessary 243 244 if Debug_Flag_Dot_SS then 245 Optimize_Alignment := 'S'; 246 elsif Debug_Flag_Dot_TT then 247 Optimize_Alignment := 'T'; 248 end if; 249 250 -- We have now processed the command line switches, and the configuration 251 -- pragma files, so this is the point at which we want to capture the 252 -- values of the configuration switches (see Opt for further details). 253 254 Opt.Register_Opt_Config_Switches; 255 256 -- Check for file which contains No_Body pragma 257 258 if Source_File_Is_No_Body (Source_Index (Main_Unit)) then 259 Change_Main_Unit_To_Spec; 260 end if; 261 262 -- Initialize the scanner. Note that we do this after the call to 263 -- Create_Standard, which uses the scanner in its processing of 264 -- floating-point bounds. 265 266 Initialize_Scanner (Main_Unit, Source_Index (Main_Unit)); 267 268 -- Here we call the parser to parse the compilation unit (or units in 269 -- the check syntax mode, but in that case we won't go on to the 270 -- semantics in any case). 271 272 Discard_List (Par (Configuration_Pragmas => False)); 273 Parsing_Main_Extended_Source := False; 274 275 -- The main unit is now loaded, and subunits of it can be loaded, 276 -- without reporting spurious loading circularities. 277 278 Set_Loading (Main_Unit, False); 279 280 -- Now that the main unit is installed, we can complete the analysis 281 -- of the pragmas in gnat.adc and the configuration file, that require 282 -- a context for their semantic processing. 283 284 if Config_Pragmas /= Error_List 285 and then Operating_Mode /= Check_Syntax 286 287 -- Do not attempt to process deferred configuration pragmas if the main 288 -- unit failed to load, to avoid cascaded inconsistencies that can lead 289 -- to a compiler crash. 290 291 and then not Fatal_Error (Main_Unit) 292 then 293 -- Pragmas that require some semantic activity, such as 294 -- Interrupt_State, cannot be processed until the main unit 295 -- is installed, because they require a compilation unit on 296 -- which to attach with_clauses, etc. So analyze them now. 297 298 declare 299 Prag : Node_Id; 300 301 begin 302 Prag := First (Config_Pragmas); 303 while Present (Prag) loop 304 if Delay_Config_Pragma_Analyze (Prag) then 305 Analyze_Pragma (Prag); 306 end if; 307 308 Next (Prag); 309 end loop; 310 end; 311 end if; 312 313 -- If we have restriction No_Exception_Propagation, and we did not have an 314 -- explicit switch turning off Warn_On_Non_Local_Exception, then turn on 315 -- this warning by default if we have encountered an exception handler. 316 317 if Restriction_Check_Required (No_Exception_Propagation) 318 and then not No_Warn_On_Non_Local_Exception 319 and then Exception_Handler_Encountered 320 then 321 Warn_On_Non_Local_Exception := True; 322 end if; 323 324 -- Now on to the semantics. Skip if in syntax only mode 325 326 if Operating_Mode /= Check_Syntax then 327 328 -- Install the configuration pragmas in the tree 329 330 Set_Config_Pragmas (Aux_Decls_Node (Cunit (Main_Unit)), Config_Pragmas); 331 332 -- Following steps are skipped if we had a fatal error during parsing 333 334 if not Fatal_Error (Main_Unit) then 335 336 -- Reset Operating_Mode to Check_Semantics for subunits. We cannot 337 -- actually generate code for subunits, so we suppress expansion. 338 -- This also corrects certain problems that occur if we try to 339 -- incorporate subunits at a lower level. 340 341 if Operating_Mode = Generate_Code 342 and then Nkind (Unit (Cunit (Main_Unit))) = N_Subunit 343 then 344 Operating_Mode := Check_Semantics; 345 end if; 346 347 -- Analyze (and possibly expand) main unit 348 349 Scope_Suppress := Suppress_Options; 350 Semantics (Cunit (Main_Unit)); 351 352 -- Cleanup processing after completing main analysis 353 354 if Operating_Mode = Generate_Code 355 or else (Operating_Mode = Check_Semantics 356 and then ASIS_Mode) 357 then 358 Instantiate_Bodies; 359 end if; 360 361 if Operating_Mode = Generate_Code then 362 if Inline_Processing_Required then 363 Analyze_Inlined_Bodies; 364 end if; 365 366 -- Remove entities from program that do not have any 367 -- execution time references. 368 369 if Debug_Flag_UU then 370 Collect_Garbage_Entities; 371 end if; 372 373 Check_Elab_Calls; 374 end if; 375 376 -- List library units if requested 377 378 if List_Units then 379 Lib.List; 380 end if; 381 382 -- Output waiting warning messages 383 384 Sem_Warn.Output_Non_Modified_In_Out_Warnings; 385 Sem_Warn.Output_Unreferenced_Messages; 386 Sem_Warn.Check_Unused_Withs; 387 Sem_Warn.Output_Unused_Warnings_Off_Warnings; 388 end if; 389 end if; 390 391 -- Qualify all entity names in inner packages, package bodies, etc., 392 -- except when compiling for the VM back-ends, which depend on having 393 -- unqualified names in certain cases and handles the generation of 394 -- qualified names when needed. 395 396 if VM_Target = No_VM then 397 Exp_Dbug.Qualify_All_Entity_Names; 398 end if; 399 400 -- SCIL backend requirement. Check that SCIL nodes associated with 401 -- dispatching calls reference subprogram calls. 402 403 if Generate_SCIL then 404 pragma Debug (Sem_SCIL.Check_SCIL_Nodes (Cunit (Main_Unit))); 405 null; 406 end if; 407 408 -- Dump the source now. Note that we do this as soon as the analysis 409 -- of the tree is complete, because it is not just a dump in the case 410 -- of -gnatD, where it rewrites all source locations in the tree. 411 412 Sprint.Source_Dump; 413 414 -- Check again for configuration pragmas that appear in the context of 415 -- the main unit. These pragmas only affect the main unit, and the 416 -- corresponding flag is reset after each call to Semantics, but they 417 -- may affect the generated ali for the unit, and therefore the flag 418 -- must be set properly after compilation. Currently we only check for 419 -- Initialize_Scalars, but others should be checked: as well??? 420 421 declare 422 Item : Node_Id; 423 424 begin 425 Item := First (Context_Items (Cunit (Main_Unit))); 426 while Present (Item) loop 427 if Nkind (Item) = N_Pragma 428 and then Pragma_Name (Item) = Name_Initialize_Scalars 429 then 430 Initialize_Scalars := True; 431 end if; 432 433 Next (Item); 434 end loop; 435 end; 436 437 -- If a mapping file has been specified by a -gnatem switch, update 438 -- it if there has been some sources that were not in the mappings. 439 440 if Mapping_File_Name /= null then 441 Fmap.Update_Mapping_File (Mapping_File_Name.all); 442 end if; 443 444 return; 445end Frontend; 446