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