File : frontend.adb


   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-2016, 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 
  26 with System.Strings; use System.Strings;
  27 
  28 with Atree;    use Atree;
  29 with Checks;
  30 with CStand;
  31 with Debug;    use Debug;
  32 with Elists;
  33 with Exp_Dbug;
  34 with Exp_Unst;
  35 with Fmap;
  36 with Fname.UF;
  37 with Ghost;    use Ghost;
  38 with Inline;   use Inline;
  39 with Lib;      use Lib;
  40 with Lib.Load; use Lib.Load;
  41 with Lib.Xref; use Lib.Xref;
  42 with Live;     use Live;
  43 with Namet;    use Namet;
  44 with Nlists;   use Nlists;
  45 with Opt;      use Opt;
  46 with Osint;
  47 with Par;
  48 with Prep;
  49 with Prepcomp;
  50 with Restrict; use Restrict;
  51 with Rident;   use Rident;
  52 with Rtsfind;  use Rtsfind;
  53 with Snames;   use Snames;
  54 with Sprint;
  55 with Scn;      use Scn;
  56 with Sem;      use Sem;
  57 with Sem_Aux;
  58 with Sem_Ch8;  use Sem_Ch8;
  59 with Sem_SCIL;
  60 with Sem_Elab; use Sem_Elab;
  61 with Sem_Prag; use Sem_Prag;
  62 with Sem_Warn; use Sem_Warn;
  63 with Sinfo;    use Sinfo;
  64 with Sinput;   use Sinput;
  65 with Sinput.L; use Sinput.L;
  66 with SCIL_LL;  use SCIL_LL;
  67 with Tbuild;   use Tbuild;
  68 with Types;    use Types;
  69 
  70 procedure Frontend is
  71    Config_Pragmas : List_Id;
  72    --  Gather configuration pragmas
  73 
  74 begin
  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 
  94    if Generate_SCIL then
  95       SCIL_LL.Initialize;
  96    end if;
  97 
  98    --  Create package Standard
  99 
 100    CStand.Create_Standard;
 101 
 102    --  Check possible symbol definitions specified by -gnateD switches
 103 
 104    Prepcomp.Process_Command_Line_Symbol_Definitions;
 105 
 106    --  If -gnatep= was specified, parse the preprocessing data file
 107 
 108    if Preprocessing_Data_File /= null then
 109       Name_Len := Preprocessing_Data_File'Length;
 110       Name_Buffer (1 .. Name_Len) := Preprocessing_Data_File.all;
 111       Prepcomp.Parse_Preprocessing_Data_File (Name_Find);
 112 
 113    --  Otherwise, check if there were preprocessing symbols on the command
 114    --  line and set preprocessing if there are.
 115 
 116    else
 117       Prepcomp.Check_Symbols;
 118    end if;
 119 
 120    --  We set Parsing_Main_Extended_Source true here to cover processing of all
 121    --  the configuration pragma files, as well as the main source unit itself.
 122 
 123    Parsing_Main_Extended_Source := True;
 124 
 125    --  Now that the preprocessing situation is established, we are able to
 126    --  load the main source (this is no longer done by Lib.Load.Initialize).
 127 
 128    Lib.Load.Load_Main_Source;
 129 
 130    --  Return immediately if the main source could not be found
 131 
 132    if Sinput.Main_Source_File = No_Source_File then
 133       return;
 134    end if;
 135 
 136    --  Read and process configuration pragma files if present
 137 
 138    declare
 139       Save_Style_Check : constant Boolean := Opt.Style_Check;
 140       --  Save style check mode so it can be restored later
 141 
 142       Source_Config_File : Source_File_Index;
 143       --  Source reference for -gnatec configuration file
 144 
 145       Prag : Node_Id;
 146 
 147       Temp_File : Boolean;
 148 
 149    begin
 150       --  We always analyze config files with style checks off, since we
 151       --  don't want a miscellaneous gnat.adc that is around to discombobulate
 152       --  intended -gnatg or -gnaty compilations. We also disconnect checking
 153       --  for maximum line length.
 154 
 155       Opt.Style_Check := False;
 156       Style_Check := False;
 157 
 158       --  Capture current suppress options, which may get modified
 159 
 160       Scope_Suppress := Opt.Suppress_Options;
 161 
 162       --  First deal with gnat.adc file
 163 
 164       if Opt.Config_File then
 165          Name_Buffer (1 .. 8) := "gnat.adc";
 166          Name_Len := 8;
 167          Source_gnat_adc := Load_Config_File (Name_Enter);
 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 unconditionally add a compilation dependency for gnat.adc
 179             --  so that if it changes, we force a recompilation. This is a
 180             --  fairly recent (2014-03-28) change.
 181 
 182             Prepcomp.Add_Dependency (Source_gnat_adc);
 183 
 184          --  Case of no gnat.adc file present
 185 
 186          else
 187             Config_Pragmas := Empty_List;
 188          end if;
 189 
 190       else
 191          Config_Pragmas := Empty_List;
 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 
 198          --  Loop through config pragmas files
 199 
 200          for Index in Opt.Config_File_Names'Range loop
 201 
 202             --  See if extension is .TMP/.tmp indicating a temporary config
 203             --  file (which we ignore from the dependency point of view).
 204 
 205             Name_Len := Config_File_Names (Index)'Length;
 206             Name_Buffer (1 .. Name_Len) := Config_File_Names (Index).all;
 207             Temp_File :=
 208               Name_Len > 4
 209                 and then
 210                   (Name_Buffer (Name_Len - 3 .. Name_Len) = ".TMP"
 211                      or else
 212                    Name_Buffer (Name_Len - 3 .. Name_Len) = ".tmp");
 213 
 214             --  Load the file, error if we did not find it
 215 
 216             Source_Config_File := Load_Config_File (Name_Enter);
 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, then
 224             --  we unconditionally add a compilation dependency for it so
 225             --  that if it changes, we force a recompilation. This is a
 226             --  fairly recent (2014-03-28) change.
 227 
 228             elsif not Temp_File then
 229                Prepcomp.Add_Dependency (Source_Config_File);
 230             end if;
 231 
 232             --  Parse the config pragmas file, and accumulate results
 233 
 234             Initialize_Scanner (No_Unit, Source_Config_File);
 235             Append_List_To
 236               (Config_Pragmas, Par (Configuration_Pragmas => True));
 237          end loop;
 238       end if;
 239 
 240       --  Now analyze all pragmas except those whose analysis must be
 241       --  deferred till after the main unit is analyzed.
 242 
 243       if Config_Pragmas /= Error_List
 244         and then Operating_Mode /= Check_Syntax
 245       then
 246          Prag := First (Config_Pragmas);
 247          while Present (Prag) loop
 248             if not Delay_Config_Pragma_Analyze (Prag) then
 249                Analyze_Pragma (Prag);
 250             end if;
 251 
 252             Next (Prag);
 253          end loop;
 254       end if;
 255 
 256       --  Restore style check, but if config file turned on checks, leave on
 257 
 258       Opt.Style_Check := Save_Style_Check or Style_Check;
 259 
 260       --  Capture any modifications to suppress options from config pragmas
 261 
 262       Opt.Suppress_Options := Scope_Suppress;
 263    end;
 264 
 265    --  If a target dependency info file has been read through switch -gnateT=,
 266    --  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 specific
 280    --  restrictions that have been set by the config pragma files (or from
 281    --  Targparm), for later restoration when processing e.g. subunits.
 282 
 283    Save_Config_Cunit_Boolean_Restrictions;
 284 
 285    --  If there was a -gnatem switch, initialize the mappings of unit names to
 286    --  file names and of file names to path names from the mapping file.
 287 
 288    if Mapping_File_Name /= null then
 289       Fmap.Initialize (Mapping_File_Name.all);
 290    end if;
 291 
 292    --  Adjust Optimize_Alignment mode from debug switches if necessary
 293 
 294    if Debug_Flag_Dot_SS then
 295       Optimize_Alignment := 'S';
 296    elsif Debug_Flag_Dot_TT then
 297       Optimize_Alignment := 'T';
 298    end if;
 299 
 300    --  We have now processed the command line switches, and the configuration
 301    --  pragma files, so this is the point at which we want to capture the
 302    --  values of the configuration switches (see Opt for further details).
 303 
 304    Opt.Register_Opt_Config_Switches;
 305 
 306    --  Check for file which contains No_Body pragma
 307 
 308    if Source_File_Is_No_Body (Source_Index (Main_Unit)) then
 309       Change_Main_Unit_To_Spec;
 310    end if;
 311 
 312    --  Initialize the scanner. Note that we do this after the call to
 313    --  Create_Standard, which uses the scanner in its processing of
 314    --  floating-point bounds.
 315 
 316    Initialize_Scanner (Main_Unit, Source_Index (Main_Unit));
 317 
 318    --  Here we call the parser to parse the compilation unit (or units in
 319    --  the check syntax mode, but in that case we won't go on to the
 320    --  semantics in any case).
 321 
 322    Discard_List (Par (Configuration_Pragmas => False));
 323    Parsing_Main_Extended_Source := False;
 324 
 325    --  The main unit is now loaded, and subunits of it can be loaded,
 326    --  without reporting spurious loading circularities.
 327 
 328    Set_Loading (Main_Unit, False);
 329 
 330    --  Now that the main unit is installed, we can complete the analysis
 331    --  of the pragmas in gnat.adc and the configuration file, that require
 332    --  a context for their semantic processing.
 333 
 334    if Config_Pragmas /= Error_List
 335      and then Operating_Mode /= Check_Syntax
 336 
 337      --  Do not attempt to process deferred configuration pragmas if the main
 338      --  unit failed to load, to avoid cascaded inconsistencies that can lead
 339      --  to a compiler crash.
 340 
 341      and then Fatal_Error (Main_Unit) /= Error_Detected
 342    then
 343       --  Pragmas that require some semantic activity, such as Interrupt_State,
 344       --  cannot be processed until the main unit is installed, because they
 345       --  require a compilation unit on which to attach with_clauses, etc. So
 346       --  analyze them now.
 347 
 348       declare
 349          Prag : Node_Id;
 350 
 351       begin
 352          Prag := First (Config_Pragmas);
 353          while Present (Prag) loop
 354 
 355             --  Guard against the case where a configuration pragma may be
 356             --  split into multiple pragmas and the original rewritten as a
 357             --  null statement.
 358 
 359             if Nkind (Prag) = N_Pragma
 360               and then Delay_Config_Pragma_Analyze (Prag)
 361             then
 362                Analyze_Pragma (Prag);
 363             end if;
 364 
 365             Next (Prag);
 366          end loop;
 367       end;
 368    end if;
 369 
 370    --  If we have restriction No_Exception_Propagation, and we did not have an
 371    --  explicit switch turning off Warn_On_Non_Local_Exception, then turn on
 372    --  this warning by default if we have encountered an exception handler.
 373 
 374    if Restriction_Check_Required (No_Exception_Propagation)
 375      and then not No_Warn_On_Non_Local_Exception
 376      and then Exception_Handler_Encountered
 377    then
 378       Warn_On_Non_Local_Exception := True;
 379    end if;
 380 
 381    --  Now on to the semantics. Skip if in syntax only mode
 382 
 383    if Operating_Mode /= Check_Syntax then
 384 
 385       --  Install the configuration pragmas in the tree
 386 
 387       Set_Config_Pragmas (Aux_Decls_Node (Cunit (Main_Unit)), Config_Pragmas);
 388 
 389       --  Following steps are skipped if we had a fatal error during parsing
 390 
 391       if Fatal_Error (Main_Unit) /= Error_Detected then
 392 
 393          --  Reset Operating_Mode to Check_Semantics for subunits. We cannot
 394          --  actually generate code for subunits, so we suppress expansion.
 395          --  This also corrects certain problems that occur if we try to
 396          --  incorporate subunits at a lower level.
 397 
 398          if Operating_Mode = Generate_Code
 399            and then Nkind (Unit (Cunit (Main_Unit))) = N_Subunit
 400          then
 401             Operating_Mode := Check_Semantics;
 402          end if;
 403 
 404          --  Analyze (and possibly expand) main unit
 405 
 406          Scope_Suppress := Suppress_Options;
 407          Semantics (Cunit (Main_Unit));
 408 
 409          --  Cleanup processing after completing main analysis
 410 
 411          --  Comment needed for ASIS mode test and GNATprove mode test???
 412 
 413          pragma Assert
 414            (Operating_Mode = Generate_Code
 415              or else Operating_Mode = Check_Semantics);
 416 
 417          if Operating_Mode = Generate_Code
 418            or else (ASIS_Mode or GNATprove_Mode)
 419          then
 420             Instantiate_Bodies;
 421          end if;
 422 
 423          if Operating_Mode = Generate_Code then
 424             if Inline_Processing_Required then
 425                Analyze_Inlined_Bodies;
 426             end if;
 427 
 428             --  Remove entities from program that do not have any execution
 429             --  time references.
 430 
 431             if Debug_Flag_UU then
 432                Collect_Garbage_Entities;
 433             end if;
 434 
 435             Check_Elab_Calls;
 436 
 437             --  Remove any ignored Ghost code as it must not appear in the
 438             --  executable.
 439 
 440             Remove_Ignored_Ghost_Code;
 441          end if;
 442 
 443          --  At this stage we can unnest subprogram bodies if required
 444 
 445          Exp_Unst.Unnest_Subprograms (Cunit (Main_Unit));
 446 
 447          --  List library units if requested
 448 
 449          if List_Units then
 450             Lib.List;
 451          end if;
 452 
 453          --  Output waiting warning messages
 454 
 455          Lib.Xref.Process_Deferred_References;
 456          Sem_Warn.Output_Non_Modified_In_Out_Warnings;
 457          Sem_Warn.Output_Unreferenced_Messages;
 458          Sem_Warn.Check_Unused_Withs;
 459          Sem_Warn.Output_Unused_Warnings_Off_Warnings;
 460       end if;
 461    end if;
 462 
 463    --  Qualify all entity names in inner packages, package bodies, etc.
 464 
 465    Exp_Dbug.Qualify_All_Entity_Names;
 466 
 467    --  SCIL backend requirement. Check that SCIL nodes associated with
 468    --  dispatching calls reference subprogram calls.
 469 
 470    if Generate_SCIL then
 471       pragma Debug (Sem_SCIL.Check_SCIL_Nodes (Cunit (Main_Unit)));
 472       null;
 473    end if;
 474 
 475    --  Dump the source now. Note that we do this as soon as the analysis
 476    --  of the tree is complete, because it is not just a dump in the case
 477    --  of -gnatD, where it rewrites all source locations in the tree.
 478 
 479    Sprint.Source_Dump;
 480 
 481    --  Check again for configuration pragmas that appear in the context
 482    --  of the main unit. These pragmas only affect the main unit, and the
 483    --  corresponding flag is reset after each call to Semantics, but they
 484    --  may affect the generated ali for the unit, and therefore the flag
 485    --  must be set properly after compilation. Currently we only check for
 486    --  Initialize_Scalars, but others should be checked: as well???
 487 
 488    declare
 489       Item  : Node_Id;
 490 
 491    begin
 492       Item := First (Context_Items (Cunit (Main_Unit)));
 493       while Present (Item) loop
 494          if Nkind (Item) = N_Pragma
 495            and then Pragma_Name (Item) = Name_Initialize_Scalars
 496          then
 497             Initialize_Scalars := True;
 498          end if;
 499 
 500          Next (Item);
 501       end loop;
 502    end;
 503 
 504    --  If a mapping file has been specified by a -gnatem switch, update
 505    --  it if there has been some sources that were not in the mappings.
 506 
 507    if Mapping_File_Name /= null then
 508       Fmap.Update_Mapping_File (Mapping_File_Name.all);
 509    end if;
 510 
 511    return;
 512 end Frontend;