File : make.adb


   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --                                 M A K E                                  --
   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 ALI;      use ALI;
  27 with ALI.Util; use ALI.Util;
  28 with Csets;
  29 with Debug;
  30 with Errutil;
  31 with Fmap;
  32 with Fname;    use Fname;
  33 with Fname.SF; use Fname.SF;
  34 with Fname.UF; use Fname.UF;
  35 with Gnatvsn;  use Gnatvsn;
  36 with Hostparm; use Hostparm;
  37 with Makeusg;
  38 with Makeutl;  use Makeutl;
  39 with MLib;
  40 with MLib.Prj;
  41 with MLib.Tgt; use MLib.Tgt;
  42 with MLib.Utl;
  43 with Namet;    use Namet;
  44 with Opt;      use Opt;
  45 with Osint.M;  use Osint.M;
  46 with Osint;    use Osint;
  47 with Output;   use Output;
  48 with Prj;      use Prj;
  49 with Prj.Com;
  50 with Prj.Env;
  51 with Prj.Pars;
  52 with Prj.Tree; use Prj.Tree;
  53 with Prj.Util;
  54 with Sdefault;
  55 with SFN_Scan;
  56 with Sinput.P;
  57 with Snames;   use Snames;
  58 with Stringt;
  59 
  60 pragma Warnings (Off);
  61 with System.HTable;
  62 pragma Warnings (On);
  63 
  64 with Switch;   use Switch;
  65 with Switch.M; use Switch.M;
  66 with Table;
  67 with Targparm; use Targparm;
  68 with Tempdir;
  69 with Types;    use Types;
  70 
  71 with Ada.Command_Line; use Ada.Command_Line;
  72 with Ada.Directories;
  73 with Ada.Exceptions;   use Ada.Exceptions;
  74 
  75 with GNAT.Case_Util;            use GNAT.Case_Util;
  76 with GNAT.Command_Line;         use GNAT.Command_Line;
  77 with GNAT.Directory_Operations; use GNAT.Directory_Operations;
  78 with GNAT.Dynamic_HTables;      use GNAT.Dynamic_HTables;
  79 with GNAT.OS_Lib;               use GNAT.OS_Lib;
  80 
  81 package body Make is
  82 
  83    use ASCII;
  84    --  Make control characters visible
  85 
  86    Standard_Library_Package_Body_Name : constant String := "s-stalib.adb";
  87    System_Package_Spec_Name : constant String := "system.ads";
  88    --  Every program depends on one of these packages: usually the first one,
  89    --  or if Supress_Standard_Library is true on the second one. The dependency
  90    --  is not always explicit and considering it is important when -f and -a
  91    --  are used.
  92 
  93    type Sigint_Handler is access procedure;
  94    pragma Convention (C, Sigint_Handler);
  95 
  96    procedure Install_Int_Handler (Handler : Sigint_Handler);
  97    pragma Import (C, Install_Int_Handler, "__gnat_install_int_handler");
  98    --  Called by Gnatmake to install the SIGINT handler below
  99 
 100    procedure Sigint_Intercepted;
 101    pragma Convention (C, Sigint_Intercepted);
 102    --  Called when the program is interrupted by Ctrl-C to delete the
 103    --  temporary mapping files and configuration pragmas files.
 104 
 105    No_Mapping_File : constant Natural := 0;
 106 
 107    type Compilation_Data is record
 108       Pid              : Process_Id;
 109       Full_Source_File : File_Name_Type;
 110       Lib_File         : File_Name_Type;
 111       Source_Unit      : Unit_Name_Type;
 112       Full_Lib_File    : File_Name_Type;
 113       Lib_File_Attr    : aliased File_Attributes;
 114       Mapping_File     : Natural := No_Mapping_File;
 115       Project          : Project_Id := No_Project;
 116    end record;
 117    --  Data recorded for each compilation process spawned
 118 
 119    No_Compilation_Data : constant Compilation_Data :=
 120      (Invalid_Pid, No_File, No_File, No_Unit_Name, No_File, Unknown_Attributes,
 121       No_Mapping_File, No_Project);
 122 
 123    type Comp_Data_Arr is array (Positive range <>) of Compilation_Data;
 124    type Comp_Data_Ptr is access Comp_Data_Arr;
 125    Running_Compile : Comp_Data_Ptr;
 126    --  Used to save information about outstanding compilations
 127 
 128    Outstanding_Compiles : Natural := 0;
 129    --  Current number of outstanding compiles
 130 
 131    -------------------------
 132    -- Note on terminology --
 133    -------------------------
 134 
 135    --  In this program, we use the phrase "termination" of a file name to refer
 136    --  to the suffix that appears after the unit name portion. Very often this
 137    --  is simply the extension, but in some cases, the sequence may be more
 138    --  complex, for example in main.1.ada, the termination in this name is
 139    --  ".1.ada" and in main_.ada the termination is "_.ada".
 140 
 141    procedure Insert_Project_Sources
 142      (The_Project  : Project_Id;
 143       All_Projects : Boolean;
 144       Into_Q       : Boolean);
 145    --  If Into_Q is True, insert all sources of the project file(s) that are
 146    --  not already marked into the Q. If Into_Q is False, call Osint.Add_File
 147    --  for the first source, then insert all other sources that are not already
 148    --  marked into the Q. If All_Projects is True, all sources of all projects
 149    --  are concerned; otherwise, only sources of The_Project are concerned,
 150    --  including, if The_Project is an extending project, sources inherited
 151    --  from projects being extended.
 152 
 153    Unique_Compile : Boolean := False;
 154    --  Set to True if -u or -U or a project file with no main is used
 155 
 156    Unique_Compile_All_Projects : Boolean := False;
 157    --  Set to True if -U is used
 158 
 159    Must_Compile : Boolean := False;
 160    --  True if gnatmake is invoked with -f -u and one or several mains on the
 161    --  command line.
 162 
 163    Project_Tree : constant Project_Tree_Ref :=
 164                     new Project_Tree_Data (Is_Root_Tree => True);
 165    --  The project tree
 166 
 167    Main_On_Command_Line : Boolean := False;
 168    --  True if gnatmake is invoked with one or several mains on the command
 169    --  line.
 170 
 171    RTS_Specified : String_Access := null;
 172    --  Used to detect multiple --RTS= switches
 173 
 174    N_M_Switch : Natural := 0;
 175    --  Used to count -mxxx switches that can affect multilib
 176 
 177    --  The 3 following packages are used to store gcc, gnatbind and gnatlink
 178    --  switches found in the project files.
 179 
 180    package Gcc_Switches is new Table.Table (
 181      Table_Component_Type => String_Access,
 182      Table_Index_Type     => Integer,
 183      Table_Low_Bound      => 1,
 184      Table_Initial        => 20,
 185      Table_Increment      => 100,
 186      Table_Name           => "Make.Gcc_Switches");
 187 
 188    package Binder_Switches is new Table.Table (
 189      Table_Component_Type => String_Access,
 190      Table_Index_Type     => Integer,
 191      Table_Low_Bound      => 1,
 192      Table_Initial        => 20,
 193      Table_Increment      => 100,
 194      Table_Name           => "Make.Binder_Switches");
 195 
 196    package Linker_Switches is new Table.Table (
 197      Table_Component_Type => String_Access,
 198      Table_Index_Type     => Integer,
 199      Table_Low_Bound      => 1,
 200      Table_Initial        => 20,
 201      Table_Increment      => 100,
 202      Table_Name           => "Make.Linker_Switches");
 203 
 204    --  The following instantiations and variables are necessary to save what
 205    --  is found on the command line, in case there is a project file specified.
 206 
 207    package Saved_Gcc_Switches is new Table.Table (
 208      Table_Component_Type => String_Access,
 209      Table_Index_Type     => Integer,
 210      Table_Low_Bound      => 1,
 211      Table_Initial        => 20,
 212      Table_Increment      => 100,
 213      Table_Name           => "Make.Saved_Gcc_Switches");
 214 
 215    package Saved_Binder_Switches is new Table.Table (
 216      Table_Component_Type => String_Access,
 217      Table_Index_Type     => Integer,
 218      Table_Low_Bound      => 1,
 219      Table_Initial        => 20,
 220      Table_Increment      => 100,
 221      Table_Name           => "Make.Saved_Binder_Switches");
 222 
 223    package Saved_Linker_Switches is new Table.Table
 224      (Table_Component_Type => String_Access,
 225       Table_Index_Type     => Integer,
 226       Table_Low_Bound      => 1,
 227       Table_Initial        => 20,
 228       Table_Increment      => 100,
 229       Table_Name           => "Make.Saved_Linker_Switches");
 230 
 231    package Switches_To_Check is new Table.Table (
 232      Table_Component_Type => String_Access,
 233      Table_Index_Type     => Integer,
 234      Table_Low_Bound      => 1,
 235      Table_Initial        => 20,
 236      Table_Increment      => 100,
 237      Table_Name           => "Make.Switches_To_Check");
 238 
 239    package Library_Paths is new Table.Table (
 240      Table_Component_Type => String_Access,
 241      Table_Index_Type     => Integer,
 242      Table_Low_Bound      => 1,
 243      Table_Initial        => 20,
 244      Table_Increment      => 100,
 245      Table_Name           => "Make.Library_Paths");
 246 
 247    package Failed_Links is new Table.Table (
 248      Table_Component_Type => File_Name_Type,
 249      Table_Index_Type     => Integer,
 250      Table_Low_Bound      => 1,
 251      Table_Initial        => 10,
 252      Table_Increment      => 100,
 253      Table_Name           => "Make.Failed_Links");
 254 
 255    package Successful_Links is new Table.Table (
 256      Table_Component_Type => File_Name_Type,
 257      Table_Index_Type     => Integer,
 258      Table_Low_Bound      => 1,
 259      Table_Initial        => 10,
 260      Table_Increment      => 100,
 261      Table_Name           => "Make.Successful_Links");
 262 
 263    package Library_Projs is new Table.Table (
 264      Table_Component_Type => Project_Id,
 265      Table_Index_Type     => Integer,
 266      Table_Low_Bound      => 1,
 267      Table_Initial        => 10,
 268      Table_Increment      => 100,
 269      Table_Name           => "Make.Library_Projs");
 270 
 271    --  Two variables to keep the last binder and linker switch index in tables
 272    --  Binder_Switches and Linker_Switches, before adding switches from the
 273    --  project file (if any) and switches from the command line (if any).
 274 
 275    Last_Binder_Switch : Integer := 0;
 276    Last_Linker_Switch : Integer := 0;
 277 
 278    Normalized_Switches : Argument_List_Access := new Argument_List (1 .. 10);
 279    Last_Norm_Switch    : Natural := 0;
 280 
 281    Saved_Maximum_Processes : Natural := 0;
 282 
 283    Gnatmake_Switch_Found : Boolean;
 284    --  Set by Scan_Make_Arg. True when the switch is a gnatmake switch.
 285    --  Tested by Add_Switches when switches in package Builder must all be
 286    --  gnatmake switches.
 287 
 288    Switch_May_Be_Passed_To_The_Compiler : Boolean;
 289    --  Set by Add_Switches and Switches_Of. True when unrecognized switches
 290    --  are passed to the Ada compiler.
 291 
 292    type Arg_List_Ref is access Argument_List;
 293    The_Saved_Gcc_Switches : Arg_List_Ref;
 294 
 295    Project_File_Name : String_Access  := null;
 296    --  The path name of the main project file, if any
 297 
 298    Project_File_Name_Present : Boolean := False;
 299    --  True when -P is used with a space between -P and the project file name
 300 
 301    Current_Verbosity : Prj.Verbosity  := Prj.Default;
 302    --  Verbosity to parse the project files
 303 
 304    Main_Project : Prj.Project_Id := No_Project;
 305    --  The project id of the main project file, if any
 306 
 307    Project_Of_Current_Object_Directory : Project_Id := No_Project;
 308    --  The object directory of the project for the last compilation. Avoid
 309    --  calling Change_Dir if the current working directory is already this
 310    --  directory.
 311 
 312    Map_File : String_Access := null;
 313    --  Value of switch --create-map-file
 314 
 315    --  Packages of project files where unknown attributes are errors
 316 
 317    Naming_String   : aliased String := "naming";
 318    Builder_String  : aliased String := "builder";
 319    Compiler_String : aliased String := "compiler";
 320    Binder_String   : aliased String := "binder";
 321    Linker_String   : aliased String := "linker";
 322 
 323    Gnatmake_Packages : aliased String_List :=
 324      (Naming_String   'Access,
 325       Builder_String  'Access,
 326       Compiler_String 'Access,
 327       Binder_String   'Access,
 328       Linker_String   'Access);
 329 
 330    Packages_To_Check_By_Gnatmake : constant String_List_Access :=
 331      Gnatmake_Packages'Access;
 332 
 333    procedure Add_Library_Search_Dir
 334      (Path            : String;
 335       On_Command_Line : Boolean);
 336    --  Call Add_Lib_Search_Dir with an absolute directory path. If Path is
 337    --  relative path, when On_Command_Line is True, it is relative to the
 338    --  current working directory. When On_Command_Line is False, it is relative
 339    --  to the project directory of the main project.
 340 
 341    procedure Add_Source_Search_Dir
 342      (Path            : String;
 343       On_Command_Line : Boolean);
 344    --  Call Add_Src_Search_Dir with an absolute directory path. If Path is a
 345    --  relative path, when On_Command_Line is True, it is relative to the
 346    --  current working directory. When On_Command_Line is False, it is relative
 347    --  to the project directory of the main project.
 348 
 349    procedure Add_Source_Dir (N : String);
 350    --  Call Add_Src_Search_Dir (output one line when in verbose mode)
 351 
 352    procedure Add_Source_Directories is
 353      new Prj.Env.For_All_Source_Dirs (Action => Add_Source_Dir);
 354 
 355    procedure Add_Object_Dir (N : String);
 356    --  Call Add_Lib_Search_Dir (output one line when in verbose mode)
 357 
 358    procedure Add_Object_Directories is
 359      new Prj.Env.For_All_Object_Dirs (Action => Add_Object_Dir);
 360 
 361    procedure Change_To_Object_Directory (Project : Project_Id);
 362    --  Change to the object directory of project Project, if this is not
 363    --  already the current working directory.
 364 
 365    type Bad_Compilation_Info is record
 366       File  : File_Name_Type;
 367       Unit  : Unit_Name_Type;
 368       Found : Boolean;
 369    end record;
 370    --  File is the name of the file for which a compilation failed. Unit is for
 371    --  gnatdist use in order to easily get the unit name of a file when its
 372    --  name is krunched or declared in gnat.adc. Found is False if the
 373    --  compilation failed because the file could not be found.
 374 
 375    package Bad_Compilation is new Table.Table (
 376      Table_Component_Type => Bad_Compilation_Info,
 377      Table_Index_Type     => Natural,
 378      Table_Low_Bound      => 1,
 379      Table_Initial        => 20,
 380      Table_Increment      => 100,
 381      Table_Name           => "Make.Bad_Compilation");
 382    --  Full name of all the source files for which compilation fails
 383 
 384    Do_Compile_Step : Boolean := True;
 385    Do_Bind_Step    : Boolean := True;
 386    Do_Link_Step    : Boolean := True;
 387    --  Flags to indicate what step should be executed. Can be set to False
 388    --  with the switches -c, -b and -l. These flags are reset to True for
 389    --  each invocation of procedure Gnatmake.
 390 
 391    Shared_String           : aliased String := "-shared";
 392    Force_Elab_Flags_String : aliased String := "-F";
 393    CodePeer_Mode_String    : aliased String := "-P";
 394 
 395    No_Shared_Switch : aliased Argument_List := (1 .. 0 => null);
 396    Shared_Switch    : aliased Argument_List := (1 => Shared_String'Access);
 397    Bind_Shared      : Argument_List_Access := No_Shared_Switch'Access;
 398    --  Switch to added in front of gnatbind switches. By default no switch is
 399    --  added. Switch "-shared" is added if there is a non-static Library
 400    --  Project File.
 401 
 402    Shared_Libgcc : aliased String := "-shared-libgcc";
 403 
 404    No_Shared_Libgcc_Switch : aliased Argument_List := (1 .. 0 => null);
 405    Shared_Libgcc_Switch    : aliased Argument_List :=
 406                                (1 => Shared_Libgcc'Access);
 407    Link_With_Shared_Libgcc : Argument_List_Access :=
 408                                No_Shared_Libgcc_Switch'Access;
 409 
 410    procedure Make_Failed (S : String);
 411    --  Delete all temp files created by Gnatmake and call Osint.Fail, with the
 412    --  parameter S (see osint.ads). This is called from the Prj hierarchy and
 413    --  the MLib hierarchy. This subprogram also prints current error messages
 414    --  (i.e. finalizes Errutil).
 415 
 416    --------------------------
 417    -- Obsolete Executables --
 418    --------------------------
 419 
 420    Executable_Obsolete : Boolean := False;
 421    --  Executable_Obsolete is initially set to False for each executable,
 422    --  and is set to True whenever one of the source of the executable is
 423    --  compiled, or has already been compiled for another executable.
 424 
 425    Max_Header : constant := 200;
 426    --  This needs a proper comment, it used to say "arbitrary" that's not an
 427    --  adequate comment ???
 428 
 429    type Header_Num is range 1 .. Max_Header;
 430    --  Header_Num for the hash table Obsoleted below
 431 
 432    function Hash (F : File_Name_Type) return Header_Num;
 433    --  Hash function for the hash table Obsoleted below
 434 
 435    package Obsoleted is new System.HTable.Simple_HTable
 436      (Header_Num => Header_Num,
 437       Element    => Boolean,
 438       No_Element => False,
 439       Key        => File_Name_Type,
 440       Hash       => Hash,
 441       Equal      => "=");
 442    --  A hash table to keep all files that have been compiled, to detect
 443    --  if an executable is up to date or not.
 444 
 445    procedure Enter_Into_Obsoleted (F : File_Name_Type);
 446    --  Enter a file name, without directory information, into the hash table
 447    --  Obsoleted.
 448 
 449    function Is_In_Obsoleted (F : File_Name_Type) return Boolean;
 450    --  Check if a file name, without directory information, has already been
 451    --  entered into the hash table Obsoleted.
 452 
 453    type Dependency is record
 454       This       : File_Name_Type;
 455       Depends_On : File_Name_Type;
 456    end record;
 457    --  Components of table Dependencies below
 458 
 459    package Dependencies is new Table.Table (
 460      Table_Component_Type => Dependency,
 461      Table_Index_Type     => Integer,
 462      Table_Low_Bound      => 1,
 463      Table_Initial        => 20,
 464      Table_Increment      => 100,
 465      Table_Name           => "Make.Dependencies");
 466    --  A table to keep dependencies, to be able to decide if an executable
 467    --  is obsolete. More explanation needed ???
 468 
 469    ----------------------------
 470    -- Arguments and Switches --
 471    ----------------------------
 472 
 473    Arguments : Argument_List_Access;
 474    --  Used to gather the arguments for invocation of the compiler
 475 
 476    Last_Argument : Natural := 0;
 477    --  Last index of arguments in Arguments above
 478 
 479    Arguments_Project : Project_Id;
 480    --  Project id, if any, of the source to be compiled
 481 
 482    Arguments_Path_Name : Path_Name_Type;
 483    --  Full path of the source to be compiled, when Arguments_Project is not
 484    --  No_Project.
 485 
 486    Dummy_Switch : constant String_Access := new String'("- ");
 487    --  Used to initialized Prev_Switch in procedure Check
 488 
 489    procedure Add_Arguments (Args : Argument_List);
 490    --  Add arguments to global variable Arguments, increasing its size
 491    --  if necessary and adjusting Last_Argument.
 492 
 493    function Configuration_Pragmas_Switch
 494      (For_Project : Project_Id) return Argument_List;
 495    --  Return an argument list of one element, if there is a configuration
 496    --  pragmas file to be specified for For_Project,
 497    --  otherwise return an empty argument list.
 498 
 499    -------------------
 500    -- Misc Routines --
 501    -------------------
 502 
 503    procedure List_Depend;
 504    --  Prints to standard output the list of object dependencies. This list
 505    --  can be used directly in a Makefile. A call to Compile_Sources must
 506    --  precede the call to List_Depend. Also because this routine uses the
 507    --  ALI files that were originally loaded and scanned by Compile_Sources,
 508    --  no additional ALI files should be scanned between the two calls (i.e.
 509    --  between the call to Compile_Sources and List_Depend.)
 510 
 511    procedure List_Bad_Compilations;
 512    --  Prints out the list of all files for which the compilation failed
 513 
 514    Usage_Needed : Boolean := True;
 515    --  Flag used to make sure Makeusg is call at most once
 516 
 517    procedure Usage;
 518    --  Call Makeusg, if Usage_Needed is True.
 519    --  Set Usage_Needed to False.
 520 
 521    procedure Debug_Msg (S : String; N : Name_Id);
 522    procedure Debug_Msg (S : String; N : File_Name_Type);
 523    procedure Debug_Msg (S : String; N : Unit_Name_Type);
 524    --  If Debug.Debug_Flag_W is set outputs string S followed by name N
 525 
 526    procedure Recursive_Compute_Depth (Project : Project_Id);
 527    --  Compute depth of Project and of the projects it depends on
 528 
 529    -----------------------
 530    -- Gnatmake Routines --
 531    -----------------------
 532 
 533    subtype Lib_Mark_Type is Byte;
 534    --  Used in Mark_Directory
 535 
 536    Ada_Lib_Dir : constant Lib_Mark_Type := 1;
 537    --  Used to mark a directory as a GNAT lib dir
 538 
 539    --  Note that the notion of GNAT lib dir is no longer used. The code related
 540    --  to it has not been removed to give an idea on how to use the directory
 541    --  prefix marking mechanism.
 542 
 543    --  An Ada library directory is a directory containing ali and object files
 544    --  but no source files for the bodies (the specs can be in the same or some
 545    --  other directory). These directories are specified in the Gnatmake
 546    --  command line with the switch "-Adir" (to specify the spec location -Idir
 547    --  cab be used). Gnatmake skips the missing sources whose ali are in Ada
 548    --  library directories. For an explanation of why Gnatmake behaves that
 549    --  way, see the spec of Make.Compile_Sources. The directory lookup penalty
 550    --  is incurred every single time this routine is called.
 551 
 552    procedure Check_Steps;
 553    --  Check what steps (Compile, Bind, Link) must be executed.
 554    --  Set the step flags accordingly.
 555 
 556    function In_Ada_Lib_Dir (File : File_Name_Type) return Boolean;
 557    --  Get directory prefix of this file and get lib mark stored in name
 558    --  table for this directory. Then check if an Ada lib mark has been set.
 559 
 560    procedure Mark_Directory
 561      (Dir             : String;
 562       Mark            : Lib_Mark_Type;
 563       On_Command_Line : Boolean);
 564    --  Store the absolute path from Dir in name table and set lib mark as name
 565    --  info to identify Ada libraries.
 566    --
 567    --  If Dir is a relative path, when On_Command_Line is True, it is relative
 568    --  to the current working directory; when On_Command_Line is False, it is
 569    --  relative to the project directory of the main project.
 570 
 571    Output_Is_Object : Boolean := True;
 572    --  Set to False when using a switch -S for the compiler
 573 
 574    procedure Check_For_S_Switch;
 575    --  Set Output_Is_Object to False when the -S switch is used for the
 576    --  compiler.
 577 
 578    function Switches_Of
 579      (Source_File      : File_Name_Type;
 580       Project          : Project_Id;
 581       In_Package       : Package_Id;
 582       Allow_ALI        : Boolean) return Variable_Value;
 583    --  Return the switches for the source file in the specified package of a
 584    --  project file. If the Source_File ends with a standard GNAT extension
 585    --  (".ads" or ".adb"), try first the full name, then the name without the
 586    --  extension, then, if Allow_ALI is True, the name with the extension
 587    --  ".ali". If there is no switches for either names, try first Switches
 588    --  (others) then the default switches for Ada. If all failed, return
 589    --  No_Variable_Value.
 590 
 591    function Is_In_Object_Directory
 592      (Source_File   : File_Name_Type;
 593       Full_Lib_File : File_Name_Type) return Boolean;
 594    --  Check if, when using a project file, the ALI file is in the project
 595    --  directory of the ultimate extending project. If it is not, we ignore
 596    --  the fact that this ALI file is read-only.
 597 
 598    procedure Process_Multilib (Env : in out Prj.Tree.Environment);
 599    --  Add appropriate --RTS argument to handle multilib
 600 
 601    procedure Resolve_Relative_Names_In_Switches (Current_Work_Dir : String);
 602    --  Resolve all relative paths found in the linker and binder switches,
 603    --  when using project files.
 604 
 605    procedure Queue_Library_Project_Sources;
 606    --  For all library project, if the library file does not exist, put all the
 607    --  project sources in the queue, and flag the project so that the library
 608    --  is generated.
 609 
 610    procedure Compute_Switches_For_Main
 611      (Main_Source_File  : in out File_Name_Type;
 612       Root_Environment  : in out Prj.Tree.Environment;
 613       Compute_Builder   : Boolean;
 614       Current_Work_Dir  : String);
 615    --  Find compiler, binder and linker switches to use for the given main
 616 
 617    procedure Compute_Executable
 618      (Main_Source_File   : File_Name_Type;
 619       Executable         : out File_Name_Type;
 620       Non_Std_Executable : out Boolean);
 621    --  Parse the linker switches and project file to compute the name of the
 622    --  executable to generate.
 623    --  ??? What is the meaning of Non_Std_Executable
 624 
 625    procedure Compilation_Phase
 626      (Main_Source_File           : File_Name_Type;
 627       Current_Main_Index         : Int := 0;
 628       Total_Compilation_Failures : in out Natural;
 629       Stand_Alone_Libraries      : in out Boolean;
 630       Executable                 : File_Name_Type := No_File;
 631       Is_Last_Main               : Boolean;
 632       Stop_Compile               : out Boolean);
 633    --  Build all source files for a given main file
 634    --
 635    --  Current_Main_Index, if not zero, is the index of the current main unit
 636    --  in its source file.
 637    --
 638    --  Stand_Alone_Libraries is set to True when there are Stand-Alone
 639    --  Libraries, so that gnatbind is invoked with the -F switch to force
 640    --  checking of elaboration flags.
 641    --
 642    --  Stop_Compile is set to true if we should not try to compile any more
 643    --  of the main units
 644 
 645    procedure Binding_Phase
 646      (Stand_Alone_Libraries : Boolean := False;
 647       Main_ALI_File : File_Name_Type);
 648    --  Stand_Alone_Libraries should be set to True when there are Stand-Alone
 649    --  Libraries, so that gnatbind is invoked with the -F switch to force
 650    --  checking of elaboration flags.
 651 
 652    procedure Library_Phase
 653       (Stand_Alone_Libraries : in out Boolean;
 654        Library_Rebuilt : in out Boolean);
 655    --  Build libraries.
 656    --  Stand_Alone_Libraries is set to True when there are Stand-Alone
 657    --  Libraries, so that gnatbind is invoked with the -F switch to force
 658    --  checking of elaboration flags.
 659 
 660    procedure Linking_Phase
 661      (Non_Std_Executable : Boolean := False;
 662       Executable         : File_Name_Type := No_File;
 663       Main_ALI_File      : File_Name_Type);
 664    --  Perform the link of a single executable. The ali file corresponds
 665    --  to Main_ALI_File. Executable is the file name of an executable.
 666    --  Non_Std_Executable is set to True when there is a possibility that
 667    --  the linker will not choose the correct executable file name.
 668 
 669    ----------------------------------------------------
 670    -- Compiler, Binder & Linker Data and Subprograms --
 671    ----------------------------------------------------
 672 
 673    Gcc      : String_Access := Program_Name ("gcc", "gnatmake");
 674    Gnatbind : String_Access := Program_Name ("gnatbind", "gnatmake");
 675    Gnatlink : String_Access := Program_Name ("gnatlink", "gnatmake");
 676    --  Default compiler, binder, linker programs
 677 
 678    Globalizer : constant String := "codepeer_globalizer";
 679    --  CodePeer globalizer executable name
 680 
 681    Saved_Gcc      : String_Access := null;
 682    Saved_Gnatbind : String_Access := null;
 683    Saved_Gnatlink : String_Access := null;
 684    --  Given by the command line. Will be used, if non null
 685 
 686    Gcc_Path      : String_Access :=
 687                      GNAT.OS_Lib.Locate_Exec_On_Path (Gcc.all);
 688    Gnatbind_Path : String_Access :=
 689                      GNAT.OS_Lib.Locate_Exec_On_Path (Gnatbind.all);
 690    Gnatlink_Path : String_Access :=
 691                      GNAT.OS_Lib.Locate_Exec_On_Path (Gnatlink.all);
 692    --  Path for compiler, binder, linker programs, defaulted now for gnatdist.
 693    --  Changed later if overridden on command line.
 694 
 695    Globalizer_Path : constant String_Access :=
 696                        GNAT.OS_Lib.Locate_Exec_On_Path (Globalizer);
 697    --  Path for CodePeer globalizer
 698 
 699    Comp_Flag         : constant String_Access := new String'("-c");
 700    Output_Flag       : constant String_Access := new String'("-o");
 701    Ada_Flag_1        : constant String_Access := new String'("-x");
 702    Ada_Flag_2        : constant String_Access := new String'("ada");
 703    AdaSCIL_Flag      : constant String_Access := new String'("adascil");
 704    No_gnat_adc       : constant String_Access := new String'("-gnatA");
 705    GNAT_Flag         : constant String_Access := new String'("-gnatpg");
 706    Do_Not_Check_Flag : constant String_Access := new String'("-x");
 707 
 708    Object_Suffix : constant String := Get_Target_Object_Suffix.all;
 709 
 710    Syntax_Only : Boolean := False;
 711    --  Set to True when compiling with -gnats
 712 
 713    Display_Executed_Programs : Boolean := True;
 714    --  Set to True if name of commands should be output on stderr (or on stdout
 715    --  if the Commands_To_Stdout flag was set by use of the -eS switch).
 716 
 717    Output_File_Name_Seen : Boolean := False;
 718    --  Set to True after having scanned the file_name for
 719    --  switch "-o file_name"
 720 
 721    Object_Directory_Seen : Boolean := False;
 722    --  Set to True after having scanned the object directory for
 723    --  switch "-D obj_dir".
 724 
 725    Object_Directory_Path : String_Access := null;
 726    --  The path name of the object directory, set with switch -D
 727 
 728    type Make_Program_Type is (None, Compiler, Binder, Linker);
 729 
 730    Program_Args : Make_Program_Type := None;
 731    --  Used to indicate if we are scanning gnatmake, gcc, gnatbind, or gnatbind
 732    --  options within the gnatmake command line. Used in Scan_Make_Arg only,
 733    --  but must be global since value preserved from one call to another.
 734 
 735    Temporary_Config_File : Boolean := False;
 736    --  Set to True when there is a temporary config file used for a project
 737    --  file, to avoid displaying the -gnatec switch for a temporary file.
 738 
 739    procedure Add_Switches
 740      (The_Package                      : Package_Id;
 741       File_Name                        : String;
 742       Program                          : Make_Program_Type;
 743       Unknown_Switches_To_The_Compiler : Boolean := True;
 744       Env                              : in out Prj.Tree.Environment);
 745    procedure Add_Switch
 746      (S             : String_Access;
 747       Program       : Make_Program_Type;
 748       Append_Switch : Boolean := True;
 749       And_Save      : Boolean := True);
 750    procedure Add_Switch
 751      (S             : String;
 752       Program       : Make_Program_Type;
 753       Append_Switch : Boolean := True;
 754       And_Save      : Boolean := True);
 755    --  Make invokes one of three programs (the compiler, the binder or the
 756    --  linker). For the sake of convenience, some program specific switches
 757    --  can be passed directly on the gnatmake command line. This procedure
 758    --  records these switches so that gnatmake can pass them to the right
 759    --  program.  S is the switch to be added at the end of the command line
 760    --  for Program if Append_Switch is True. If Append_Switch is False S is
 761    --  added at the beginning of the command line.
 762 
 763    procedure Check
 764      (Source_File    : File_Name_Type;
 765       Is_Main_Source : Boolean;
 766       The_Args       : Argument_List;
 767       Lib_File       : File_Name_Type;
 768       Full_Lib_File  : File_Name_Type;
 769       Lib_File_Attr  : access File_Attributes;
 770       Read_Only      : Boolean;
 771       ALI            : out ALI_Id;
 772       O_File         : out File_Name_Type;
 773       O_Stamp        : out Time_Stamp_Type);
 774    --  Determines whether the library file Lib_File is up-to-date or not. The
 775    --  full name (with path information) of the object file corresponding to
 776    --  Lib_File is returned in O_File. Its time stamp is saved in O_Stamp.
 777    --  ALI is the ALI_Id corresponding to Lib_File. If Lib_File in not
 778    --  up-to-date, then the corresponding source file needs to be recompiled.
 779    --  In this case ALI = No_ALI_Id.
 780    --  Full_Lib_File must be the result of calling Osint.Full_Lib_File_Name on
 781    --  Lib_File. Precomputing it saves system calls. Lib_File_Attr is the
 782    --  initialized attributes of that file, which is also used to save on
 783    --  system calls (it can safely be initialized to Unknown_Attributes).
 784 
 785    procedure Check_Linker_Options
 786      (E_Stamp : Time_Stamp_Type;
 787       O_File  : out File_Name_Type;
 788       O_Stamp : out Time_Stamp_Type);
 789    --  Checks all linker options for linker files that are newer
 790    --  than E_Stamp. If such objects are found, the youngest object
 791    --  is returned in O_File and its stamp in O_Stamp.
 792    --
 793    --  If no obsolete linker files were found, the first missing
 794    --  linker file is returned in O_File and O_Stamp is empty.
 795    --  Otherwise O_File is No_File.
 796 
 797    procedure Collect_Arguments
 798      (Source_File    : File_Name_Type;
 799       Is_Main_Source : Boolean;
 800       Args           : Argument_List);
 801    --  Collect all arguments for a source to be compiled, including those
 802    --  that come from a project file.
 803 
 804    procedure Display (Program : String; Args : Argument_List);
 805    --  Displays Program followed by the arguments in Args if variable
 806    --  Display_Executed_Programs is set. The lower bound of Args must be 1.
 807 
 808    procedure Report_Compilation_Failed;
 809    --  Delete all temporary files and fail graciously
 810 
 811    -----------------
 812    --  Mapping files
 813    -----------------
 814 
 815    type Temp_Path_Names is array (Positive range <>) of Path_Name_Type;
 816    type Temp_Path_Ptr is access Temp_Path_Names;
 817 
 818    type Free_File_Indexes is array (Positive range <>) of Positive;
 819    type Free_Indexes_Ptr is access Free_File_Indexes;
 820 
 821    type Project_Compilation_Data is record
 822       Mapping_File_Names : Temp_Path_Ptr;
 823       --  The name ids of the temporary mapping files used. This is indexed
 824       --  on the maximum number of compilation processes we will be spawning
 825       --  (-j parameter)
 826 
 827       Last_Mapping_File_Names : Natural;
 828       --  Index of the last mapping file created for this project
 829 
 830       Free_Mapping_File_Indexes : Free_Indexes_Ptr;
 831       --  Indexes in Mapping_File_Names of the mapping file names that can be
 832       --  reused for subsequent compilations.
 833 
 834       Last_Free_Indexes : Natural;
 835       --  Number of mapping files that can be reused
 836    end record;
 837    --  Information necessary when compiling a project
 838 
 839    type Project_Compilation_Access is access Project_Compilation_Data;
 840 
 841    package Project_Compilation_Htable is new Simple_HTable
 842      (Header_Num => Prj.Header_Num,
 843       Element    => Project_Compilation_Access,
 844       No_Element => null,
 845       Key        => Project_Id,
 846       Hash       => Prj.Hash,
 847       Equal      => "=");
 848 
 849    Project_Compilation : Project_Compilation_Htable.Instance;
 850 
 851    Gnatmake_Mapping_File : String_Access := null;
 852    --  The path name of a mapping file specified by switch -C=
 853 
 854    procedure Init_Mapping_File
 855      (Project    : Project_Id;
 856       Data       : in out Project_Compilation_Data;
 857       File_Index : in out Natural);
 858    --  Create a new temporary mapping file, and fill it with the project file
 859    --  mappings, when using project file(s). The out parameter File_Index is
 860    --  the index to the name of the file in the array The_Mapping_File_Names.
 861 
 862    -------------------------------------------------
 863    -- Subprogram declarations moved from the spec --
 864    -------------------------------------------------
 865 
 866    procedure Bind (ALI_File : File_Name_Type; Args : Argument_List);
 867    --  Binds ALI_File. Args are the arguments to pass to the binder.
 868    --  Args must have a lower bound of 1.
 869 
 870    procedure Display_Commands (Display : Boolean := True);
 871    --  The default behavior of Make commands (Compile_Sources, Bind, Link)
 872    --  is to display them on stderr. This behavior can be changed repeatedly
 873    --  by invoking this procedure.
 874 
 875    --  If a compilation, bind or link failed one of the following 3 exceptions
 876    --  is raised. These need to be handled by the calling routines.
 877 
 878    procedure Compile_Sources
 879      (Main_Source           : File_Name_Type;
 880       Args                  : Argument_List;
 881       First_Compiled_File   : out File_Name_Type;
 882       Most_Recent_Obj_File  : out File_Name_Type;
 883       Most_Recent_Obj_Stamp : out Time_Stamp_Type;
 884       Main_Unit             : out Boolean;
 885       Compilation_Failures  : out Natural;
 886       Main_Index            : Int      := 0;
 887       Check_Readonly_Files  : Boolean  := False;
 888       Do_Not_Execute        : Boolean  := False;
 889       Force_Compilations    : Boolean  := False;
 890       Keep_Going            : Boolean  := False;
 891       In_Place_Mode         : Boolean  := False;
 892       Initialize_ALI_Data   : Boolean  := True;
 893       Max_Process           : Positive := 1);
 894    --  Compile_Sources will recursively compile all the sources needed by
 895    --  Main_Source. Before calling this routine make sure Namet has been
 896    --  initialized. This routine can be called repeatedly with different
 897    --  Main_Source file as long as all the source (-I flags), library
 898    --  (-B flags) and ada library (-A flags) search paths between calls are
 899    --  *exactly* the same. The default directory must also be the same.
 900    --
 901    --    Args contains the arguments to use during the compilations.
 902    --    The lower bound of Args must be 1.
 903    --
 904    --    First_Compiled_File is set to the name of the first file that is
 905    --    compiled or that needs to be compiled. This is set to No_Name if no
 906    --    compilations were needed.
 907    --
 908    --    Most_Recent_Obj_File is set to the full name of the most recent
 909    --    object file found when no compilations are needed, that is when
 910    --    First_Compiled_File is set to No_Name. When First_Compiled_File
 911    --    is set then Most_Recent_Obj_File is set to No_Name.
 912    --
 913    --    Most_Recent_Obj_Stamp is the time stamp of Most_Recent_Obj_File.
 914    --
 915    --    Main_Unit is set to True if Main_Source can be a main unit.
 916    --    If Do_Not_Execute is False and First_Compiled_File /= No_Name
 917    --    the value of Main_Unit is always False.
 918    --    Is this used any more??? It is certainly not used by gnatmake???
 919    --
 920    --    Compilation_Failures is a count of compilation failures. This count
 921    --    is used to extract compilation failure reports with Extract_Failure.
 922    --
 923    --    Main_Index, when not zero, is the index of the main unit in source
 924    --    file Main_Source which is a multi-unit source.
 925    --    Zero indicates that Main_Source is a single unit source file.
 926    --
 927    --    Check_Readonly_Files set it to True to compile source files
 928    --    which library files are read-only. When compiling GNAT predefined
 929    --    files the "-gnatg" flag is used.
 930    --
 931    --    Do_Not_Execute set it to True to find out the first source that
 932    --    needs to be recompiled, but without recompiling it. This file is
 933    --    saved in First_Compiled_File.
 934    --
 935    --    Force_Compilations forces all compilations no matter what but
 936    --    recompiles read-only files only if Check_Readonly_Files
 937    --    is set.
 938    --
 939    --    Keep_Going when True keep compiling even in the presence of
 940    --    compilation errors.
 941    --
 942    --    In_Place_Mode when True save library/object files in their object
 943    --    directory if they already exist; otherwise, in the source directory.
 944    --
 945    --    Initialize_ALI_Data set it to True when you want to initialize ALI
 946    --    data-structures. This is what you should do most of the time.
 947    --    (especially the first time around when you call this routine).
 948    --    This parameter is set to False to preserve previously recorded
 949    --    ALI file data.
 950    --
 951    --    Max_Process is the maximum number of processes that should be spawned
 952    --    to carry out compilations.
 953    --
 954    --  Flags in Package Opt Affecting Compile_Sources
 955    --  -----------------------------------------------
 956    --
 957    --    Check_Object_Consistency set it to False to omit all consistency
 958    --      checks between an .ali file and its corresponding object file.
 959    --      When this flag is set to true, every time an .ali is read,
 960    --      package Osint checks that the corresponding object file
 961    --      exists and is more recent than the .ali.
 962    --
 963    --  Use of Name Table Info
 964    --  ----------------------
 965    --
 966    --  All file names manipulated by Compile_Sources are entered into the
 967    --  Names table. The Byte field of a source file is used to mark it.
 968    --
 969    --  Calling Compile_Sources Several Times
 970    --  -------------------------------------
 971    --
 972    --  Upon return from Compile_Sources all the ALI data structures are left
 973    --  intact for further browsing. HOWEVER upon entry to this routine ALI
 974    --  data structures are re-initialized if parameter Initialize_ALI_Data
 975    --  above is set to true. Typically this is what you want the first time
 976    --  you call Compile_Sources. You should not load an ali file, call this
 977    --  routine with flag Initialize_ALI_Data set to True and then expect
 978    --  that ALI information to be around after the call. Note that the first
 979    --  time you call Compile_Sources you better set Initialize_ALI_Data to
 980    --  True unless you have called Initialize_ALI yourself.
 981    --
 982    --  Compile_Sources ALGORITHM : Compile_Sources (Main_Source)
 983    --  -------------------------
 984    --
 985    --  1. Insert Main_Source in a Queue (Q) and mark it.
 986    --
 987    --  2. Let unit.adb be the file at the head of the Q. If unit.adb is
 988    --     missing but its corresponding ali file is in an Ada library directory
 989    --     (see below) then, remove unit.adb from the Q and goto step 4.
 990    --     Otherwise, look at the files under the D (dependency) section of
 991    --     unit.ali. If unit.ali does not exist or some of the time stamps do
 992    --     not match, (re)compile unit.adb.
 993    --
 994    --     An Ada library directory is a directory containing Ada specs, ali
 995    --     and object files but no source files for the bodies. An Ada library
 996    --     directory is communicated to gnatmake by means of some switch so that
 997    --     gnatmake can skip the sources whole ali are in that directory.
 998    --     There are two reasons for skipping the sources in this case. Firstly,
 999    --     Ada libraries typically come without full sources but binding and
1000    --     linking against those libraries is still possible. Secondly, it would
1001    --     be very wasteful for gnatmake to systematically check the consistency
1002    --     of every external Ada library used in a program. The binder is
1003    --     already in charge of catching any potential inconsistencies.
1004    --
1005    --  3. Look into the W section of unit.ali and insert into the Q all
1006    --     unmarked source files. Mark all files newly inserted in the Q.
1007    --     Specifically, assuming that the W section looks like
1008    --
1009    --     W types%s               types.adb               types.ali
1010    --     W unchecked_deallocation%s
1011    --     W xref_tab%s            xref_tab.adb            xref_tab.ali
1012    --
1013    --     Then xref_tab.adb and types.adb are inserted in the Q if they are not
1014    --     already marked.
1015    --     Note that there is no file listed under W unchecked_deallocation%s
1016    --     so no generic body should ever be explicitly compiled (unless the
1017    --     Main_Source at the start was a generic body).
1018    --
1019    --  4. Repeat steps 2 and 3 above until the Q is empty
1020    --
1021    --  Note that the above algorithm works because the units withed in
1022    --  subunits are transitively included in the W section (with section) of
1023    --  the main unit. Likewise the withed units in a generic body needed
1024    --  during a compilation are also transitively included in the W section
1025    --  of the originally compiled file.
1026 
1027    procedure Globalize (Success : out Boolean);
1028    --  Call the CodePeer globalizer on all the project's object directories,
1029    --  or on the current directory if no projects.
1030 
1031    procedure Initialize
1032       (Project_Node_Tree : out Project_Node_Tree_Ref;
1033        Env               : out Prj.Tree.Environment);
1034    --  Performs default and package initialization. Therefore,
1035    --  Compile_Sources can be called by an external unit.
1036 
1037    procedure Link
1038      (ALI_File : File_Name_Type;
1039       Args     : Argument_List;
1040       Success  : out Boolean);
1041    --  Links ALI_File. Args are the arguments to pass to the linker.
1042    --  Args must have a lower bound of 1. Success indicates if the link
1043    --  succeeded or not.
1044 
1045    procedure Scan_Make_Arg
1046      (Env               : in out Prj.Tree.Environment;
1047       Argv              : String;
1048       And_Save          : Boolean);
1049    --  Scan make arguments. Argv is a single argument to be processed.
1050    --  Project_Node_Tree will be used to initialize external references. It
1051    --  must have been initialized.
1052 
1053    -------------------
1054    -- Add_Arguments --
1055    -------------------
1056 
1057    procedure Add_Arguments (Args : Argument_List) is
1058    begin
1059       if Arguments = null then
1060          Arguments := new Argument_List (1 .. Args'Length + 10);
1061 
1062       else
1063          while Last_Argument + Args'Length > Arguments'Last loop
1064             declare
1065                New_Arguments : constant Argument_List_Access :=
1066                                  new Argument_List (1 .. Arguments'Last * 2);
1067             begin
1068                New_Arguments (1 .. Last_Argument) :=
1069                  Arguments (1 .. Last_Argument);
1070                Arguments := New_Arguments;
1071             end;
1072          end loop;
1073       end if;
1074 
1075       Arguments (Last_Argument + 1 .. Last_Argument + Args'Length) := Args;
1076       Last_Argument := Last_Argument + Args'Length;
1077    end Add_Arguments;
1078 
1079 --     --------------------
1080 --     -- Add_Dependency --
1081 --     --------------------
1082 --
1083 --     procedure Add_Dependency (S : File_Name_Type; On : File_Name_Type) is
1084 --     begin
1085 --        Dependencies.Increment_Last;
1086 --        Dependencies.Table (Dependencies.Last) := (S, On);
1087 --     end Add_Dependency;
1088 
1089    ----------------------------
1090    -- Add_Library_Search_Dir --
1091    ----------------------------
1092 
1093    procedure Add_Library_Search_Dir
1094      (Path            : String;
1095       On_Command_Line : Boolean)
1096    is
1097    begin
1098       if On_Command_Line then
1099          Add_Lib_Search_Dir (Normalize_Pathname (Path));
1100 
1101       else
1102          Get_Name_String (Main_Project.Directory.Display_Name);
1103          Add_Lib_Search_Dir
1104            (Normalize_Pathname (Path, Name_Buffer (1 .. Name_Len)));
1105       end if;
1106    end Add_Library_Search_Dir;
1107 
1108    --------------------
1109    -- Add_Object_Dir --
1110    --------------------
1111 
1112    procedure Add_Object_Dir (N : String) is
1113    begin
1114       Add_Lib_Search_Dir (N);
1115 
1116       if Verbose_Mode then
1117          Write_Str ("Adding object directory """);
1118          Write_Str (N);
1119          Write_Str (""".");
1120          Write_Eol;
1121       end if;
1122    end Add_Object_Dir;
1123 
1124    --------------------
1125    -- Add_Source_Dir --
1126    --------------------
1127 
1128    procedure Add_Source_Dir (N : String) is
1129    begin
1130       Add_Src_Search_Dir (N);
1131 
1132       if Verbose_Mode then
1133          Write_Str ("Adding source directory """);
1134          Write_Str (N);
1135          Write_Str (""".");
1136          Write_Eol;
1137       end if;
1138    end Add_Source_Dir;
1139 
1140    ---------------------------
1141    -- Add_Source_Search_Dir --
1142    ---------------------------
1143 
1144    procedure Add_Source_Search_Dir
1145      (Path            : String;
1146       On_Command_Line : Boolean)
1147    is
1148    begin
1149       if On_Command_Line then
1150          Add_Src_Search_Dir (Normalize_Pathname (Path));
1151 
1152       else
1153          Get_Name_String (Main_Project.Directory.Display_Name);
1154          Add_Src_Search_Dir
1155            (Normalize_Pathname (Path, Name_Buffer (1 .. Name_Len)));
1156       end if;
1157    end Add_Source_Search_Dir;
1158 
1159    ----------------
1160    -- Add_Switch --
1161    ----------------
1162 
1163    procedure Add_Switch
1164      (S             : String_Access;
1165       Program       : Make_Program_Type;
1166       Append_Switch : Boolean := True;
1167       And_Save      : Boolean := True)
1168    is
1169       generic
1170          with package T is new Table.Table (<>);
1171       procedure Generic_Position (New_Position : out Integer);
1172       --  Generic procedure that chooses a position for S in T at the
1173       --  beginning or the end, depending on the boolean Append_Switch.
1174       --  Calling this procedure may expand the table.
1175 
1176       ----------------------
1177       -- Generic_Position --
1178       ----------------------
1179 
1180       procedure Generic_Position (New_Position : out Integer) is
1181       begin
1182          T.Increment_Last;
1183 
1184          if Append_Switch then
1185             New_Position := Integer (T.Last);
1186          else
1187             for J in reverse T.Table_Index_Type'Succ (T.First) .. T.Last loop
1188                T.Table (J) := T.Table (T.Table_Index_Type'Pred (J));
1189             end loop;
1190 
1191             New_Position := Integer (T.First);
1192          end if;
1193       end Generic_Position;
1194 
1195       procedure Gcc_Switches_Pos    is new Generic_Position (Gcc_Switches);
1196       procedure Binder_Switches_Pos is new Generic_Position (Binder_Switches);
1197       procedure Linker_Switches_Pos is new Generic_Position (Linker_Switches);
1198 
1199       procedure Saved_Gcc_Switches_Pos is new
1200         Generic_Position (Saved_Gcc_Switches);
1201 
1202       procedure Saved_Binder_Switches_Pos is new
1203         Generic_Position (Saved_Binder_Switches);
1204 
1205       procedure Saved_Linker_Switches_Pos is new
1206         Generic_Position (Saved_Linker_Switches);
1207 
1208       New_Position : Integer;
1209 
1210    --  Start of processing for Add_Switch
1211 
1212    begin
1213       if And_Save then
1214          case Program is
1215             when Compiler =>
1216                Saved_Gcc_Switches_Pos (New_Position);
1217                Saved_Gcc_Switches.Table (New_Position) := S;
1218 
1219             when Binder   =>
1220                Saved_Binder_Switches_Pos (New_Position);
1221                Saved_Binder_Switches.Table (New_Position) := S;
1222 
1223             when Linker   =>
1224                Saved_Linker_Switches_Pos (New_Position);
1225                Saved_Linker_Switches.Table (New_Position) := S;
1226 
1227             when None =>
1228                raise Program_Error;
1229          end case;
1230 
1231       else
1232          case Program is
1233             when Compiler =>
1234                Gcc_Switches_Pos (New_Position);
1235                Gcc_Switches.Table (New_Position) := S;
1236 
1237             when Binder   =>
1238                Binder_Switches_Pos (New_Position);
1239                Binder_Switches.Table (New_Position) := S;
1240 
1241             when Linker   =>
1242                Linker_Switches_Pos (New_Position);
1243                Linker_Switches.Table (New_Position) := S;
1244 
1245             when None =>
1246                raise Program_Error;
1247          end case;
1248       end if;
1249    end Add_Switch;
1250 
1251    procedure Add_Switch
1252      (S             : String;
1253       Program       : Make_Program_Type;
1254       Append_Switch : Boolean := True;
1255       And_Save      : Boolean := True)
1256    is
1257    begin
1258       Add_Switch (S             => new String'(S),
1259                   Program       => Program,
1260                   Append_Switch => Append_Switch,
1261                   And_Save      => And_Save);
1262    end Add_Switch;
1263 
1264    ------------------
1265    -- Add_Switches --
1266    ------------------
1267 
1268    procedure Add_Switches
1269      (The_Package                      : Package_Id;
1270       File_Name                        : String;
1271       Program                          : Make_Program_Type;
1272       Unknown_Switches_To_The_Compiler : Boolean := True;
1273       Env                              : in out Prj.Tree.Environment)
1274    is
1275       Switches    : Variable_Value;
1276       Switch_List : String_List_Id;
1277       Element     : String_Element;
1278 
1279    begin
1280       Switch_May_Be_Passed_To_The_Compiler :=
1281         Unknown_Switches_To_The_Compiler;
1282 
1283       if File_Name'Length > 0 then
1284          Name_Len := 0;
1285          Add_Str_To_Name_Buffer (File_Name);
1286          Switches :=
1287            Switches_Of
1288              (Source_File => Name_Find,
1289               Project     => Main_Project,
1290               In_Package  => The_Package,
1291               Allow_ALI   => Program = Binder or else Program = Linker);
1292 
1293          if Switches.Kind = List then
1294             Program_Args := Program;
1295 
1296             Switch_List := Switches.Values;
1297             while Switch_List /= Nil_String loop
1298                Element :=
1299                  Project_Tree.Shared.String_Elements.Table (Switch_List);
1300                Get_Name_String (Element.Value);
1301 
1302                if Name_Len > 0 then
1303                   declare
1304                      Argv : constant String := Name_Buffer (1 .. Name_Len);
1305                      --  We need a copy, because Name_Buffer may be modified
1306 
1307                   begin
1308                      if Verbose_Mode then
1309                         Write_Str ("   Adding ");
1310                         Write_Line (Argv);
1311                      end if;
1312 
1313                      Scan_Make_Arg (Env, Argv, And_Save => False);
1314 
1315                      if not Gnatmake_Switch_Found
1316                        and then not Switch_May_Be_Passed_To_The_Compiler
1317                      then
1318                         Errutil.Error_Msg
1319                           ('"' & Argv &
1320                            """ is not a gnatmake switch. Consider moving "
1321                            & "it to Global_Compilation_Switches.",
1322                            Element.Location);
1323                         Make_Failed ("*** illegal switch """ & Argv & """");
1324                      end if;
1325                   end;
1326                end if;
1327 
1328                Switch_List := Element.Next;
1329             end loop;
1330          end if;
1331       end if;
1332    end Add_Switches;
1333 
1334    ----------
1335    -- Bind --
1336    ----------
1337 
1338    procedure Bind (ALI_File : File_Name_Type; Args : Argument_List) is
1339       Bind_Args : Argument_List (1 .. Args'Last + 2);
1340       Bind_Last : Integer;
1341       Success   : Boolean;
1342 
1343    begin
1344       pragma Assert (Args'First = 1);
1345 
1346       --  Optimize the simple case where the gnatbind command line looks like
1347       --     gnatbind -aO. -I- file.ali
1348       --  into
1349       --     gnatbind file.adb
1350 
1351       if Args'Length = 2
1352         and then Args (Args'First).all = "-aO" & Normalized_CWD
1353         and then Args (Args'Last).all = "-I-"
1354         and then ALI_File = Strip_Directory (ALI_File)
1355       then
1356          Bind_Last := Args'First - 1;
1357 
1358       else
1359          Bind_Last := Args'Last;
1360          Bind_Args (Args'Range) := Args;
1361       end if;
1362 
1363       --  It is completely pointless to re-check source file time stamps. This
1364       --  has been done already by gnatmake
1365 
1366       Bind_Last := Bind_Last + 1;
1367       Bind_Args (Bind_Last) := Do_Not_Check_Flag;
1368 
1369       Get_Name_String (ALI_File);
1370 
1371       Bind_Last := Bind_Last + 1;
1372       Bind_Args (Bind_Last) := new String'(Name_Buffer (1 .. Name_Len));
1373 
1374       GNAT.OS_Lib.Normalize_Arguments (Bind_Args (Args'First .. Bind_Last));
1375 
1376       Display (Gnatbind.all, Bind_Args (Args'First .. Bind_Last));
1377 
1378       if Gnatbind_Path = null then
1379          Make_Failed ("error, unable to locate " & Gnatbind.all);
1380       end if;
1381 
1382       GNAT.OS_Lib.Spawn
1383         (Gnatbind_Path.all, Bind_Args (Args'First .. Bind_Last), Success);
1384 
1385       if not Success then
1386          Make_Failed ("*** bind failed.");
1387       end if;
1388    end Bind;
1389 
1390    --------------------------------
1391    -- Change_To_Object_Directory --
1392    --------------------------------
1393 
1394    procedure Change_To_Object_Directory (Project : Project_Id) is
1395       Object_Directory : Path_Name_Type;
1396 
1397    begin
1398       pragma Assert (Project /= No_Project);
1399 
1400       --  Nothing to do if the current working directory is already the correct
1401       --  object directory.
1402 
1403       if Project_Of_Current_Object_Directory /= Project then
1404          Project_Of_Current_Object_Directory := Project;
1405          Object_Directory := Project.Object_Directory.Display_Name;
1406 
1407          --  Set the working directory to the object directory of the actual
1408          --  project.
1409 
1410          if Verbose_Mode then
1411             Write_Str  ("Changing to object directory of """);
1412             Write_Name (Project.Display_Name);
1413             Write_Str  (""": """);
1414             Write_Name (Object_Directory);
1415             Write_Line ("""");
1416          end if;
1417 
1418          Change_Dir (Get_Name_String (Object_Directory));
1419       end if;
1420 
1421    exception
1422       --  Fail if unable to change to the object directory
1423 
1424       when Directory_Error =>
1425          Make_Failed ("unable to change to object directory """ &
1426                       Path_Or_File_Name
1427                         (Project.Object_Directory.Display_Name) &
1428                       """ of project " &
1429                       Get_Name_String (Project.Display_Name));
1430    end Change_To_Object_Directory;
1431 
1432    -----------
1433    -- Check --
1434    -----------
1435 
1436    procedure Check
1437      (Source_File    : File_Name_Type;
1438       Is_Main_Source : Boolean;
1439       The_Args       : Argument_List;
1440       Lib_File       : File_Name_Type;
1441       Full_Lib_File  : File_Name_Type;
1442       Lib_File_Attr  : access File_Attributes;
1443       Read_Only      : Boolean;
1444       ALI            : out ALI_Id;
1445       O_File         : out File_Name_Type;
1446       O_Stamp        : out Time_Stamp_Type)
1447    is
1448       function First_New_Spec (A : ALI_Id) return File_Name_Type;
1449       --  Looks in the with table entries of A and returns the spec file name
1450       --  of the first withed unit (subprogram) for which no spec existed when
1451       --  A was generated but for which there exists one now, implying that A
1452       --  is now obsolete. If no such unit is found No_File is returned.
1453       --  Otherwise the spec file name of the unit is returned.
1454       --
1455       --  **WARNING** in the event of Uname format modifications, one *MUST*
1456       --  make sure this function is also updated.
1457       --
1458       --  Note: This function should really be in ali.adb and use Uname
1459       --  services, but this causes the whole compiler to be dragged along
1460       --  for gnatbind and gnatmake.
1461 
1462       --------------------
1463       -- First_New_Spec --
1464       --------------------
1465 
1466       function First_New_Spec (A : ALI_Id) return File_Name_Type is
1467          Spec_File_Name : File_Name_Type := No_File;
1468 
1469          function New_Spec (Uname : Unit_Name_Type) return Boolean;
1470          --  Uname is the name of the spec or body of some ada unit. This
1471          --  function returns True if the Uname is the name of a body which has
1472          --  a spec not mentioned in ALI file A. If True is returned
1473          --  Spec_File_Name above is set to the name of this spec file.
1474 
1475          --------------
1476          -- New_Spec --
1477          --------------
1478 
1479          function New_Spec (Uname : Unit_Name_Type) return Boolean is
1480             Spec_Name : Unit_Name_Type;
1481             File_Name : File_Name_Type;
1482 
1483          begin
1484             --  Test whether Uname is the name of a body unit (i.e. ends
1485             --  with %b).
1486 
1487             Get_Name_String (Uname);
1488             pragma
1489               Assert (Name_Len > 2 and then Name_Buffer (Name_Len - 1) = '%');
1490 
1491             if Name_Buffer (Name_Len) /= 'b' then
1492                return False;
1493             end if;
1494 
1495             --  Convert unit name into spec name
1496 
1497             --  ??? this code seems dubious in presence of pragma
1498             --  Source_File_Name since there is no more direct relationship
1499             --  between unit name and file name.
1500 
1501             --  ??? Further, what about alternative subunit naming
1502 
1503             Name_Buffer (Name_Len) := 's';
1504             Spec_Name := Name_Find;
1505             File_Name := Get_File_Name (Spec_Name, Subunit => False);
1506 
1507             --  Look if File_Name is mentioned in A's sdep list.
1508             --  If not look if the file exists. If it does return True.
1509 
1510             for D in
1511               ALIs.Table (A).First_Sdep .. ALIs.Table (A).Last_Sdep
1512             loop
1513                if Sdep.Table (D).Sfile = File_Name then
1514                   return False;
1515                end if;
1516             end loop;
1517 
1518             if Full_Source_Name (File_Name) /= No_File then
1519                Spec_File_Name := File_Name;
1520                return True;
1521             end if;
1522 
1523             return False;
1524          end New_Spec;
1525 
1526       --  Start of processing for First_New_Spec
1527 
1528       begin
1529          U_Chk : for U in
1530            ALIs.Table (A).First_Unit .. ALIs.Table (A).Last_Unit
1531          loop
1532             exit U_Chk when Units.Table (U).Utype = Is_Body_Only
1533                and then New_Spec (Units.Table (U).Uname);
1534 
1535             for W in Units.Table (U).First_With
1536                        ..
1537                      Units.Table (U).Last_With
1538             loop
1539                exit U_Chk when
1540                  Withs.Table (W).Afile /= No_File
1541                  and then New_Spec (Withs.Table (W).Uname);
1542             end loop;
1543          end loop U_Chk;
1544 
1545          return Spec_File_Name;
1546       end First_New_Spec;
1547 
1548       ---------------------------------
1549       -- Data declarations for Check --
1550       ---------------------------------
1551 
1552       Full_Obj_File : File_Name_Type;
1553       --  Full name of the object file corresponding to Lib_File
1554 
1555       Lib_Stamp : Time_Stamp_Type;
1556       --  Time stamp of the current ada library file
1557 
1558       Obj_Stamp : Time_Stamp_Type;
1559       --  Time stamp of the current object file
1560 
1561       Modified_Source : File_Name_Type;
1562       --  The first source in Lib_File whose current time stamp differs from
1563       --  that stored in Lib_File.
1564 
1565       New_Spec : File_Name_Type;
1566       --  If Lib_File contains in its W (with) section a body (for a
1567       --  subprogram) for which there exists a spec, and the spec did not
1568       --  appear in the Sdep section of Lib_File, New_Spec contains the file
1569       --  name of this new spec.
1570 
1571       Source_Name : File_Name_Type;
1572       Text        : Text_Buffer_Ptr;
1573 
1574       First_Arg : Arg_Id;
1575       --  Index of the first argument in Args.Table for a given unit
1576 
1577       Last_Arg  : Arg_Id;
1578       --  Index of the last argument in Args.Table for a given unit
1579 
1580       Arg : Arg_Id := Arg_Id'First;
1581       --  Current index in Args.Table for a given unit (init to stop warning)
1582 
1583       Number_Of_Switches : Natural;
1584       --  Number of switches recorded for a given unit
1585 
1586       Prev_Switch : String_Access;
1587       --  Previous switch processed
1588 
1589       Switch_Found : Boolean;
1590       --  True if a given switch has been found
1591 
1592       ALI_Project : Project_Id;
1593       --  If the ALI file is in the object directory of a project, this is
1594       --  the project id.
1595 
1596    --  Start of processing for Check
1597 
1598    begin
1599       pragma Assert (Lib_File /= No_File);
1600 
1601       --  If ALI file is read-only, temporarily set Check_Object_Consistency to
1602       --  False. We don't care if the object file is not there (presumably a
1603       --  library will be used for linking.)
1604 
1605       if Read_Only then
1606          declare
1607             Saved_Check_Object_Consistency : constant Boolean :=
1608                                                Check_Object_Consistency;
1609          begin
1610             Check_Object_Consistency := False;
1611             Text := Read_Library_Info_From_Full (Full_Lib_File, Lib_File_Attr);
1612             Check_Object_Consistency := Saved_Check_Object_Consistency;
1613          end;
1614 
1615       else
1616          Text := Read_Library_Info_From_Full (Full_Lib_File, Lib_File_Attr);
1617       end if;
1618 
1619       Full_Obj_File := Full_Object_File_Name;
1620       Lib_Stamp     := Current_Library_File_Stamp;
1621       Obj_Stamp     := Current_Object_File_Stamp;
1622 
1623       if Full_Lib_File = No_File then
1624          Verbose_Msg
1625            (Lib_File,
1626             "being checked ...",
1627             Prefix => "  ",
1628             Minimum_Verbosity => Opt.Medium);
1629       else
1630          Verbose_Msg
1631            (Full_Lib_File,
1632             "being checked ...",
1633             Prefix => "  ",
1634             Minimum_Verbosity => Opt.Medium);
1635       end if;
1636 
1637       ALI     := No_ALI_Id;
1638       O_File  := Full_Obj_File;
1639       O_Stamp := Obj_Stamp;
1640 
1641       if Text = null then
1642          if Full_Lib_File = No_File then
1643             Verbose_Msg (Lib_File, "missing.");
1644 
1645          elsif Obj_Stamp (Obj_Stamp'First) = ' ' then
1646             Verbose_Msg (Full_Obj_File, "missing.");
1647 
1648          else
1649             Verbose_Msg
1650               (Full_Lib_File, "(" & String (Lib_Stamp) & ") newer than",
1651                Full_Obj_File, "(" & String (Obj_Stamp) & ")");
1652          end if;
1653 
1654       else
1655          ALI := Scan_ALI (Lib_File, Text, Ignore_ED => False, Err => True);
1656          Free (Text);
1657 
1658          if ALI = No_ALI_Id then
1659             Verbose_Msg (Full_Lib_File, "incorrectly formatted ALI file");
1660             return;
1661 
1662          elsif ALIs.Table (ALI).Ver (1 .. ALIs.Table (ALI).Ver_Len) /=
1663                  Verbose_Library_Version
1664          then
1665             Verbose_Msg (Full_Lib_File, "compiled with old GNAT version");
1666             ALI := No_ALI_Id;
1667             return;
1668          end if;
1669 
1670          --  Don't take ALI file into account if it was generated with errors
1671 
1672          if ALIs.Table (ALI).Compile_Errors then
1673             Verbose_Msg (Full_Lib_File, "had errors, must be recompiled");
1674             ALI := No_ALI_Id;
1675             return;
1676          end if;
1677 
1678          --  Don't take ALI file into account if no object was generated
1679 
1680          if Operating_Mode /= Check_Semantics
1681            and then ALIs.Table (ALI).No_Object
1682          then
1683             Verbose_Msg (Full_Lib_File, "has no corresponding object");
1684             ALI := No_ALI_Id;
1685             return;
1686          end if;
1687 
1688          --  When compiling with -gnatc, don't take ALI file into account if
1689          --  it has not been generated for the current source, for example if
1690          --  it has been generated for the spec, but we are compiling the body.
1691 
1692          if Operating_Mode = Check_Semantics then
1693             declare
1694                File_Name : String  := Get_Name_String (Source_File);
1695                OK        : Boolean := False;
1696 
1697             begin
1698                --  In the ALI file, the source file names are in canonical case
1699 
1700                Canonical_Case_File_Name (File_Name);
1701 
1702                for U in ALIs.Table (ALI).First_Unit ..
1703                  ALIs.Table (ALI).Last_Unit
1704                loop
1705                   OK := Get_Name_String (Units.Table (U).Sfile) = File_Name;
1706                   exit when OK;
1707                end loop;
1708 
1709                if not OK then
1710                   Verbose_Msg
1711                     (Full_Lib_File, "not generated for the same source");
1712                   ALI := No_ALI_Id;
1713                   return;
1714                end if;
1715             end;
1716          end if;
1717 
1718          --  Check for matching compiler switches if needed
1719 
1720          if Check_Switches then
1721 
1722             --  First, collect all the switches
1723 
1724             Collect_Arguments (Source_File, Is_Main_Source, The_Args);
1725             Prev_Switch := Dummy_Switch;
1726             Get_Name_String (ALIs.Table (ALI).Sfile);
1727             Switches_To_Check.Set_Last (0);
1728 
1729             for J in 1 .. Last_Argument loop
1730 
1731                --  Skip -c, -I and -o switches
1732 
1733                if Arguments (J) (1) = '-'
1734                  and then Arguments (J) (2) /= 'c'
1735                  and then Arguments (J) (2) /= 'o'
1736                  and then Arguments (J) (2) /= 'I'
1737                then
1738                   Normalize_Compiler_Switches
1739                     (Arguments (J).all,
1740                      Normalized_Switches,
1741                      Last_Norm_Switch);
1742 
1743                   for K in 1 .. Last_Norm_Switch loop
1744                      Switches_To_Check.Increment_Last;
1745                      Switches_To_Check.Table (Switches_To_Check.Last) :=
1746                        Normalized_Switches (K);
1747                   end loop;
1748                end if;
1749             end loop;
1750 
1751             First_Arg := Units.Table (ALIs.Table (ALI).First_Unit).First_Arg;
1752             Last_Arg  := Units.Table (ALIs.Table (ALI).First_Unit).Last_Arg;
1753 
1754             for J in 1 .. Switches_To_Check.Last loop
1755 
1756                --  Comparing switches is delicate because gcc reorders a number
1757                --  of switches, according to lang-specs.h, but gnatmake doesn't
1758                --  have sufficient knowledge to perform the same reordering.
1759                --  Instead, we ignore orders between different "first letter"
1760                --  switches, but keep orders between same switches, e.g -O -O2
1761                --  is different than -O2 -O, but -g -O is equivalent to -O -g.
1762 
1763                if Switches_To_Check.Table (J) (2) /= Prev_Switch (2) or else
1764                    (Prev_Switch'Length >= 6 and then
1765                     Prev_Switch (2 .. 5) = "gnat" and then
1766                     Switches_To_Check.Table (J)'Length >= 6 and then
1767                     Switches_To_Check.Table (J) (2 .. 5) = "gnat" and then
1768                     Prev_Switch (6) /= Switches_To_Check.Table (J) (6))
1769                then
1770                   Prev_Switch := Switches_To_Check.Table (J);
1771                   Arg := First_Arg;
1772                end if;
1773 
1774                Switch_Found := False;
1775 
1776                for K in Arg .. Last_Arg loop
1777                   if
1778                     Switches_To_Check.Table (J).all = Args.Table (K).all
1779                   then
1780                      Arg := K + 1;
1781                      Switch_Found := True;
1782                      exit;
1783                   end if;
1784                end loop;
1785 
1786                if not Switch_Found then
1787                   if Verbose_Mode then
1788                      Verbose_Msg (ALIs.Table (ALI).Sfile,
1789                                   "switch mismatch """ &
1790                                   Switches_To_Check.Table (J).all & '"');
1791                   end if;
1792 
1793                   ALI := No_ALI_Id;
1794                   return;
1795                end if;
1796             end loop;
1797 
1798             Number_Of_Switches := Natural (Last_Arg - First_Arg + 1);
1799 
1800             --  Do not count the multilib switches reinstated by the compiler
1801             --  according to the lang-specs.h.settings.
1802 
1803             for K in First_Arg .. Last_Arg loop
1804                if Args.Table (K).all = "-mrtp" then
1805                   Number_Of_Switches := Number_Of_Switches - 1;
1806                end if;
1807             end loop;
1808 
1809             if Switches_To_Check.Last /= Number_Of_Switches then
1810                if Verbose_Mode then
1811                   Verbose_Msg (ALIs.Table (ALI).Sfile,
1812                                "different number of switches");
1813 
1814                   for K in First_Arg .. Last_Arg loop
1815                      Write_Str (Args.Table (K).all);
1816                      Write_Char (' ');
1817                   end loop;
1818 
1819                   Write_Eol;
1820 
1821                   for J in 1 .. Switches_To_Check.Last loop
1822                      Write_Str (Switches_To_Check.Table (J).all);
1823                      Write_Char (' ');
1824                   end loop;
1825 
1826                   Write_Eol;
1827                end if;
1828 
1829                ALI := No_ALI_Id;
1830                return;
1831             end if;
1832          end if;
1833 
1834          --  Get the source files and their message digests. Note that some
1835          --  sources may be missing if ALI is out-of-date.
1836 
1837          Set_Source_Table (ALI);
1838 
1839          Modified_Source := Time_Stamp_Mismatch (ALI, Read_Only);
1840 
1841          --  To avoid using too much memory when switch -m is used, free the
1842          --  memory allocated for the source file when computing the checksum.
1843 
1844          if Minimal_Recompilation then
1845             Sinput.P.Clear_Source_File_Table;
1846          end if;
1847 
1848          if Modified_Source /= No_File then
1849             ALI := No_ALI_Id;
1850 
1851             if Verbose_Mode then
1852                Source_Name := Full_Source_Name (Modified_Source);
1853 
1854                if Source_Name /= No_File then
1855                   Verbose_Msg (Source_Name, "time stamp mismatch");
1856                else
1857                   Verbose_Msg (Modified_Source, "missing");
1858                end if;
1859             end if;
1860 
1861          else
1862             New_Spec := First_New_Spec (ALI);
1863 
1864             if New_Spec /= No_File then
1865                ALI := No_ALI_Id;
1866 
1867                if Verbose_Mode then
1868                   Source_Name := Full_Source_Name (New_Spec);
1869 
1870                   if Source_Name /= No_File then
1871                      Verbose_Msg (Source_Name, "new spec");
1872                   else
1873                      Verbose_Msg (New_Spec, "old spec missing");
1874                   end if;
1875                end if;
1876 
1877             elsif not Read_Only and then Main_Project /= No_Project then
1878                declare
1879                   Uname : constant Name_Id :=
1880                             Check_Source_Info_In_ALI (ALI, Project_Tree);
1881 
1882                   Udata : Prj.Unit_Index;
1883 
1884                begin
1885                   if Uname = No_Name then
1886                      ALI := No_ALI_Id;
1887                      return;
1888                   end if;
1889 
1890                   --  Check that ALI file is in the correct object directory.
1891                   --  If it is in the object directory of a project that is
1892                   --  extended and it depends on a source that is in one of
1893                   --  its extending projects, then the ALI file is not in the
1894                   --  correct object directory.
1895 
1896                   --  First, find the project of this ALI file. As there may be
1897                   --  several projects with the same object directory, we first
1898                   --  need to find the project of the source.
1899 
1900                   ALI_Project := No_Project;
1901 
1902                   Udata := Units_Htable.Get (Project_Tree.Units_HT, Uname);
1903 
1904                   if Udata /= No_Unit_Index then
1905                      if Udata.File_Names (Impl) /= null
1906                        and then Udata.File_Names (Impl).File = Source_File
1907                      then
1908                         ALI_Project := Udata.File_Names (Impl).Project;
1909 
1910                      elsif Udata.File_Names (Spec) /= null
1911                        and then Udata.File_Names (Spec).File = Source_File
1912                      then
1913                         ALI_Project := Udata.File_Names (Spec).Project;
1914                      end if;
1915                   end if;
1916                end;
1917 
1918                if ALI_Project = No_Project then
1919                   return;
1920                end if;
1921 
1922                declare
1923                   Obj_Dir : Path_Name_Type;
1924                   Res_Obj_Dir : constant String :=
1925                                   Normalize_Pathname
1926                                     (Dir_Name
1927                                       (Get_Name_String (Full_Lib_File)),
1928                                      Resolve_Links  =>
1929                                        Opt.Follow_Links_For_Dirs,
1930                                      Case_Sensitive => False);
1931 
1932                begin
1933                   Name_Len := 0;
1934                   Add_Str_To_Name_Buffer (Res_Obj_Dir);
1935 
1936                   if not Is_Directory_Separator (Name_Buffer (Name_Len)) then
1937                      Add_Char_To_Name_Buffer (Directory_Separator);
1938                   end if;
1939 
1940                   Obj_Dir := Name_Find;
1941 
1942                   while ALI_Project /= No_Project
1943                     and then Obj_Dir /= ALI_Project.Object_Directory.Name
1944                   loop
1945                      ALI_Project := ALI_Project.Extended_By;
1946                   end loop;
1947                end;
1948 
1949                if ALI_Project = No_Project then
1950                   ALI := No_ALI_Id;
1951 
1952                   Verbose_Msg (Lib_File, " wrong object directory");
1953                   return;
1954                end if;
1955 
1956                --  If the ALI project is not extended, then it must be in
1957                --  the correct object directory.
1958 
1959                if ALI_Project.Extended_By = No_Project then
1960                   return;
1961                end if;
1962 
1963                --  Count the extending projects
1964 
1965                declare
1966                   Num_Ext : Natural;
1967                   Proj    : Project_Id;
1968 
1969                begin
1970                   Num_Ext := 0;
1971                   Proj := ALI_Project;
1972                   loop
1973                      Proj := Proj.Extended_By;
1974                      exit when Proj = No_Project;
1975                      Num_Ext := Num_Ext + 1;
1976                   end loop;
1977 
1978                   --  Make a list of the extending projects
1979 
1980                   declare
1981                      Projects : array (1 .. Num_Ext) of Project_Id;
1982                      Dep      : Sdep_Record;
1983                      OK       : Boolean := True;
1984                      UID      : Unit_Index;
1985 
1986                   begin
1987                      Proj := ALI_Project;
1988                      for J in Projects'Range loop
1989                         Proj := Proj.Extended_By;
1990                         Projects (J) := Proj;
1991                      end loop;
1992 
1993                      --  Now check if any of the dependant sources are in any
1994                      --  of these extending projects.
1995 
1996                      D_Chk :
1997                      for D in ALIs.Table (ALI).First_Sdep ..
1998                               ALIs.Table (ALI).Last_Sdep
1999                      loop
2000                         Dep := Sdep.Table (D);
2001                         UID  := Units_Htable.Get_First (Project_Tree.Units_HT);
2002                         Proj := No_Project;
2003 
2004                         Unit_Loop :
2005                         while UID /= null loop
2006                            if UID.File_Names (Impl) /= null
2007                              and then UID.File_Names (Impl).File = Dep.Sfile
2008                            then
2009                               Proj := UID.File_Names (Impl).Project;
2010 
2011                            elsif UID.File_Names (Spec) /= null
2012                              and then UID.File_Names (Spec).File = Dep.Sfile
2013                            then
2014                               Proj := UID.File_Names (Spec).Project;
2015                            end if;
2016 
2017                            --  If a source is in a project, check if it is one
2018                            --  in the list.
2019 
2020                            if Proj /= No_Project then
2021                               for J in Projects'Range loop
2022                                  if Proj = Projects (J) then
2023                                     OK := False;
2024                                     exit D_Chk;
2025                                  end if;
2026                               end loop;
2027 
2028                               exit Unit_Loop;
2029                            end if;
2030 
2031                            UID :=
2032                              Units_Htable.Get_Next (Project_Tree.Units_HT);
2033                         end loop Unit_Loop;
2034                      end loop D_Chk;
2035 
2036                      --  If one of the dependent sources is in one project of
2037                      --  the list, then we must recompile.
2038 
2039                      if not OK then
2040                         ALI := No_ALI_Id;
2041                         Verbose_Msg (Lib_File, " wrong object directory");
2042                      end if;
2043                   end;
2044                end;
2045             end if;
2046          end if;
2047       end if;
2048    end Check;
2049 
2050    ------------------------
2051    -- Check_For_S_Switch --
2052    ------------------------
2053 
2054    procedure Check_For_S_Switch is
2055    begin
2056       --  By default, we generate an object file
2057 
2058       Output_Is_Object := True;
2059 
2060       for Arg in 1 .. Last_Argument loop
2061          if Arguments (Arg).all = "-S" then
2062             Output_Is_Object := False;
2063 
2064          elsif Arguments (Arg).all = "-c" then
2065             Output_Is_Object := True;
2066          end if;
2067       end loop;
2068    end Check_For_S_Switch;
2069 
2070    --------------------------
2071    -- Check_Linker_Options --
2072    --------------------------
2073 
2074    procedure Check_Linker_Options
2075      (E_Stamp   : Time_Stamp_Type;
2076       O_File    : out File_Name_Type;
2077       O_Stamp   : out Time_Stamp_Type)
2078    is
2079       procedure Check_File (File : File_Name_Type);
2080       --  Update O_File and O_Stamp if the given file is younger than E_Stamp
2081       --  and O_Stamp, or if O_File is No_File and File does not exist.
2082 
2083       function Get_Library_File (Name : String) return File_Name_Type;
2084       --  Return the full file name including path of a library based
2085       --  on the name specified with the -l linker option, using the
2086       --  Ada object path. Return No_File if no such file can be found.
2087 
2088       type Char_Array is array (Natural) of Character;
2089       type Char_Array_Access is access constant Char_Array;
2090 
2091       Template : Char_Array_Access;
2092       pragma Import (C, Template, "__gnat_library_template");
2093 
2094       ----------------
2095       -- Check_File --
2096       ----------------
2097 
2098       procedure Check_File (File : File_Name_Type) is
2099          Stamp : Time_Stamp_Type;
2100          Name  : File_Name_Type := File;
2101 
2102       begin
2103          Get_Name_String (Name);
2104 
2105          --  Remove any trailing NUL characters
2106 
2107          while Name_Len >= Name_Buffer'First
2108            and then Name_Buffer (Name_Len) = NUL
2109          loop
2110             Name_Len := Name_Len - 1;
2111          end loop;
2112 
2113          if Name_Len = 0 then
2114             return;
2115 
2116          elsif Name_Buffer (1) = '-' then
2117 
2118             --  Do not check if File is a switch other than "-l"
2119 
2120             if Name_Buffer (2) /= 'l' then
2121                return;
2122             end if;
2123 
2124             --  The argument is a library switch, get actual name. It
2125             --  is necessary to make a copy of the relevant part of
2126             --  Name_Buffer as Get_Library_Name uses Name_Buffer as well.
2127 
2128             declare
2129                Base_Name : constant String := Name_Buffer (3 .. Name_Len);
2130 
2131             begin
2132                Name := Get_Library_File (Base_Name);
2133             end;
2134 
2135             if Name = No_File then
2136                return;
2137             end if;
2138          end if;
2139 
2140          Stamp := File_Stamp (Name);
2141 
2142          --  Find the youngest object file that is younger than the
2143          --  executable. If no such file exist, record the first object
2144          --  file that is not found.
2145 
2146          if (O_Stamp < Stamp and then E_Stamp < Stamp)
2147            or else (O_File = No_File and then Stamp (Stamp'First) = ' ')
2148          then
2149             O_Stamp := Stamp;
2150             O_File := Name;
2151 
2152             --  Strip the trailing NUL if present
2153 
2154             Get_Name_String (O_File);
2155 
2156             if Name_Buffer (Name_Len) = NUL then
2157                Name_Len := Name_Len - 1;
2158                O_File := Name_Find;
2159             end if;
2160          end if;
2161       end Check_File;
2162 
2163       ----------------------
2164       -- Get_Library_Name --
2165       ----------------------
2166 
2167       --  See comments in a-adaint.c about template syntax
2168 
2169       function Get_Library_File (Name : String) return File_Name_Type is
2170          File : File_Name_Type := No_File;
2171 
2172       begin
2173          Name_Len := 0;
2174 
2175          for Ptr in Template'Range loop
2176             case Template (Ptr) is
2177                when '*'    =>
2178                   Add_Str_To_Name_Buffer (Name);
2179 
2180                when ';'    =>
2181                   File := Full_Lib_File_Name (Name_Find);
2182                   exit when File /= No_File;
2183                   Name_Len := 0;
2184 
2185                when NUL    =>
2186                   exit;
2187 
2188                when others =>
2189                   Add_Char_To_Name_Buffer (Template (Ptr));
2190             end case;
2191          end loop;
2192 
2193          --  The for loop exited because the end of the template
2194          --  was reached. File contains the last possible file name
2195          --  for the library.
2196 
2197          if File = No_File and then Name_Len > 0 then
2198             File := Full_Lib_File_Name (Name_Find);
2199          end if;
2200 
2201          return File;
2202       end Get_Library_File;
2203 
2204    --  Start of processing for Check_Linker_Options
2205 
2206    begin
2207       O_File  := No_File;
2208       O_Stamp := (others => ' ');
2209 
2210       --  Process linker options from the ALI files
2211 
2212       for Opt in 1 .. Linker_Options.Last loop
2213          Check_File (File_Name_Type (Linker_Options.Table (Opt).Name));
2214       end loop;
2215 
2216       --  Process options given on the command line
2217 
2218       for Opt in Linker_Switches.First .. Linker_Switches.Last loop
2219 
2220          --  Check if the previous Opt has one of the two switches
2221          --  that take an extra parameter. (See GCC manual.)
2222 
2223          if Opt = Linker_Switches.First
2224            or else (Linker_Switches.Table (Opt - 1).all /= "-u"
2225                       and then
2226                     Linker_Switches.Table (Opt - 1).all /= "-Xlinker"
2227                       and then
2228                     Linker_Switches.Table (Opt - 1).all /= "-L")
2229          then
2230             Name_Len := 0;
2231             Add_Str_To_Name_Buffer (Linker_Switches.Table (Opt).all);
2232             Check_File (Name_Find);
2233          end if;
2234       end loop;
2235    end Check_Linker_Options;
2236 
2237    -----------------
2238    -- Check_Steps --
2239    -----------------
2240 
2241    procedure Check_Steps is
2242    begin
2243       --  If either -c, -b or -l has been specified, we will not necessarily
2244       --  execute all steps.
2245 
2246       if Make_Steps then
2247          Do_Compile_Step := Do_Compile_Step and Compile_Only;
2248          Do_Bind_Step    := Do_Bind_Step    and Bind_Only;
2249          Do_Link_Step    := Do_Link_Step    and Link_Only;
2250 
2251          --  If -c has been specified, but not -b, ignore any potential -l
2252 
2253          if Do_Compile_Step and then not Do_Bind_Step then
2254             Do_Link_Step := False;
2255          end if;
2256       end if;
2257    end Check_Steps;
2258 
2259    -----------------------
2260    -- Collect_Arguments --
2261    -----------------------
2262 
2263    procedure Collect_Arguments
2264      (Source_File    : File_Name_Type;
2265       Is_Main_Source : Boolean;
2266       Args           : Argument_List)
2267    is
2268       pragma Unreferenced (Is_Main_Source);
2269 
2270    begin
2271       Arguments_Project := No_Project;
2272       Last_Argument := 0;
2273       Add_Arguments (Args);
2274 
2275       if Main_Project /= No_Project then
2276          declare
2277             Source_File_Name : constant String :=
2278                                  Get_Name_String (Source_File);
2279             Compiler_Package : Prj.Package_Id;
2280             Switches         : Prj.Variable_Value;
2281 
2282          begin
2283             Prj.Env.
2284               Get_Reference
2285               (Source_File_Name => Source_File_Name,
2286                Project          => Arguments_Project,
2287                Path             => Arguments_Path_Name,
2288                In_Tree          => Project_Tree);
2289 
2290             --  If the source is not a source of a project file, add the
2291             --  recorded arguments. Check will be done later if the source
2292             --  need to be compiled that the switch -x has been used.
2293 
2294             if Arguments_Project = No_Project then
2295                Add_Arguments (The_Saved_Gcc_Switches.all);
2296 
2297             elsif not Arguments_Project.Externally_Built or else Must_Compile
2298             then
2299                --  We get the project directory for the relative path
2300                --  switches and arguments.
2301 
2302                Arguments_Project :=
2303                  Ultimate_Extending_Project_Of (Arguments_Project);
2304 
2305                --  If building a dynamic or relocatable library, compile with
2306                --  PIC option, if it exists.
2307 
2308                if Arguments_Project.Library
2309                  and then Arguments_Project.Library_Kind /= Static
2310                then
2311                   declare
2312                      PIC : constant String := MLib.Tgt.PIC_Option;
2313                   begin
2314                      if PIC /= "" then
2315                         Add_Arguments ((1 => new String'(PIC)));
2316                      end if;
2317                   end;
2318                end if;
2319 
2320                --  We now look for package Compiler and get the switches from
2321                --  this package.
2322 
2323                Compiler_Package :=
2324                  Prj.Util.Value_Of
2325                    (Name        => Name_Compiler,
2326                     In_Packages => Arguments_Project.Decl.Packages,
2327                     Shared      => Project_Tree.Shared);
2328 
2329                if Compiler_Package /= No_Package then
2330 
2331                   --  If package Gnatmake.Compiler exists, we get the specific
2332                   --  switches for the current source, or the global switches,
2333                   --  if any.
2334 
2335                   Switches :=
2336                     Switches_Of
2337                       (Source_File => Source_File,
2338                        Project     => Arguments_Project,
2339                        In_Package  => Compiler_Package,
2340                        Allow_ALI   => False);
2341 
2342                end if;
2343 
2344                case Switches.Kind is
2345 
2346                   --  We have a list of switches. We add these switches,
2347                   --  plus the saved gcc switches.
2348 
2349                   when List =>
2350                      declare
2351                         Current : String_List_Id := Switches.Values;
2352                         Element : String_Element;
2353                         Number  : Natural := 0;
2354 
2355                      begin
2356                         while Current /= Nil_String loop
2357                            Element := Project_Tree.Shared.String_Elements.
2358                                         Table (Current);
2359                            Number  := Number + 1;
2360                            Current := Element.Next;
2361                         end loop;
2362 
2363                         declare
2364                            New_Args : Argument_List (1 .. Number);
2365                            Last_New : Natural := 0;
2366                            Dir_Path : constant String := Get_Name_String
2367                              (Arguments_Project.Directory.Display_Name);
2368 
2369                         begin
2370                            Current := Switches.Values;
2371 
2372                            for Index in New_Args'Range loop
2373                               Element := Project_Tree.Shared.String_Elements.
2374                                            Table (Current);
2375                               Get_Name_String (Element.Value);
2376 
2377                               if Name_Len > 0 then
2378                                  Last_New := Last_New + 1;
2379                                  New_Args (Last_New) :=
2380                                    new String'(Name_Buffer (1 .. Name_Len));
2381                                  Ensure_Absolute_Path
2382                                    (New_Args (Last_New),
2383                                     Do_Fail              => Make_Failed'Access,
2384                                     Parent               => Dir_Path,
2385                                     Including_Non_Switch => False);
2386                               end if;
2387 
2388                               Current := Element.Next;
2389                            end loop;
2390 
2391                            Add_Arguments
2392                              (Configuration_Pragmas_Switch (Arguments_Project)
2393                               & New_Args (1 .. Last_New)
2394                               & The_Saved_Gcc_Switches.all);
2395                         end;
2396                      end;
2397 
2398                      --  We have a single switch. We add this switch,
2399                      --  plus the saved gcc switches.
2400 
2401                   when Single =>
2402                      Get_Name_String (Switches.Value);
2403 
2404                      declare
2405                         New_Args : Argument_List :=
2406                                      (1 => new String'
2407                                             (Name_Buffer (1 .. Name_Len)));
2408                         Dir_Path : constant String :=
2409                                      Get_Name_String
2410                                        (Arguments_Project.
2411                                         Directory.Display_Name);
2412 
2413                      begin
2414                         Ensure_Absolute_Path
2415                           (New_Args (1),
2416                            Do_Fail              => Make_Failed'Access,
2417                            Parent               => Dir_Path,
2418                            Including_Non_Switch => False);
2419                         Add_Arguments
2420                           (Configuration_Pragmas_Switch (Arguments_Project) &
2421                            New_Args & The_Saved_Gcc_Switches.all);
2422                      end;
2423 
2424                      --  We have no switches from Gnatmake.Compiler.
2425                      --  We add the saved gcc switches.
2426 
2427                   when Undefined =>
2428                      Add_Arguments
2429                        (Configuration_Pragmas_Switch (Arguments_Project) &
2430                         The_Saved_Gcc_Switches.all);
2431                end case;
2432             end if;
2433          end;
2434       end if;
2435 
2436       --  Set Output_Is_Object, depending if there is a -S switch.
2437       --  If the bind step is not performed, and there is a -S switch,
2438       --  then we will not check for a valid object file.
2439 
2440       Check_For_S_Switch;
2441    end Collect_Arguments;
2442 
2443    ---------------------
2444    -- Compile_Sources --
2445    ---------------------
2446 
2447    procedure Compile_Sources
2448      (Main_Source           : File_Name_Type;
2449       Args                  : Argument_List;
2450       First_Compiled_File   : out File_Name_Type;
2451       Most_Recent_Obj_File  : out File_Name_Type;
2452       Most_Recent_Obj_Stamp : out Time_Stamp_Type;
2453       Main_Unit             : out Boolean;
2454       Compilation_Failures  : out Natural;
2455       Main_Index            : Int      := 0;
2456       Check_Readonly_Files  : Boolean  := False;
2457       Do_Not_Execute        : Boolean  := False;
2458       Force_Compilations    : Boolean  := False;
2459       Keep_Going            : Boolean  := False;
2460       In_Place_Mode         : Boolean  := False;
2461       Initialize_ALI_Data   : Boolean  := True;
2462       Max_Process           : Positive := 1)
2463    is
2464       Mfile            : Natural := No_Mapping_File;
2465       Mapping_File_Arg : String_Access;
2466       --  Info on the mapping file
2467 
2468       Need_To_Check_Standard_Library : Boolean :=
2469                                          (Check_Readonly_Files or Must_Compile)
2470                                            and not Unique_Compile;
2471 
2472       procedure Add_Process
2473         (Pid           : Process_Id;
2474          Sfile         : File_Name_Type;
2475          Afile         : File_Name_Type;
2476          Uname         : Unit_Name_Type;
2477          Full_Lib_File : File_Name_Type;
2478          Lib_File_Attr : File_Attributes;
2479          Mfile         : Natural := No_Mapping_File);
2480       --  Adds process Pid to the current list of outstanding compilation
2481       --  processes and record the full name of the source file Sfile that
2482       --  we are compiling, the name of its library file Afile and the
2483       --  name of its unit Uname. If Mfile is not equal to No_Mapping_File,
2484       --  it is the index of the mapping file used during compilation in the
2485       --  array The_Mapping_File_Names.
2486 
2487       procedure Await_Compile
2488         (Data  : out Compilation_Data;
2489          OK    : out Boolean);
2490       --  Awaits that an outstanding compilation process terminates. When it
2491       --  does set Data to the information registered for the corresponding
2492       --  call to Add_Process. Note that this time stamp can be used to check
2493       --  whether the compilation did generate an object file. OK is set to
2494       --  True if the compilation succeeded. Data could be No_Compilation_Data
2495       --  if there was no compilation to wait for.
2496 
2497       function Bad_Compilation_Count return Natural;
2498       --  Returns the number of compilation failures
2499 
2500       procedure Check_Standard_Library;
2501       --  Check if s-stalib.adb needs to be compiled
2502 
2503       procedure Collect_Arguments_And_Compile
2504         (Full_Source_File : File_Name_Type;
2505          Lib_File         : File_Name_Type;
2506          Source_Index     : Int;
2507          Pid              : out Process_Id;
2508          Process_Created  : out Boolean);
2509       --  Collect arguments from project file (if any) and compile. If no
2510       --  compilation was attempted, Processed_Created is set to False, and the
2511       --  value of Pid is unknown.
2512 
2513       function Compile
2514         (Project      : Project_Id;
2515          S            : File_Name_Type;
2516          L            : File_Name_Type;
2517          Source_Index : Int;
2518          Args         : Argument_List) return Process_Id;
2519       --  Compiles S using Args. If S is a GNAT predefined source "-gnatpg" is
2520       --  added to Args. Non blocking call. L corresponds to the expected
2521       --  library file name. Process_Id of the process spawned to execute the
2522       --  compilation.
2523 
2524       type ALI_Project is record
2525          ALI      : ALI_Id;
2526          Project : Project_Id;
2527       end record;
2528 
2529       package Good_ALI is new Table.Table (
2530         Table_Component_Type => ALI_Project,
2531         Table_Index_Type     => Natural,
2532         Table_Low_Bound      => 1,
2533         Table_Initial        => 50,
2534         Table_Increment      => 100,
2535         Table_Name           => "Make.Good_ALI");
2536       --  Contains the set of valid ALI files that have not yet been scanned
2537 
2538       function Good_ALI_Present return Boolean;
2539       --  Returns True if any ALI file was recorded in the previous set
2540 
2541       procedure Get_Mapping_File (Project : Project_Id);
2542       --  Get a mapping file name. If there is one to be reused, reuse it.
2543       --  Otherwise, create a new mapping file.
2544 
2545       function Get_Next_Good_ALI return ALI_Project;
2546       --  Returns the next good ALI_Id record
2547 
2548       procedure Record_Failure
2549         (File  : File_Name_Type;
2550          Unit  : Unit_Name_Type;
2551          Found : Boolean := True);
2552       --  Records in the previous table that the compilation for File failed.
2553       --  If Found is False then the compilation of File failed because we
2554       --  could not find it. Records also Unit when possible.
2555 
2556       procedure Record_Good_ALI (A : ALI_Id; Project : Project_Id);
2557       --  Records in the previous set the Id of an ALI file
2558 
2559       function Must_Exit_Because_Of_Error return Boolean;
2560       --  Return True if there were errors and the user decided to exit in such
2561       --  a case. This waits for any outstanding compilation.
2562 
2563       function Start_Compile_If_Possible (Args : Argument_List) return Boolean;
2564       --  Check if there is more work that we can do (i.e. the Queue is non
2565       --  empty). If there is, do it only if we have not yet used up all the
2566       --  available processes.
2567       --  Returns True if we should exit the main loop
2568 
2569       procedure Wait_For_Available_Slot;
2570       --  Check if we should wait for a compilation to finish. This is the case
2571       --  if all the available processes are busy compiling sources or there is
2572       --  nothing else to do (that is the Q is empty and there are no good ALIs
2573       --  to process).
2574 
2575       procedure Fill_Queue_From_ALI_Files;
2576       --  Check if we recorded good ALI files. If yes process them now in the
2577       --  order in which they have been recorded. There are two occasions in
2578       --  which we record good ali files. The first is in phase 1 when, after
2579       --  scanning an existing ALI file we realize it is up-to-date, the second
2580       --  instance is after a successful compilation.
2581 
2582       -----------------
2583       -- Add_Process --
2584       -----------------
2585 
2586       procedure Add_Process
2587         (Pid           : Process_Id;
2588          Sfile         : File_Name_Type;
2589          Afile         : File_Name_Type;
2590          Uname         : Unit_Name_Type;
2591          Full_Lib_File : File_Name_Type;
2592          Lib_File_Attr : File_Attributes;
2593          Mfile         : Natural := No_Mapping_File)
2594       is
2595          OC1 : constant Positive := Outstanding_Compiles + 1;
2596 
2597       begin
2598          pragma Assert (OC1 <= Max_Process);
2599          pragma Assert (Pid /= Invalid_Pid);
2600 
2601          Running_Compile (OC1) :=
2602            (Pid              => Pid,
2603             Full_Source_File => Sfile,
2604             Lib_File         => Afile,
2605             Full_Lib_File    => Full_Lib_File,
2606             Lib_File_Attr    => Lib_File_Attr,
2607             Source_Unit      => Uname,
2608             Mapping_File     => Mfile,
2609             Project          => Arguments_Project);
2610 
2611          Outstanding_Compiles := OC1;
2612 
2613          if Arguments_Project /= No_Project then
2614             Queue.Set_Obj_Dir_Busy (Arguments_Project.Object_Directory.Name);
2615          end if;
2616       end Add_Process;
2617 
2618       --------------------
2619       -- Await_Compile --
2620       -------------------
2621 
2622       procedure Await_Compile
2623         (Data : out Compilation_Data;
2624          OK   : out Boolean)
2625       is
2626          Pid       : Process_Id;
2627          Project   : Project_Id;
2628          Comp_Data : Project_Compilation_Access;
2629 
2630       begin
2631          pragma Assert (Outstanding_Compiles > 0);
2632 
2633          Data := No_Compilation_Data;
2634          OK   := False;
2635 
2636          Wait_Process (Pid, OK);
2637 
2638          if Pid = Invalid_Pid then
2639             return;
2640          end if;
2641 
2642          --  Look into the running compilation processes for this PID
2643 
2644          for J in Running_Compile'First .. Outstanding_Compiles loop
2645             if Pid = Running_Compile (J).Pid then
2646                Data    := Running_Compile (J);
2647                Project := Running_Compile (J).Project;
2648 
2649                if Project /= No_Project then
2650                   Queue.Set_Obj_Dir_Free (Project.Object_Directory.Name);
2651                end if;
2652 
2653                --  If a mapping file was used by this compilation, get its file
2654                --  name for reuse by a subsequent compilation.
2655 
2656                if Running_Compile (J).Mapping_File /= No_Mapping_File then
2657                   Comp_Data :=
2658                     Project_Compilation_Htable.Get
2659                       (Project_Compilation, Project);
2660                   Comp_Data.Last_Free_Indexes :=
2661                     Comp_Data.Last_Free_Indexes + 1;
2662                   Comp_Data.Free_Mapping_File_Indexes
2663                     (Comp_Data.Last_Free_Indexes) :=
2664                     Running_Compile (J).Mapping_File;
2665                end if;
2666 
2667                --  To actually remove this Pid and related info from
2668                --  Running_Compile replace its entry with the last valid
2669                --  entry in Running_Compile.
2670 
2671                if J = Outstanding_Compiles then
2672                   null;
2673                else
2674                   Running_Compile (J) :=
2675                     Running_Compile (Outstanding_Compiles);
2676                end if;
2677 
2678                Outstanding_Compiles := Outstanding_Compiles - 1;
2679                exit;
2680             end if;
2681          end loop;
2682 
2683          --  If the PID was not found, return with OK set to False
2684 
2685          if Data = No_Compilation_Data then
2686             OK := False;
2687          end if;
2688       end Await_Compile;
2689 
2690       ---------------------------
2691       -- Bad_Compilation_Count --
2692       ---------------------------
2693 
2694       function Bad_Compilation_Count return Natural is
2695       begin
2696          return Bad_Compilation.Last - Bad_Compilation.First + 1;
2697       end Bad_Compilation_Count;
2698 
2699       ----------------------------
2700       -- Check_Standard_Library --
2701       ----------------------------
2702 
2703       procedure Check_Standard_Library is
2704       begin
2705          Need_To_Check_Standard_Library := False;
2706          Name_Len := 0;
2707 
2708          if not Targparm.Suppress_Standard_Library_On_Target then
2709             Add_Str_To_Name_Buffer (Standard_Library_Package_Body_Name);
2710          else
2711             Add_Str_To_Name_Buffer (System_Package_Spec_Name);
2712          end if;
2713 
2714          declare
2715             Add_It : Boolean := True;
2716             Sfile  : File_Name_Type;
2717 
2718          begin
2719             Sfile := Name_Enter;
2720 
2721             --  If we have a special runtime, we add the standard library only
2722             --  if we can find it.
2723 
2724             if RTS_Switch then
2725                Add_It := Full_Source_Name (Sfile) /= No_File;
2726             end if;
2727 
2728             if Add_It then
2729                if not Queue.Insert
2730                         ((Format  => Format_Gnatmake,
2731                           File    => Sfile,
2732                           Unit    => No_Unit_Name,
2733                           Project => No_Project,
2734                           Index   => 0,
2735                           Sid     => No_Source))
2736                then
2737                   if Is_In_Obsoleted (Sfile) then
2738                      Executable_Obsolete := True;
2739                   end if;
2740                end if;
2741             end if;
2742          end;
2743       end Check_Standard_Library;
2744 
2745       -----------------------------------
2746       -- Collect_Arguments_And_Compile --
2747       -----------------------------------
2748 
2749       procedure Collect_Arguments_And_Compile
2750         (Full_Source_File : File_Name_Type;
2751          Lib_File         : File_Name_Type;
2752          Source_Index     : Int;
2753          Pid              : out Process_Id;
2754          Process_Created  : out Boolean) is
2755       begin
2756          Process_Created := False;
2757 
2758          --  If we use mapping file (-P or -C switches), then get one
2759 
2760          if Create_Mapping_File then
2761             Get_Mapping_File (Arguments_Project);
2762          end if;
2763 
2764          --  If the source is part of a project file, we set the ADA_*_PATHs,
2765          --  check for an eventual library project, and use the full path.
2766 
2767          if Arguments_Project /= No_Project then
2768             if not Arguments_Project.Externally_Built
2769               or else Must_Compile
2770             then
2771                Prj.Env.Set_Ada_Paths
2772                  (Arguments_Project,
2773                   Project_Tree,
2774                   Including_Libraries => True,
2775                   Include_Path        => Use_Include_Path_File);
2776 
2777                if not Unique_Compile
2778                  and then MLib.Tgt.Support_For_Libraries /= Prj.None
2779                then
2780                   declare
2781                      Prj : constant Project_Id :=
2782                              Ultimate_Extending_Project_Of (Arguments_Project);
2783 
2784                   begin
2785                      if Prj.Library
2786                        and then (not Prj.Externally_Built or else Must_Compile)
2787                        and then not Prj.Need_To_Build_Lib
2788                      then
2789                         --  Add to the Q all sources of the project that have
2790                         --  not been marked.
2791 
2792                         Insert_Project_Sources
2793                           (The_Project  => Prj,
2794                            All_Projects => False,
2795                            Into_Q       => True);
2796 
2797                         --  Now mark the project as processed
2798 
2799                         Prj.Need_To_Build_Lib := True;
2800                      end if;
2801                   end;
2802                end if;
2803 
2804                Pid :=
2805                  Compile
2806                    (Project       => Arguments_Project,
2807                     S             => File_Name_Type (Arguments_Path_Name),
2808                     L             => Lib_File,
2809                     Source_Index  => Source_Index,
2810                     Args          => Arguments (1 .. Last_Argument));
2811                Process_Created := True;
2812             end if;
2813 
2814          else
2815             --  If this is a source outside of any project file, make sure it
2816             --  will be compiled in object directory of the main project file.
2817 
2818             Pid :=
2819               Compile
2820                 (Project        => Main_Project,
2821                  S              => Full_Source_File,
2822                  L              => Lib_File,
2823                  Source_Index   => Source_Index,
2824                  Args           => Arguments (1 .. Last_Argument));
2825             Process_Created := True;
2826          end if;
2827       end Collect_Arguments_And_Compile;
2828 
2829       -------------
2830       -- Compile --
2831       -------------
2832 
2833       function Compile
2834         (Project      : Project_Id;
2835          S            : File_Name_Type;
2836          L            : File_Name_Type;
2837          Source_Index : Int;
2838          Args         : Argument_List) return Process_Id
2839       is
2840          Comp_Args : Argument_List (Args'First .. Args'Last + 10);
2841          Comp_Next : Integer := Args'First;
2842          Comp_Last : Integer;
2843          Arg_Index : Integer;
2844 
2845          function Ada_File_Name (Name : File_Name_Type) return Boolean;
2846          --  Returns True if Name is the name of an ada source file
2847          --  (i.e. suffix is .ads or .adb)
2848 
2849          -------------------
2850          -- Ada_File_Name --
2851          -------------------
2852 
2853          function Ada_File_Name (Name : File_Name_Type) return Boolean is
2854          begin
2855             Get_Name_String (Name);
2856             return
2857               Name_Len > 4
2858                 and then Name_Buffer (Name_Len - 3 .. Name_Len - 1) = ".ad"
2859                 and then (Name_Buffer (Name_Len) = 'b'
2860                             or else
2861                           Name_Buffer (Name_Len) = 's');
2862          end Ada_File_Name;
2863 
2864       --  Start of processing for Compile
2865 
2866       begin
2867          Enter_Into_Obsoleted (S);
2868 
2869          --  By default, Syntax_Only is False
2870 
2871          Syntax_Only := False;
2872 
2873          for J in Args'Range loop
2874             if Args (J).all = "-gnats" then
2875 
2876                --  If we compile with -gnats, the bind step and the link step
2877                --  are inhibited. Also, we set Syntax_Only to True, so that
2878                --  we don't fail when we don't find the ALI file, after
2879                --  compilation.
2880 
2881                Do_Bind_Step := False;
2882                Do_Link_Step := False;
2883                Syntax_Only  := True;
2884 
2885             elsif Args (J).all = "-gnatc" then
2886 
2887                --  If we compile with -gnatc, the bind step and the link step
2888                --  are inhibited. We set Syntax_Only to False for the case when
2889                --  -gnats was previously specified.
2890 
2891                Do_Bind_Step := False;
2892                Do_Link_Step := False;
2893                Syntax_Only  := False;
2894             end if;
2895          end loop;
2896 
2897          Comp_Args (Comp_Next) := new String'("-gnatea");
2898          Comp_Next := Comp_Next + 1;
2899 
2900          Comp_Args (Comp_Next) := Comp_Flag;
2901          Comp_Next := Comp_Next + 1;
2902 
2903          --  Optimize the simple case where the gcc command line looks like
2904          --     gcc -c -I. ... -I- file.adb
2905          --  into
2906          --     gcc -c ... file.adb
2907 
2908          if Args (Args'First).all = "-I" & Normalized_CWD
2909            and then Args (Args'Last).all = "-I-"
2910            and then S = Strip_Directory (S)
2911          then
2912             Comp_Last := Comp_Next + Args'Length - 3;
2913             Arg_Index := Args'First + 1;
2914 
2915          else
2916             Comp_Last := Comp_Next + Args'Length - 1;
2917             Arg_Index := Args'First;
2918          end if;
2919 
2920          --  Make a deep copy of the arguments, because Normalize_Arguments
2921          --  may deallocate some arguments. Also strip target specific -mxxx
2922          --  switches in CodePeer mode.
2923 
2924          declare
2925             Index : Natural;
2926             Last  : constant Natural := Comp_Last;
2927 
2928          begin
2929             Index := Comp_Next;
2930             for J in Comp_Next .. Last loop
2931                declare
2932                   Str : String renames Args (Arg_Index).all;
2933                begin
2934                   if CodePeer_Mode
2935                     and then Str'Length > 2
2936                     and then Str (Str'First .. Str'First + 1) = "-m"
2937                   then
2938                      Comp_Last := Comp_Last - 1;
2939                   else
2940                      Comp_Args (Index) := new String'(Str);
2941                      Index := Index + 1;
2942                   end if;
2943                end;
2944 
2945                Arg_Index := Arg_Index + 1;
2946             end loop;
2947          end;
2948 
2949          --  Set -gnatpg for predefined files (for this purpose the renamings
2950          --  such as Text_IO do not count as predefined). Note that we strip
2951          --  the directory name from the source file name because the call to
2952          --  Fname.Is_Predefined_File_Name cannot deal with directory prefixes.
2953 
2954          declare
2955             Fname : constant File_Name_Type := Strip_Directory (S);
2956 
2957          begin
2958             if Is_Predefined_File_Name (Fname, False) then
2959                if Check_Readonly_Files or else Must_Compile then
2960                   Comp_Args (Comp_Args'First + 2 .. Comp_Last + 1) :=
2961                     Comp_Args (Comp_Args'First + 1 .. Comp_Last);
2962                   Comp_Last := Comp_Last + 1;
2963                   Comp_Args (Comp_Args'First + 1) := GNAT_Flag;
2964 
2965                else
2966                   Make_Failed
2967                     ("not allowed to compile """ &
2968                      Get_Name_String (Fname) &
2969                      """; use -a switch, or use the compiler directly with "
2970                      & "the ""-gnatg"" switch");
2971                end if;
2972             end if;
2973          end;
2974 
2975          --  Now check if the file name has one of the suffixes familiar to
2976          --  the gcc driver. If this is not the case then add the ada flag
2977          --  "-x ada".
2978          --  Append systematically "-x adascil" in CodePeer mode instead, to
2979          --  force the use of gnat1scil instead of gnat1.
2980 
2981          if CodePeer_Mode then
2982             Comp_Last := Comp_Last + 1;
2983             Comp_Args (Comp_Last) := Ada_Flag_1;
2984             Comp_Last := Comp_Last + 1;
2985             Comp_Args (Comp_Last) := AdaSCIL_Flag;
2986 
2987          elsif not Ada_File_Name (S) then
2988             Comp_Last := Comp_Last + 1;
2989             Comp_Args (Comp_Last) := Ada_Flag_1;
2990             Comp_Last := Comp_Last + 1;
2991             Comp_Args (Comp_Last) := Ada_Flag_2;
2992          end if;
2993 
2994          if Source_Index /= 0 then
2995             declare
2996                Num : constant String := Source_Index'Img;
2997             begin
2998                Comp_Last := Comp_Last + 1;
2999                Comp_Args (Comp_Last) :=
3000                  new String'("-gnateI" & Num (Num'First + 1 .. Num'Last));
3001             end;
3002          end if;
3003 
3004          if Source_Index /= 0
3005            or else L /= Strip_Directory (L)
3006            or else Object_Directory_Path /= null
3007          then
3008             --  Build -o argument
3009 
3010             Get_Name_String (L);
3011 
3012             for J in reverse 1 .. Name_Len loop
3013                if Name_Buffer (J) = '.' then
3014                   Name_Len := J + Object_Suffix'Length - 1;
3015                   Name_Buffer (J .. Name_Len) := Object_Suffix;
3016                   exit;
3017                end if;
3018             end loop;
3019 
3020             Comp_Last := Comp_Last + 1;
3021             Comp_Args (Comp_Last) := Output_Flag;
3022             Comp_Last := Comp_Last + 1;
3023 
3024             --  If an object directory was specified, prepend the object file
3025             --  name with this object directory.
3026 
3027             if Object_Directory_Path /= null then
3028                Comp_Args (Comp_Last) :=
3029                  new String'(Object_Directory_Path.all &
3030                                Name_Buffer (1 .. Name_Len));
3031 
3032             else
3033                Comp_Args (Comp_Last) :=
3034                  new String'(Name_Buffer (1 .. Name_Len));
3035             end if;
3036          end if;
3037 
3038          if Create_Mapping_File and then Mapping_File_Arg /= null then
3039             Comp_Last := Comp_Last + 1;
3040             Comp_Args (Comp_Last) := new String'(Mapping_File_Arg.all);
3041          end if;
3042 
3043          Get_Name_String (S);
3044 
3045          Comp_Last := Comp_Last + 1;
3046          Comp_Args (Comp_Last) := new String'(Name_Buffer (1 .. Name_Len));
3047 
3048          --  Change to object directory of the project file, if necessary
3049 
3050          if Project /= No_Project then
3051             Change_To_Object_Directory (Project);
3052          end if;
3053 
3054          GNAT.OS_Lib.Normalize_Arguments (Comp_Args (Args'First .. Comp_Last));
3055 
3056          Comp_Last := Comp_Last + 1;
3057          Comp_Args (Comp_Last) := new String'("-gnatez");
3058 
3059          Display (Gcc.all, Comp_Args (Args'First .. Comp_Last));
3060 
3061          if Gcc_Path = null then
3062             Make_Failed ("error, unable to locate " & Gcc.all);
3063          end if;
3064 
3065          return
3066            GNAT.OS_Lib.Non_Blocking_Spawn
3067              (Gcc_Path.all, Comp_Args (Args'First .. Comp_Last));
3068       end Compile;
3069 
3070       -------------------------------
3071       -- Fill_Queue_From_ALI_Files --
3072       -------------------------------
3073 
3074       procedure Fill_Queue_From_ALI_Files is
3075          ALI_P        : ALI_Project;
3076          ALI          : ALI_Id;
3077          Source_Index : Int;
3078          Sfile        : File_Name_Type;
3079          Sid          : Prj.Source_Id;
3080          Uname        : Unit_Name_Type;
3081          Unit_Name    : Name_Id;
3082          Uid          : Prj.Unit_Index;
3083 
3084       begin
3085          while Good_ALI_Present loop
3086             ALI_P        := Get_Next_Good_ALI;
3087             ALI          := ALI_P.ALI;
3088             Source_Index := Unit_Index_Of (ALIs.Table (ALI_P.ALI).Afile);
3089 
3090             --  If we are processing the library file corresponding to the
3091             --  main source file check if this source can be a main unit.
3092 
3093             if ALIs.Table (ALI).Sfile = Main_Source
3094               and then Source_Index = Main_Index
3095             then
3096                Main_Unit := ALIs.Table (ALI).Main_Program /= None;
3097             end if;
3098 
3099             --  The following adds the standard library (s-stalib) to the list
3100             --  of files to be handled by gnatmake: this file and any files it
3101             --  depends on are always included in every bind, even if they are
3102             --  not in the explicit dependency list. Of course, it is not added
3103             --  if Suppress_Standard_Library is True.
3104 
3105             --  However, to avoid annoying output about s-stalib.ali being read
3106             --  only, when "-v" is used, we add the standard library only when
3107             --  "-a" is used.
3108 
3109             if Need_To_Check_Standard_Library then
3110                Check_Standard_Library;
3111             end if;
3112 
3113             --  Now insert in the Q the unmarked source files (i.e. those which
3114             --  have never been inserted in the Q and hence never considered).
3115             --  Only do that if Unique_Compile is False.
3116 
3117             if not Unique_Compile then
3118                for J in
3119                  ALIs.Table (ALI).First_Unit .. ALIs.Table (ALI).Last_Unit
3120                loop
3121                   for K in
3122                     Units.Table (J).First_With .. Units.Table (J).Last_With
3123                   loop
3124                      Sfile := Withs.Table (K).Sfile;
3125                      Uname := Withs.Table (K).Uname;
3126                      Sid   := No_Source;
3127 
3128                      --  If project files are used, find the proper source to
3129                      --  compile in case Sfile is the spec but there is a body.
3130 
3131                      if Main_Project /= No_Project then
3132                         Get_Name_String (Uname);
3133                         Name_Len  := Name_Len - 2;
3134                         Unit_Name := Name_Find;
3135                         Uid :=
3136                           Units_Htable.Get (Project_Tree.Units_HT, Unit_Name);
3137 
3138                         if Uid /= Prj.No_Unit_Index then
3139                            if Uid.File_Names (Impl) /= null
3140                              and then not Uid.File_Names (Impl).Locally_Removed
3141                            then
3142                               Sfile        := Uid.File_Names (Impl).File;
3143                               Source_Index := Uid.File_Names (Impl).Index;
3144                               Sid          := Uid.File_Names (Impl);
3145 
3146                            elsif Uid.File_Names (Spec) /= null
3147                              and then not Uid.File_Names (Spec).Locally_Removed
3148                            then
3149                               Sfile        := Uid.File_Names (Spec).File;
3150                               Source_Index := Uid.File_Names (Spec).Index;
3151                               Sid          := Uid.File_Names (Spec);
3152                            end if;
3153                         end if;
3154                      end if;
3155 
3156                      Dependencies.Append ((ALIs.Table (ALI).Sfile, Sfile));
3157 
3158                      if Is_In_Obsoleted (Sfile) then
3159                         Executable_Obsolete := True;
3160                      end if;
3161 
3162                      if Sfile = No_File then
3163                         Debug_Msg ("Skipping generic:", Withs.Table (K).Uname);
3164 
3165                      else
3166                         Source_Index := Unit_Index_Of (Withs.Table (K).Afile);
3167 
3168                         if not (Check_Readonly_Files or Must_Compile)
3169                           and then Is_Internal_File_Name (Sfile, False)
3170                         then
3171                            Debug_Msg ("Skipping internal file:", Sfile);
3172 
3173                         else
3174                            Queue.Insert
3175                              ((Format  => Format_Gnatmake,
3176                                File    => Sfile,
3177                                Project => ALI_P.Project,
3178                                Unit    => Withs.Table (K).Uname,
3179                                Index   => Source_Index,
3180                                Sid     => Sid));
3181                         end if;
3182                      end if;
3183                   end loop;
3184                end loop;
3185             end if;
3186          end loop;
3187       end Fill_Queue_From_ALI_Files;
3188 
3189       ----------------------
3190       -- Get_Mapping_File --
3191       ----------------------
3192 
3193       procedure Get_Mapping_File (Project : Project_Id) is
3194          Data : Project_Compilation_Access;
3195 
3196       begin
3197          Data := Project_Compilation_Htable.Get (Project_Compilation, Project);
3198 
3199          --  If there is a mapping file ready to be reused, reuse it
3200 
3201          if Data.Last_Free_Indexes > 0 then
3202             Mfile := Data.Free_Mapping_File_Indexes (Data.Last_Free_Indexes);
3203             Data.Last_Free_Indexes := Data.Last_Free_Indexes - 1;
3204 
3205          --  Otherwise, create and initialize a new one
3206 
3207          else
3208             Init_Mapping_File
3209               (Project => Project, Data => Data.all, File_Index => Mfile);
3210          end if;
3211 
3212          --  Put the name in the mapping file argument for the invocation
3213          --  of the compiler.
3214 
3215          Free (Mapping_File_Arg);
3216          Mapping_File_Arg :=
3217            new String'("-gnatem=" &
3218                        Get_Name_String (Data.Mapping_File_Names (Mfile)));
3219       end Get_Mapping_File;
3220 
3221       -----------------------
3222       -- Get_Next_Good_ALI --
3223       -----------------------
3224 
3225       function Get_Next_Good_ALI return ALI_Project is
3226          ALIP : ALI_Project;
3227 
3228       begin
3229          pragma Assert (Good_ALI_Present);
3230          ALIP := Good_ALI.Table (Good_ALI.Last);
3231          Good_ALI.Decrement_Last;
3232          return ALIP;
3233       end Get_Next_Good_ALI;
3234 
3235       ----------------------
3236       -- Good_ALI_Present --
3237       ----------------------
3238 
3239       function Good_ALI_Present return Boolean is
3240       begin
3241          return Good_ALI.First <= Good_ALI.Last;
3242       end Good_ALI_Present;
3243 
3244       --------------------------------
3245       -- Must_Exit_Because_Of_Error --
3246       --------------------------------
3247 
3248       function Must_Exit_Because_Of_Error return Boolean is
3249          Data    : Compilation_Data;
3250          Success : Boolean;
3251 
3252       begin
3253          if Bad_Compilation_Count > 0 and then not Keep_Going then
3254             while Outstanding_Compiles > 0 loop
3255                Await_Compile (Data, Success);
3256 
3257                if not Success then
3258                   Record_Failure (Data.Full_Source_File, Data.Source_Unit);
3259                end if;
3260             end loop;
3261 
3262             return True;
3263          end if;
3264 
3265          return False;
3266       end Must_Exit_Because_Of_Error;
3267 
3268       --------------------
3269       -- Record_Failure --
3270       --------------------
3271 
3272       procedure Record_Failure
3273         (File  : File_Name_Type;
3274          Unit  : Unit_Name_Type;
3275          Found : Boolean := True)
3276       is
3277       begin
3278          Bad_Compilation.Increment_Last;
3279          Bad_Compilation.Table (Bad_Compilation.Last) := (File, Unit, Found);
3280       end Record_Failure;
3281 
3282       ---------------------
3283       -- Record_Good_ALI --
3284       ---------------------
3285 
3286       procedure Record_Good_ALI (A : ALI_Id; Project : Project_Id) is
3287       begin
3288          Good_ALI.Increment_Last;
3289          Good_ALI.Table (Good_ALI.Last) := (A, Project);
3290       end Record_Good_ALI;
3291 
3292       -------------------------------
3293       -- Start_Compile_If_Possible --
3294       -------------------------------
3295 
3296       function Start_Compile_If_Possible
3297         (Args : Argument_List) return Boolean
3298       is
3299          In_Lib_Dir      : Boolean;
3300          Need_To_Compile : Boolean;
3301          Pid             : Process_Id := Invalid_Pid;
3302          Process_Created : Boolean;
3303 
3304          Source           : Queue.Source_Info;
3305          Full_Source_File : File_Name_Type := No_File;
3306          Source_File_Attr : aliased File_Attributes;
3307          --  The full name of the source file and its attributes (size, ...)
3308 
3309          Lib_File      : File_Name_Type;
3310          Full_Lib_File : File_Name_Type := No_File;
3311          Lib_File_Attr : aliased File_Attributes;
3312          Read_Only     : Boolean := False;
3313          ALI           : ALI_Id;
3314          --  The ALI file and its attributes (size, stamp, ...)
3315 
3316          Obj_File  : File_Name_Type;
3317          Obj_Stamp : Time_Stamp_Type;
3318          --  The object file
3319 
3320          Found : Boolean;
3321 
3322       begin
3323          if not Queue.Is_Virtually_Empty and then
3324             Outstanding_Compiles < Max_Process
3325          then
3326             Queue.Extract (Found, Source);
3327 
3328             --  If it is a source in a project, first look for the ALI file
3329             --  in the object directory. When the project is extending another
3330             --  the ALI file may not be found, but the source does not
3331             --  necessarily need to be compiled, as it may already be up to
3332             --  date in the project being extended. In this case, look for an
3333             --  ALI file in all the object directories, as is done when
3334             --  gnatmake is not invoked with a project file.
3335 
3336             if Source.Sid /= No_Source then
3337                Initialize_Source_Record (Source.Sid);
3338                Full_Source_File :=
3339                  File_Name_Type (Source.Sid.Path.Display_Name);
3340                Lib_File      := Source.Sid.Dep_Name;
3341                Full_Lib_File := File_Name_Type (Source.Sid.Dep_Path);
3342                Lib_File_Attr := Unknown_Attributes;
3343 
3344                if Full_Lib_File /= No_File then
3345                   declare
3346                      FLF : constant String :=
3347                        Get_Name_String (Full_Lib_File) & ASCII.NUL;
3348                   begin
3349                      if not Is_Regular_File
3350                        (FLF'Address, Lib_File_Attr'Access)
3351                      then
3352                         Full_Lib_File := No_File;
3353                      end if;
3354                   end;
3355                end if;
3356             end if;
3357 
3358             if Full_Lib_File = No_File then
3359                Osint.Full_Source_Name
3360                  (Source.File,
3361                   Full_File => Full_Source_File,
3362                   Attr      => Source_File_Attr'Access);
3363 
3364                Lib_File := Osint.Lib_File_Name (Source.File, Source.Index);
3365 
3366                Osint.Full_Lib_File_Name
3367                  (Lib_File,
3368                   Lib_File => Full_Lib_File,
3369                   Attr     => Lib_File_Attr);
3370             end if;
3371 
3372             --  If source has already been compiled, executable is obsolete
3373 
3374             if Is_In_Obsoleted (Source.File) then
3375                Executable_Obsolete := True;
3376             end if;
3377 
3378             In_Lib_Dir := Full_Lib_File /= No_File
3379                           and then In_Ada_Lib_Dir (Full_Lib_File);
3380 
3381             --  Since the following requires a system call, we precompute it
3382             --  when needed.
3383 
3384             if not In_Lib_Dir then
3385                if Full_Lib_File /= No_File
3386                  and then not (Check_Readonly_Files or else Must_Compile)
3387                then
3388                   Get_Name_String (Full_Lib_File);
3389                   Name_Buffer (Name_Len + 1) := ASCII.NUL;
3390                   Read_Only := not Is_Writable_File
3391                     (Name_Buffer'Address, Lib_File_Attr'Access);
3392                else
3393                   Read_Only := False;
3394                end if;
3395             end if;
3396 
3397             --  If the library file is an Ada library skip it
3398 
3399             if In_Lib_Dir then
3400                Verbose_Msg
3401                  (Lib_File,
3402                   "is in an Ada library",
3403                   Prefix => "  ",
3404                   Minimum_Verbosity => Opt.High);
3405 
3406                --  If the library file is a read-only library skip it, but only
3407                --  if, when using project files, this library file is in the
3408                --  right object directory (a read-only ALI file in the object
3409                --  directory of a project being extended must not be skipped).
3410 
3411             elsif Read_Only
3412               and then Is_In_Object_Directory (Source.File, Full_Lib_File)
3413             then
3414                Verbose_Msg
3415                  (Lib_File,
3416                   "is a read-only library",
3417                   Prefix => "  ",
3418                   Minimum_Verbosity => Opt.High);
3419 
3420                --  The source file that we are checking cannot be located
3421 
3422             elsif Full_Source_File = No_File then
3423                Record_Failure (Source.File, Source.Unit, False);
3424 
3425                --  Source and library files can be located but are internal
3426                --  files.
3427 
3428             elsif not (Check_Readonly_Files or else Must_Compile)
3429               and then Full_Lib_File /= No_File
3430               and then Is_Internal_File_Name (Source.File, False)
3431             then
3432                if Force_Compilations then
3433                   Fail
3434                     ("not allowed to compile """ &
3435                      Get_Name_String (Source.File) &
3436                      """; use -a switch, or use the compiler directly with "
3437                      & "the ""-gnatg"" switch");
3438                end if;
3439 
3440                Verbose_Msg
3441                  (Lib_File,
3442                   "is an internal library",
3443                   Prefix => "  ",
3444                   Minimum_Verbosity => Opt.High);
3445 
3446                --  The source file that we are checking can be located
3447 
3448             else
3449                Collect_Arguments
3450                   (Source.File, Source.File = Main_Source, Args);
3451 
3452                --  Do nothing if project of source is externally built
3453 
3454                if Arguments_Project = No_Project
3455                  or else not Arguments_Project.Externally_Built
3456                  or else Must_Compile
3457                then
3458                   --  Don't waste any time if we have to recompile anyway
3459 
3460                   Obj_Stamp       := Empty_Time_Stamp;
3461                   Need_To_Compile := Force_Compilations;
3462 
3463                   if not Force_Compilations then
3464                      Check (Source_File    => Source.File,
3465                             Is_Main_Source => Source.File = Main_Source,
3466                             The_Args       => Args,
3467                             Lib_File       => Lib_File,
3468                             Full_Lib_File  => Full_Lib_File,
3469                             Lib_File_Attr  => Lib_File_Attr'Access,
3470                             Read_Only      => Read_Only,
3471                             ALI            => ALI,
3472                             O_File         => Obj_File,
3473                             O_Stamp        => Obj_Stamp);
3474                      Need_To_Compile := (ALI = No_ALI_Id);
3475                   end if;
3476 
3477                   if not Need_To_Compile then
3478 
3479                      --  The ALI file is up-to-date; record its Id
3480 
3481                      Record_Good_ALI (ALI, Arguments_Project);
3482 
3483                      --  Record the time stamp of the most recent object
3484                      --  file as long as no (re)compilations are needed.
3485 
3486                      if First_Compiled_File = No_File
3487                        and then (Most_Recent_Obj_File = No_File
3488                                   or else Obj_Stamp > Most_Recent_Obj_Stamp)
3489                      then
3490                         Most_Recent_Obj_File  := Obj_File;
3491                         Most_Recent_Obj_Stamp := Obj_Stamp;
3492                      end if;
3493 
3494                   else
3495                      --  Check that switch -x has been used if a source outside
3496                      --  of project files need to be compiled.
3497 
3498                      if Main_Project /= No_Project
3499                        and then Arguments_Project = No_Project
3500                        and then not External_Unit_Compilation_Allowed
3501                      then
3502                         Make_Failed ("external source ("
3503                                      & Get_Name_String (Source.File)
3504                                      & ") is not part of any project;"
3505                                      & " cannot be compiled without"
3506                                      & " gnatmake switch -x");
3507                      end if;
3508 
3509                      --  Is this the first file we have to compile?
3510 
3511                      if First_Compiled_File = No_File then
3512                         First_Compiled_File  := Full_Source_File;
3513                         Most_Recent_Obj_File := No_File;
3514 
3515                         if Do_Not_Execute then
3516 
3517                            --  Exit the main loop
3518 
3519                            return True;
3520                         end if;
3521                      end if;
3522 
3523                      --  Compute where the ALI file must be generated in
3524                      --  In_Place_Mode (this does not require to know the
3525                      --  location of the object directory).
3526 
3527                      if In_Place_Mode then
3528                         if Full_Lib_File = No_File then
3529 
3530                            --  If the library file was not found, then save
3531                            --  the library file near the source file.
3532 
3533                            Lib_File :=
3534                              Osint.Lib_File_Name
3535                                (Full_Source_File, Source.Index);
3536                            Full_Lib_File := Lib_File;
3537 
3538                         else
3539                            --  If the library file was found, then save the
3540                            --  library file in the same place.
3541 
3542                            Lib_File := Full_Lib_File;
3543                         end if;
3544                      end if;
3545 
3546                      --  Start the compilation and record it. We can do this
3547                      --  because there is at least one free process. This might
3548                      --  change the current directory.
3549 
3550                      Collect_Arguments_And_Compile
3551                        (Full_Source_File => Full_Source_File,
3552                         Lib_File         => Lib_File,
3553                         Source_Index     => Source.Index,
3554                         Pid              => Pid,
3555                         Process_Created  => Process_Created);
3556 
3557                      --  Compute where the ALI file will be generated (for
3558                      --  cases that might require to know the current
3559                      --  directory). The current directory might be changed
3560                      --  when compiling other files so we cannot rely on it
3561                      --  being the same to find the resulting ALI file.
3562 
3563                      if not In_Place_Mode then
3564 
3565                         --  Compute the expected location of the ALI file. This
3566                         --  can be from several places:
3567                         --    -i => in place mode. In such a case,
3568                         --          Full_Lib_File has already been set above
3569                         --    -D => if specified
3570                         --    or defaults in current dir
3571                         --  We could simply use a call similar to
3572                         --     Osint.Full_Lib_File_Name (Lib_File)
3573                         --  but that involves system calls and is thus slower
3574 
3575                         if Object_Directory_Path /= null then
3576                            Name_Len := 0;
3577                            Add_Str_To_Name_Buffer (Object_Directory_Path.all);
3578                            Add_Str_To_Name_Buffer (Get_Name_String (Lib_File));
3579                            Full_Lib_File := Name_Find;
3580 
3581                         else
3582                            if Project_Of_Current_Object_Directory /=
3583                              No_Project
3584                            then
3585                               Get_Name_String
3586                                 (Project_Of_Current_Object_Directory
3587                                  .Object_Directory.Display_Name);
3588                               Add_Str_To_Name_Buffer
3589                                 (Get_Name_String (Lib_File));
3590                               Full_Lib_File := Name_Find;
3591 
3592                            else
3593                               Full_Lib_File := Lib_File;
3594                            end if;
3595                         end if;
3596 
3597                      end if;
3598 
3599                      Lib_File_Attr := Unknown_Attributes;
3600 
3601                      --  Make sure we could successfully start the compilation
3602 
3603                      if Process_Created then
3604                         if Pid = Invalid_Pid then
3605                            Record_Failure (Full_Source_File, Source.Unit);
3606                         else
3607                            Add_Process
3608                              (Pid           => Pid,
3609                               Sfile         => Full_Source_File,
3610                               Afile         => Lib_File,
3611                               Uname         => Source.Unit,
3612                               Mfile         => Mfile,
3613                               Full_Lib_File => Full_Lib_File,
3614                               Lib_File_Attr => Lib_File_Attr);
3615                         end if;
3616                      end if;
3617                   end if;
3618                end if;
3619             end if;
3620          end if;
3621          return False;
3622       end Start_Compile_If_Possible;
3623 
3624       -----------------------------
3625       -- Wait_For_Available_Slot --
3626       -----------------------------
3627 
3628       procedure Wait_For_Available_Slot is
3629          Compilation_OK : Boolean;
3630          Text           : Text_Buffer_Ptr;
3631          ALI            : ALI_Id;
3632          Data           : Compilation_Data;
3633 
3634       begin
3635          if Outstanding_Compiles = Max_Process
3636            or else (Queue.Is_Virtually_Empty
3637                      and then not Good_ALI_Present
3638                      and then Outstanding_Compiles > 0)
3639          then
3640             Await_Compile (Data, Compilation_OK);
3641 
3642             if not Compilation_OK then
3643                Record_Failure (Data.Full_Source_File, Data.Source_Unit);
3644             end if;
3645 
3646             if Compilation_OK or else Keep_Going then
3647 
3648                --  Re-read the updated library file
3649 
3650                declare
3651                   Saved_Object_Consistency : constant Boolean :=
3652                                                Check_Object_Consistency;
3653 
3654                begin
3655                   --  If compilation was not OK, or if output is not an object
3656                   --  file and we don't do the bind step, don't check for
3657                   --  object consistency.
3658 
3659                   Check_Object_Consistency :=
3660                     Check_Object_Consistency
3661                       and Compilation_OK
3662                       and (Output_Is_Object or Do_Bind_Step);
3663 
3664                   Text :=
3665                     Read_Library_Info_From_Full
3666                       (Data.Full_Lib_File, Data.Lib_File_Attr'Access);
3667 
3668                   --  Restore Check_Object_Consistency to its initial value
3669 
3670                   Check_Object_Consistency := Saved_Object_Consistency;
3671                end;
3672 
3673                --  If an ALI file was generated by this compilation, scan the
3674                --  ALI file and record it.
3675 
3676                --  If the scan fails, a previous ali file is inconsistent with
3677                --  the unit just compiled.
3678 
3679                if Text /= null then
3680                   ALI :=
3681                     Scan_ALI
3682                       (Data.Lib_File, Text, Ignore_ED => False, Err => True);
3683 
3684                   if ALI = No_ALI_Id then
3685 
3686                      --  Record a failure only if not already done
3687 
3688                      if Compilation_OK then
3689                         Inform
3690                           (Data.Lib_File,
3691                            "incompatible ALI file, please recompile");
3692                         Record_Failure
3693                           (Data.Full_Source_File, Data.Source_Unit);
3694                      end if;
3695 
3696                   else
3697                      Record_Good_ALI (ALI, Data.Project);
3698                   end if;
3699 
3700                   Free (Text);
3701 
3702                --  If we could not read the ALI file that was just generated
3703                --  then there could be a problem reading either the ALI or the
3704                --  corresponding object file (if Check_Object_Consistency is
3705                --  set Read_Library_Info checks that the time stamp of the
3706                --  object file is more recent than that of the ALI). However,
3707                --  we record a failure only if not already done.
3708 
3709                else
3710                   if Compilation_OK and not Syntax_Only then
3711                      Inform
3712                        (Data.Lib_File,
3713                         "WARNING: ALI or object file not found after compile");
3714 
3715                      if not Is_Regular_File
3716                               (Get_Name_String (Name_Id (Data.Full_Lib_File)))
3717                      then
3718                         Inform (Data.Full_Lib_File, "not found");
3719                      end if;
3720 
3721                      Record_Failure (Data.Full_Source_File, Data.Source_Unit);
3722                   end if;
3723                end if;
3724             end if;
3725          end if;
3726       end Wait_For_Available_Slot;
3727 
3728    --  Start of processing for Compile_Sources
3729 
3730    begin
3731       pragma Assert (Args'First = 1);
3732 
3733       Outstanding_Compiles := 0;
3734       Running_Compile := new Comp_Data_Arr (1 .. Max_Process);
3735 
3736       --  Package and Queue initializations
3737 
3738       Good_ALI.Init;
3739 
3740       if Initialize_ALI_Data then
3741          Initialize_ALI;
3742          Initialize_ALI_Source;
3743       end if;
3744 
3745       --  The following two flags affect the behavior of ALI.Set_Source_Table.
3746       --  We set Check_Source_Files to True to ensure that source file time
3747       --  stamps are checked, and we set All_Sources to False to avoid checking
3748       --  the presence of the source files listed in the source dependency
3749       --  section of an ali file (which would be a mistake since the ali file
3750       --  may be obsolete).
3751 
3752       Check_Source_Files := True;
3753       All_Sources        := False;
3754 
3755       Queue.Insert
3756         ((Format  => Format_Gnatmake,
3757           File    => Main_Source,
3758           Project => Main_Project,
3759           Unit    => No_Unit_Name,
3760           Index   => Main_Index,
3761           Sid     => No_Source));
3762 
3763       First_Compiled_File   := No_File;
3764       Most_Recent_Obj_File  := No_File;
3765       Most_Recent_Obj_Stamp := Empty_Time_Stamp;
3766       Main_Unit             := False;
3767 
3768       --  Keep looping until there is no more work to do (the Q is empty)
3769       --  and all the outstanding compilations have terminated.
3770 
3771       Make_Loop :
3772       while not Queue.Is_Empty or else Outstanding_Compiles > 0 loop
3773          exit Make_Loop when Must_Exit_Because_Of_Error;
3774          exit Make_Loop when Start_Compile_If_Possible (Args);
3775 
3776          Wait_For_Available_Slot;
3777 
3778          --  ??? Should be done as soon as we add a Good_ALI, wouldn't it avoid
3779          --  the need for a list of good ALI?
3780 
3781          Fill_Queue_From_ALI_Files;
3782 
3783          if Display_Compilation_Progress then
3784             Write_Str ("completed ");
3785             Write_Int (Int (Queue.Processed));
3786             Write_Str (" out of ");
3787             Write_Int (Int (Queue.Size));
3788             Write_Str (" (");
3789             Write_Int (Int ((Queue.Processed * 100) / Queue.Size));
3790             Write_Str ("%)...");
3791             Write_Eol;
3792          end if;
3793       end loop Make_Loop;
3794 
3795       Compilation_Failures := Bad_Compilation_Count;
3796 
3797       --  Compilation is finished
3798 
3799       --  Delete any temporary configuration pragma file
3800 
3801       if not Keep_Temporary_Files then
3802          Delete_Temp_Config_Files (Project_Tree);
3803       end if;
3804    end Compile_Sources;
3805 
3806    ----------------------------------
3807    -- Configuration_Pragmas_Switch --
3808    ----------------------------------
3809 
3810    function Configuration_Pragmas_Switch
3811      (For_Project : Project_Id) return Argument_List
3812    is
3813       The_Packages : Package_Id;
3814       Gnatmake     : Package_Id;
3815       Compiler     : Package_Id;
3816 
3817       Global_Attribute : Variable_Value := Nil_Variable_Value;
3818       Local_Attribute  : Variable_Value := Nil_Variable_Value;
3819 
3820       Global_Attribute_Present : Boolean := False;
3821       Local_Attribute_Present  : Boolean := False;
3822 
3823       Result : Argument_List (1 .. 3);
3824       Last   : Natural := 0;
3825 
3826    begin
3827       Prj.Env.Create_Config_Pragmas_File
3828         (For_Project, Project_Tree);
3829 
3830       if For_Project.Config_File_Name /= No_Path then
3831          Temporary_Config_File := For_Project.Config_File_Temp;
3832          Last := 1;
3833          Result (1) :=
3834            new String'
3835              ("-gnatec=" & Get_Name_String (For_Project.Config_File_Name));
3836 
3837       else
3838          Temporary_Config_File := False;
3839       end if;
3840 
3841       --  Check for attribute Builder'Global_Configuration_Pragmas
3842 
3843       The_Packages := Main_Project.Decl.Packages;
3844       Gnatmake :=
3845         Prj.Util.Value_Of
3846           (Name        => Name_Builder,
3847            In_Packages => The_Packages,
3848            Shared      => Project_Tree.Shared);
3849 
3850       if Gnatmake /= No_Package then
3851          Global_Attribute := Prj.Util.Value_Of
3852            (Variable_Name => Name_Global_Configuration_Pragmas,
3853             In_Variables  => Project_Tree.Shared.Packages.Table
3854                                (Gnatmake).Decl.Attributes,
3855             Shared        => Project_Tree.Shared);
3856          Global_Attribute_Present :=
3857            Global_Attribute /= Nil_Variable_Value
3858            and then Get_Name_String (Global_Attribute.Value) /= "";
3859 
3860          if Global_Attribute_Present then
3861             declare
3862                Path : constant String :=
3863                         Absolute_Path
3864                           (Path_Name_Type (Global_Attribute.Value),
3865                            Global_Attribute.Project);
3866             begin
3867                if not Is_Regular_File (Path) then
3868                   if Debug.Debug_Flag_F then
3869                      Make_Failed
3870                        ("cannot find configuration pragmas file "
3871                         & File_Name (Path));
3872                   else
3873                      Make_Failed
3874                        ("cannot find configuration pragmas file " & Path);
3875                   end if;
3876                end if;
3877 
3878                Last := Last + 1;
3879                Result (Last) := new String'("-gnatec=" &  Path);
3880             end;
3881          end if;
3882       end if;
3883 
3884       --  Check for attribute Compiler'Local_Configuration_Pragmas
3885 
3886       The_Packages := For_Project.Decl.Packages;
3887       Compiler :=
3888         Prj.Util.Value_Of
3889           (Name        => Name_Compiler,
3890            In_Packages => The_Packages,
3891            Shared      => Project_Tree.Shared);
3892 
3893       if Compiler /= No_Package then
3894          Local_Attribute := Prj.Util.Value_Of
3895            (Variable_Name => Name_Local_Configuration_Pragmas,
3896             In_Variables  => Project_Tree.Shared.Packages.Table
3897                                (Compiler).Decl.Attributes,
3898             Shared        => Project_Tree.Shared);
3899          Local_Attribute_Present :=
3900            Local_Attribute /= Nil_Variable_Value
3901            and then Get_Name_String (Local_Attribute.Value) /= "";
3902 
3903          if Local_Attribute_Present then
3904             declare
3905                Path : constant String :=
3906                         Absolute_Path
3907                           (Path_Name_Type (Local_Attribute.Value),
3908                            Local_Attribute.Project);
3909             begin
3910                if not Is_Regular_File (Path) then
3911                   if Debug.Debug_Flag_F then
3912                      Make_Failed
3913                        ("cannot find configuration pragmas file "
3914                         & File_Name (Path));
3915 
3916                   else
3917                      Make_Failed
3918                        ("cannot find configuration pragmas file " & Path);
3919                   end if;
3920                end if;
3921 
3922                Last := Last + 1;
3923                Result (Last) := new String'("-gnatec=" & Path);
3924             end;
3925          end if;
3926       end if;
3927 
3928       return Result (1 .. Last);
3929    end Configuration_Pragmas_Switch;
3930 
3931    ---------------
3932    -- Debug_Msg --
3933    ---------------
3934 
3935    procedure Debug_Msg (S : String; N : Name_Id) is
3936    begin
3937       if Debug.Debug_Flag_W then
3938          Write_Str ("   ... ");
3939          Write_Str (S);
3940          Write_Str (" ");
3941          Write_Name (N);
3942          Write_Eol;
3943       end if;
3944    end Debug_Msg;
3945 
3946    procedure Debug_Msg (S : String; N : File_Name_Type) is
3947    begin
3948       Debug_Msg (S, Name_Id (N));
3949    end Debug_Msg;
3950 
3951    procedure Debug_Msg (S : String; N : Unit_Name_Type) is
3952    begin
3953       Debug_Msg (S, Name_Id (N));
3954    end Debug_Msg;
3955 
3956    -------------
3957    -- Display --
3958    -------------
3959 
3960    procedure Display (Program : String; Args : Argument_List) is
3961    begin
3962       pragma Assert (Args'First = 1);
3963 
3964       if Display_Executed_Programs then
3965          Write_Str (Program);
3966 
3967          for J in Args'Range loop
3968 
3969             --  Never display -gnatea nor -gnatez
3970 
3971             if Args (J).all /= "-gnatea"
3972                  and then
3973                Args (J).all /= "-gnatez"
3974             then
3975                --  Do not display the mapping file argument automatically
3976                --  created when using a project file.
3977 
3978                if Main_Project = No_Project
3979                  or else Opt.Keep_Temporary_Files
3980                  or else Args (J)'Length < 8
3981                  or else
3982                    Args (J) (Args (J)'First .. Args (J)'First + 6) /= "-gnatem"
3983                then
3984                   --  When -dn is not specified, do not display the config
3985                   --  pragmas switch (-gnatec) for the temporary file created
3986                   --  by the project manager (always the first -gnatec switch).
3987                   --  Reset Temporary_Config_File to False so that the eventual
3988                   --  other -gnatec switches will be displayed.
3989 
3990                   if not Opt.Keep_Temporary_Files
3991                     and then Temporary_Config_File
3992                     and then Args (J)'Length > 7
3993                     and then Args (J) (Args (J)'First .. Args (J)'First + 6) =
3994                                                                     "-gnatec"
3995                   then
3996                      Temporary_Config_File := False;
3997 
3998                      --  Do not display the -F=mapping_file switch for gnatbind
3999                      --  if -dn is not specified.
4000 
4001                   elsif Opt.Keep_Temporary_Files
4002                     or else Args (J)'Length < 4
4003                     or else
4004                       Args (J) (Args (J)'First .. Args (J)'First + 2) /= "-F="
4005                   then
4006                      Write_Str (" ");
4007 
4008                      --  If -df is used, only display file names, not path
4009                      --  names.
4010 
4011                      if Debug.Debug_Flag_F then
4012                         declare
4013                            Equal_Pos : Natural;
4014 
4015                         begin
4016                            Equal_Pos := Args (J)'First - 1;
4017                            for K in Args (J)'Range loop
4018                               if Args (J) (K) = '=' then
4019                                  Equal_Pos := K;
4020                                  exit;
4021                               end if;
4022                            end loop;
4023 
4024                            if Is_Absolute_Path
4025                              (Args (J) (Equal_Pos + 1 .. Args (J)'Last))
4026                            then
4027                               Write_Str
4028                                 (Args (J) (Args (J)'First .. Equal_Pos));
4029                               Write_Str
4030                                 (File_Name
4031                                    (Args (J)
4032                                     (Equal_Pos + 1 .. Args (J)'Last)));
4033 
4034                            else
4035                               Write_Str (Args (J).all);
4036                            end if;
4037                         end;
4038 
4039                      else
4040                         Write_Str (Args (J).all);
4041                      end if;
4042                   end if;
4043                end if;
4044             end if;
4045          end loop;
4046 
4047          Write_Eol;
4048       end if;
4049    end Display;
4050 
4051    ----------------------
4052    -- Display_Commands --
4053    ----------------------
4054 
4055    procedure Display_Commands (Display : Boolean := True) is
4056    begin
4057       Display_Executed_Programs := Display;
4058    end Display_Commands;
4059 
4060    --------------------------
4061    -- Enter_Into_Obsoleted --
4062    --------------------------
4063 
4064    procedure Enter_Into_Obsoleted (F : File_Name_Type) is
4065       Name  : constant String := Get_Name_String (F);
4066       First : Natural;
4067       F2    : File_Name_Type;
4068 
4069    begin
4070       First := Name'Last;
4071       while First > Name'First
4072         and then not Is_Directory_Separator (Name (First - 1))
4073       loop
4074          First := First - 1;
4075       end loop;
4076 
4077       if First /= Name'First then
4078          Name_Len := 0;
4079          Add_Str_To_Name_Buffer (Name (First .. Name'Last));
4080          F2 := Name_Find;
4081 
4082       else
4083          F2 := F;
4084       end if;
4085 
4086       Debug_Msg ("New entry in Obsoleted table:", F2);
4087       Obsoleted.Set (F2, True);
4088    end Enter_Into_Obsoleted;
4089 
4090    ---------------
4091    -- Globalize --
4092    ---------------
4093 
4094    procedure Globalize (Success : out Boolean) is
4095       Quiet_Str       : aliased String := "-quiet";
4096       Globalizer_Args : constant Argument_List :=
4097                           (1 => Quiet_Str'Unchecked_Access);
4098       Previous_Dir    : String_Access;
4099 
4100       procedure Globalize_Dir (Dir : String);
4101       --  Call CodePeer globalizer on Dir
4102 
4103       -------------------
4104       -- Globalize_Dir --
4105       -------------------
4106 
4107       procedure Globalize_Dir (Dir : String) is
4108          Result : Boolean;
4109       begin
4110          if Previous_Dir = null or else Dir /= Previous_Dir.all then
4111             Free (Previous_Dir);
4112             Previous_Dir := new String'(Dir);
4113             Change_Dir (Dir);
4114             GNAT.OS_Lib.Spawn (Globalizer_Path.all, Globalizer_Args, Result);
4115             Success := Success and Result;
4116          end if;
4117       end Globalize_Dir;
4118 
4119       procedure Globalize_Dirs is new
4120         Prj.Env.For_All_Object_Dirs (Globalize_Dir);
4121 
4122    --  Start of processing for Globalize
4123 
4124    begin
4125       Success := True;
4126       Display (Globalizer, Globalizer_Args);
4127 
4128       if Globalizer_Path = null then
4129          Make_Failed ("error, unable to locate " & Globalizer);
4130       end if;
4131 
4132       if Main_Project = No_Project then
4133          GNAT.OS_Lib.Spawn (Globalizer_Path.all, Globalizer_Args, Success);
4134       else
4135          Globalize_Dirs (Main_Project, Project_Tree);
4136       end if;
4137    end Globalize;
4138 
4139    -------------------
4140    -- Linking_Phase --
4141    -------------------
4142 
4143    procedure Linking_Phase
4144      (Non_Std_Executable : Boolean := False;
4145       Executable         : File_Name_Type := No_File;
4146       Main_ALI_File      : File_Name_Type)
4147    is
4148       Linker_Switches_Last : constant Integer := Linker_Switches.Last;
4149       Path_Option          : constant String_Access :=
4150                                MLib.Linker_Library_Path_Option;
4151       Libraries_Present    : Boolean := False;
4152       Current              : Natural;
4153       Proj2                : Project_Id;
4154       Depth                : Natural;
4155       Proj1                : Project_List;
4156 
4157    begin
4158       if not Run_Path_Option then
4159          Linker_Switches.Increment_Last;
4160          Linker_Switches.Table (Linker_Switches.Last) :=
4161            new String'("-R");
4162       end if;
4163 
4164       if Main_Project /= No_Project then
4165          Library_Paths.Set_Last (0);
4166          Library_Projs.Init;
4167 
4168          if MLib.Tgt.Support_For_Libraries /= Prj.None then
4169 
4170             --  Check for library projects
4171 
4172             Proj1 := Project_Tree.Projects;
4173             while Proj1 /= null loop
4174                if Proj1.Project /= Main_Project
4175                  and then Proj1.Project.Library
4176                then
4177                   --  Add this project to table Library_Projs
4178 
4179                   Libraries_Present := True;
4180                   Depth := Proj1.Project.Depth;
4181                   Library_Projs.Increment_Last;
4182                   Current := Library_Projs.Last;
4183 
4184                   --  Any project with a greater depth should be after this
4185                   --  project in the list.
4186 
4187                   while Current > 1 loop
4188                      Proj2 := Library_Projs.Table (Current - 1);
4189                      exit when Proj2.Depth <= Depth;
4190                      Library_Projs.Table (Current) := Proj2;
4191                      Current := Current - 1;
4192                   end loop;
4193 
4194                   Library_Projs.Table (Current) := Proj1.Project;
4195 
4196                   --  If it is not a static library and path option is set, add
4197                   --  it to the Library_Paths table.
4198 
4199                   if Proj1.Project.Library_Kind /= Static
4200                     and then Proj1.Project.Extended_By = No_Project
4201                     and then Path_Option /= null
4202                   then
4203                      Library_Paths.Increment_Last;
4204                      Library_Paths.Table (Library_Paths.Last) :=
4205                        new String'
4206                          (Get_Name_String
4207                               (Proj1.Project.Library_Dir.Display_Name));
4208                   end if;
4209                end if;
4210 
4211                Proj1 := Proj1.Next;
4212             end loop;
4213 
4214             for Index in 1 .. Library_Projs.Last loop
4215                if Library_Projs.Table (Index).Extended_By = No_Project then
4216                   if Library_Projs.Table (Index).Library_Kind = Static then
4217                      Linker_Switches.Increment_Last;
4218                      Linker_Switches.Table (Linker_Switches.Last) :=
4219                        new String'
4220                          (Get_Name_String
4221                               (Library_Projs.Table
4222                                    (Index).Library_Dir.Display_Name) &
4223                           "lib" &
4224                           Get_Name_String
4225                             (Library_Projs.Table (Index).Library_Name) &
4226                           "." &
4227                           MLib.Tgt.Archive_Ext);
4228 
4229                   else
4230                      --  Add the -L switch
4231 
4232                      Linker_Switches.Increment_Last;
4233                      Linker_Switches.Table (Linker_Switches.Last) :=
4234                        new String'("-L" &
4235                          Get_Name_String (Library_Projs.Table (Index).
4236                                             Library_Dir.Display_Name));
4237 
4238                      --  Add the -l switch
4239 
4240                      Linker_Switches.Increment_Last;
4241                      Linker_Switches.Table (Linker_Switches.Last) :=
4242                        new String'("-l" &
4243                          Get_Name_String
4244                            (Library_Projs.Table (Index).Library_Name));
4245                   end if;
4246                end if;
4247             end loop;
4248          end if;
4249 
4250          if Libraries_Present then
4251 
4252             --  If Path_Option is not null, create the switch ("-Wl,-rpath,"
4253             --  or equivalent) with all the non-static library dirs plus the
4254             --  standard GNAT library dir. We do that only if Run_Path_Option
4255             --  is True (not disabled by -R switch).
4256 
4257             if Run_Path_Option and then Path_Option /= null then
4258                declare
4259                   Option  : String_Access;
4260                   Length  : Natural := Path_Option'Length;
4261                   Current : Natural;
4262 
4263                begin
4264                   if MLib.Separate_Run_Path_Options then
4265 
4266                      --  We are going to create one switch of the form
4267                      --  "-Wl,-rpath,dir_N" for each directory to
4268                      --  consider.
4269 
4270                      --  One switch for each library directory
4271 
4272                      for Index in
4273                        Library_Paths.First .. Library_Paths.Last
4274                      loop
4275                         Linker_Switches.Increment_Last;
4276                         Linker_Switches.Table (Linker_Switches.Last) :=
4277                           new String'
4278                             (Path_Option.all &
4279                              Library_Paths.Table (Index).all);
4280                      end loop;
4281 
4282                      --  One switch for the standard GNAT library dir
4283 
4284                      Linker_Switches.Increment_Last;
4285                      Linker_Switches.Table (Linker_Switches.Last) :=
4286                        new String'(Path_Option.all & MLib.Utl.Lib_Directory);
4287 
4288                   else
4289                      --  We are going to create one switch of the form
4290                      --  "-Wl,-rpath,dir_1:dir_2:dir_3"
4291 
4292                      for Index in Library_Paths.First .. Library_Paths.Last
4293                      loop
4294                         --  Add the length of the library dir plus one for the
4295                         --  directory separator.
4296 
4297                         Length :=
4298                           Length + Library_Paths.Table (Index)'Length + 1;
4299                      end loop;
4300 
4301                      --  Finally, add the length of the standard GNAT
4302                      --  library dir.
4303 
4304                      Length := Length + MLib.Utl.Lib_Directory'Length;
4305                      Option := new String (1 .. Length);
4306                      Option (1 .. Path_Option'Length) := Path_Option.all;
4307                      Current := Path_Option'Length;
4308 
4309                      --  Put each library dir followed by a dir
4310                      --  separator.
4311 
4312                      for Index in Library_Paths.First .. Library_Paths.Last
4313                      loop
4314                         Option
4315                           (Current + 1 ..
4316                              Current + Library_Paths.Table (Index)'Length) :=
4317                           Library_Paths.Table (Index).all;
4318                         Current :=
4319                           Current + Library_Paths.Table (Index)'Length + 1;
4320                         Option (Current) := Path_Separator;
4321                      end loop;
4322 
4323                      --  Finally put the standard GNAT library dir
4324 
4325                      Option
4326                        (Current + 1 ..
4327                           Current + MLib.Utl.Lib_Directory'Length) :=
4328                          MLib.Utl.Lib_Directory;
4329 
4330                      --  And add the switch to the linker switches
4331 
4332                      Linker_Switches.Increment_Last;
4333                      Linker_Switches.Table (Linker_Switches.Last) := Option;
4334                   end if;
4335                end;
4336             end if;
4337          end if;
4338 
4339          --  Put the object directories in ADA_OBJECTS_PATH
4340 
4341          Prj.Env.Set_Ada_Paths
4342            (Main_Project,
4343             Project_Tree,
4344             Including_Libraries => False,
4345             Include_Path        => False);
4346 
4347          --  Check for attributes Linker'Linker_Options in projects other than
4348          --  the main project
4349 
4350          declare
4351             Linker_Options : constant String_List :=
4352               Linker_Options_Switches
4353                 (Main_Project,
4354                  Do_Fail => Make_Failed'Access,
4355                  In_Tree => Project_Tree);
4356          begin
4357             for Option in Linker_Options'Range loop
4358                Linker_Switches.Increment_Last;
4359                Linker_Switches.Table (Linker_Switches.Last) :=
4360                  Linker_Options (Option);
4361             end loop;
4362          end;
4363       end if;
4364 
4365       if CodePeer_Mode then
4366          Linker_Switches.Increment_Last;
4367          Linker_Switches.Table (Linker_Switches.Last) :=
4368            new String'(CodePeer_Mode_String);
4369       end if;
4370 
4371       --  Add switch -M to gnatlink if builder switch --create-map-file
4372       --  has been specified.
4373 
4374       if Map_File /= null then
4375          Linker_Switches.Increment_Last;
4376          Linker_Switches.Table (Linker_Switches.Last) :=
4377            new String'("-M" & Map_File.all);
4378       end if;
4379 
4380       declare
4381          Args : Argument_List
4382                   (Linker_Switches.First .. Linker_Switches.Last + 2);
4383 
4384          Last_Arg : Integer := Linker_Switches.First - 1;
4385          Skip     : Boolean := False;
4386 
4387       begin
4388          --  Get all the linker switches
4389 
4390          for J in Linker_Switches.First .. Linker_Switches.Last loop
4391             if Skip then
4392                Skip := False;
4393 
4394             elsif Non_Std_Executable
4395               and then Linker_Switches.Table (J).all = "-o"
4396             then
4397                Skip := True;
4398 
4399                --  Here we capture and duplicate the linker argument. We
4400                --  need to do the duplication since the arguments will get
4401                --  normalized. Not doing so will result in calling normalized
4402                --  two times for the same set of arguments if gnatmake is
4403                --  passed multiple mains. This can result in the wrong
4404                --  argument being passed to the linker.
4405 
4406             else
4407                Last_Arg := Last_Arg + 1;
4408                Args (Last_Arg) := new String'(Linker_Switches.Table (J).all);
4409             end if;
4410          end loop;
4411 
4412          --  If need be, add the -o switch
4413 
4414          if Non_Std_Executable then
4415             Last_Arg := Last_Arg + 1;
4416             Args (Last_Arg) := new String'("-o");
4417             Last_Arg := Last_Arg + 1;
4418             Args (Last_Arg) := new String'(Get_Name_String (Executable));
4419          end if;
4420 
4421          --  And invoke the linker
4422 
4423          declare
4424             Success : Boolean := False;
4425 
4426          begin
4427             --  If gnatmake was invoked with --subdirs and no project file,
4428             --  put the executable in the subdirectory specified.
4429 
4430             if Prj.Subdirs /= null and then Main_Project = No_Project then
4431                Change_Dir (Object_Directory_Path.all);
4432             end if;
4433 
4434             Link (Main_ALI_File,
4435                   Link_With_Shared_Libgcc.all &
4436                   Args (Args'First .. Last_Arg),
4437                   Success);
4438 
4439             if Success then
4440                Successful_Links.Increment_Last;
4441                Successful_Links.Table (Successful_Links.Last) := Main_ALI_File;
4442 
4443             elsif Osint.Number_Of_Files = 1 or else not Keep_Going then
4444                Make_Failed ("*** link failed.");
4445 
4446             else
4447                Set_Standard_Error;
4448                Write_Line ("*** link failed");
4449 
4450                if Commands_To_Stdout then
4451                   Set_Standard_Output;
4452                end if;
4453 
4454                Failed_Links.Increment_Last;
4455                Failed_Links.Table (Failed_Links.Last) := Main_ALI_File;
4456             end if;
4457          end;
4458       end;
4459 
4460       Linker_Switches.Set_Last (Linker_Switches_Last);
4461    end Linking_Phase;
4462 
4463    -------------------
4464    -- Binding_Phase --
4465    -------------------
4466 
4467    procedure Binding_Phase
4468      (Stand_Alone_Libraries : Boolean := False;
4469       Main_ALI_File         : File_Name_Type)
4470    is
4471       Args : Argument_List (Binder_Switches.First .. Binder_Switches.Last + 2);
4472       --  The arguments for the invocation of gnatbind
4473 
4474       Last_Arg : Natural := Binder_Switches.Last;
4475       --  Index of the last argument in Args
4476 
4477       Shared_Libs : Boolean := False;
4478       --  Set to True when there are shared library project files or
4479       --  when gnatbind is invoked with -shared.
4480 
4481       Proj : Project_List;
4482 
4483       Mapping_Path : Path_Name_Type := No_Path;
4484       --  The path name of the mapping file
4485 
4486    begin
4487       --  Check if there are shared libraries, so that gnatbind is called with
4488       --  -shared. Check also if gnatbind is called with -shared, so that
4489       --  gnatlink is called with -shared-libgcc ensuring that the shared
4490       --  version of libgcc will be used.
4491 
4492       if Main_Project /= No_Project
4493         and then MLib.Tgt.Support_For_Libraries /= Prj.None
4494       then
4495          Proj := Project_Tree.Projects;
4496          while Proj /= null loop
4497             if Proj.Project.Library
4498               and then Proj.Project.Library_Kind /= Static
4499             then
4500                Shared_Libs := True;
4501                Bind_Shared := Shared_Switch'Access;
4502                exit;
4503             end if;
4504 
4505             Proj := Proj.Next;
4506          end loop;
4507       end if;
4508 
4509       --  Check now for switch -shared
4510 
4511       if not Shared_Libs then
4512          for J in Binder_Switches.First .. Last_Arg loop
4513             if Binder_Switches.Table (J).all = "-shared" then
4514                Shared_Libs := True;
4515                exit;
4516             end if;
4517          end loop;
4518       end if;
4519 
4520       --  If shared libraries present, invoke gnatlink with
4521       --  -shared-libgcc.
4522 
4523       if Shared_Libs then
4524          Link_With_Shared_Libgcc := Shared_Libgcc_Switch'Access;
4525       end if;
4526 
4527       --  Get all the binder switches
4528 
4529       for J in Binder_Switches.First .. Last_Arg loop
4530          Args (J) := Binder_Switches.Table (J);
4531       end loop;
4532 
4533       if Stand_Alone_Libraries then
4534          Last_Arg := Last_Arg + 1;
4535          Args (Last_Arg) := Force_Elab_Flags_String'Access;
4536       end if;
4537 
4538       if CodePeer_Mode then
4539          Last_Arg := Last_Arg + 1;
4540          Args (Last_Arg) := CodePeer_Mode_String'Access;
4541       end if;
4542 
4543       if Main_Project /= No_Project then
4544 
4545          --  Put all the source directories in ADA_INCLUDE_PATH, and all the
4546          --  object directories in ADA_OBJECTS_PATH.
4547 
4548          Prj.Env.Set_Ada_Paths
4549            (Project             => Main_Project,
4550             In_Tree             => Project_Tree,
4551             Including_Libraries => True,
4552             Include_Path        => Use_Include_Path_File);
4553 
4554          --  If switch -C was specified, create a binder mapping file
4555 
4556          if Create_Mapping_File then
4557             Mapping_Path := Create_Binder_Mapping_File (Project_Tree);
4558 
4559             if Mapping_Path /= No_Path then
4560                Last_Arg := Last_Arg + 1;
4561                Args (Last_Arg) :=
4562                  new String'("-F=" & Get_Name_String (Mapping_Path));
4563             end if;
4564          end if;
4565       end if;
4566 
4567       --  If gnatmake was invoked with --subdirs and no project file, put the
4568       --  binder generated files in the subdirectory specified.
4569 
4570       if Main_Project = No_Project and then Prj.Subdirs /= null then
4571          Change_Dir (Object_Directory_Path.all);
4572       end if;
4573 
4574       begin
4575          Bind (Main_ALI_File,
4576                Bind_Shared.all & Args (Args'First .. Last_Arg));
4577 
4578       exception
4579          when others =>
4580 
4581             --  Delete the temporary mapping file if one was created
4582 
4583             if Mapping_Path /= No_Path then
4584                Delete_Temporary_File (Project_Tree.Shared, Mapping_Path);
4585             end if;
4586 
4587             --  And reraise the exception
4588 
4589             raise;
4590       end;
4591 
4592       --  If -dn was not specified, delete the temporary mapping file
4593       --  if one was created.
4594 
4595       if Mapping_Path /= No_Path then
4596          Delete_Temporary_File (Project_Tree.Shared, Mapping_Path);
4597       end if;
4598    end Binding_Phase;
4599 
4600    -------------------
4601    -- Library_Phase --
4602    -------------------
4603 
4604    procedure Library_Phase
4605      (Stand_Alone_Libraries : in out Boolean;
4606       Library_Rebuilt       : in out Boolean)
4607    is
4608       Depth   : Natural;
4609       Current : Natural;
4610       Proj1   : Project_List;
4611 
4612       procedure Add_To_Library_Projs (Proj : Project_Id);
4613       --  Add project Project to table Library_Projs in decreasing depth order
4614 
4615       --------------------------
4616       -- Add_To_Library_Projs --
4617       --------------------------
4618 
4619       procedure Add_To_Library_Projs (Proj : Project_Id) is
4620          Prj : Project_Id;
4621 
4622       begin
4623          Library_Projs.Increment_Last;
4624          Depth := Proj.Depth;
4625 
4626          --  Put the projects in decreasing depth order, so that
4627          --  if libA depends on libB, libB is first in order.
4628 
4629          Current := Library_Projs.Last;
4630          while Current > 1 loop
4631             Prj := Library_Projs.Table (Current - 1);
4632             exit when Prj.Depth >= Depth;
4633             Library_Projs.Table (Current) := Prj;
4634             Current := Current - 1;
4635          end loop;
4636 
4637          Library_Projs.Table (Current) := Proj;
4638       end Add_To_Library_Projs;
4639 
4640    --  Start of processing for Library_Phase
4641 
4642    begin
4643       Library_Projs.Init;
4644 
4645       --  Put in Library_Projs table all library project file ids when the
4646       --  library need to be rebuilt.
4647 
4648       Proj1 := Project_Tree.Projects;
4649       while Proj1 /= null loop
4650          if Proj1.Project.Extended_By = No_Project then
4651             if Proj1.Project.Standalone_Library /= No then
4652                Stand_Alone_Libraries := True;
4653             end if;
4654 
4655             if Proj1.Project.Library then
4656                MLib.Prj.Check_Library
4657                  (Proj1.Project, Project_Tree);
4658             end if;
4659 
4660             if Proj1.Project.Need_To_Build_Lib then
4661                Add_To_Library_Projs (Proj1.Project);
4662             end if;
4663          end if;
4664 
4665          Proj1 := Proj1.Next;
4666       end loop;
4667 
4668       --  Check if importing libraries should be regenerated
4669       --  because at least an imported library will be
4670       --  regenerated or is more recent.
4671 
4672       Proj1 := Project_Tree.Projects;
4673       while Proj1 /= null loop
4674          if Proj1.Project.Library
4675            and then Proj1.Project.Extended_By = No_Project
4676            and then Proj1.Project.Library_Kind /= Static
4677            and then not Proj1.Project.Need_To_Build_Lib
4678            and then not Proj1.Project.Externally_Built
4679          then
4680             declare
4681                List    : Project_List;
4682                Proj2   : Project_Id;
4683                Rebuild : Boolean := False;
4684 
4685                Lib_Timestamp1 : constant Time_Stamp_Type :=
4686                                   Proj1.Project.Library_TS;
4687 
4688             begin
4689                List := Proj1.Project.All_Imported_Projects;
4690                while List /= null loop
4691                   Proj2 := List.Project;
4692 
4693                   if Proj2.Library then
4694                      if Proj2.Need_To_Build_Lib
4695                        or else
4696                          (Lib_Timestamp1 < Proj2.Library_TS)
4697                      then
4698                         Rebuild := True;
4699                         exit;
4700                      end if;
4701                   end if;
4702 
4703                   List := List.Next;
4704                end loop;
4705 
4706                if Rebuild then
4707                   Proj1.Project.Need_To_Build_Lib := True;
4708                   Add_To_Library_Projs (Proj1.Project);
4709                end if;
4710             end;
4711          end if;
4712 
4713          Proj1 := Proj1.Next;
4714       end loop;
4715 
4716       --  Reset the flags Need_To_Build_Lib for the next main, to avoid
4717       --  rebuilding libraries uselessly.
4718 
4719       Proj1 := Project_Tree.Projects;
4720       while Proj1 /= null loop
4721          Proj1.Project.Need_To_Build_Lib := False;
4722          Proj1 := Proj1.Next;
4723       end loop;
4724 
4725       --  Build the libraries, if any need to be built
4726 
4727       for J in 1 .. Library_Projs.Last loop
4728          Library_Rebuilt := True;
4729 
4730          --  If a library is rebuilt, then executables are obsolete
4731 
4732          Executable_Obsolete := True;
4733 
4734          MLib.Prj.Build_Library
4735            (For_Project   => Library_Projs.Table (J),
4736             In_Tree       => Project_Tree,
4737             Gnatbind      => Gnatbind.all,
4738             Gnatbind_Path => Gnatbind_Path,
4739             Gcc           => Gcc.all,
4740             Gcc_Path      => Gcc_Path);
4741       end loop;
4742    end Library_Phase;
4743 
4744    -----------------------
4745    -- Compilation_Phase --
4746    -----------------------
4747 
4748    procedure Compilation_Phase
4749      (Main_Source_File           : File_Name_Type;
4750       Current_Main_Index         : Int := 0;
4751       Total_Compilation_Failures : in out Natural;
4752       Stand_Alone_Libraries      : in out Boolean;
4753       Executable                 : File_Name_Type := No_File;
4754       Is_Last_Main               : Boolean;
4755       Stop_Compile               : out Boolean)
4756    is
4757       Args                : Argument_List (1 .. Gcc_Switches.Last);
4758       First_Compiled_File : File_Name_Type;
4759       Youngest_Obj_File   : File_Name_Type;
4760       Youngest_Obj_Stamp  : Time_Stamp_Type;
4761 
4762       Is_Main_Unit : Boolean;
4763       --  Set True by Compile_Sources if Main_Source_File can be a main unit
4764 
4765       Compilation_Failures : Natural;
4766 
4767       Executable_Stamp : Time_Stamp_Type;
4768 
4769       Library_Rebuilt : Boolean := False;
4770 
4771    begin
4772       Stop_Compile := False;
4773 
4774       for J in 1 .. Gcc_Switches.Last loop
4775          Args (J) := Gcc_Switches.Table (J);
4776       end loop;
4777 
4778       --  Now we invoke Compile_Sources for the current main
4779 
4780       Compile_Sources
4781         (Main_Source           => Main_Source_File,
4782          Args                  => Args,
4783          First_Compiled_File   => First_Compiled_File,
4784          Most_Recent_Obj_File  => Youngest_Obj_File,
4785          Most_Recent_Obj_Stamp => Youngest_Obj_Stamp,
4786          Main_Unit             => Is_Main_Unit,
4787          Main_Index            => Current_Main_Index,
4788          Compilation_Failures  => Compilation_Failures,
4789          Check_Readonly_Files  => Check_Readonly_Files,
4790          Do_Not_Execute        => Do_Not_Execute,
4791          Force_Compilations    => Force_Compilations,
4792          In_Place_Mode         => In_Place_Mode,
4793          Keep_Going            => Keep_Going,
4794          Initialize_ALI_Data   => True,
4795          Max_Process           => Saved_Maximum_Processes);
4796 
4797       if Verbose_Mode then
4798          Write_Str ("End of compilation");
4799          Write_Eol;
4800       end if;
4801 
4802       Total_Compilation_Failures :=
4803         Total_Compilation_Failures + Compilation_Failures;
4804 
4805       if Total_Compilation_Failures /= 0 then
4806          Stop_Compile := True;
4807          return;
4808       end if;
4809 
4810       --  Regenerate libraries, if there are any and if object files have been
4811       --  regenerated. Note that we skip this in CodePeer mode because we don't
4812       --  need libraries in this case, and more importantly, the object files
4813       --  may not be present.
4814 
4815       if Main_Project /= No_Project
4816         and then not CodePeer_Mode
4817         and then MLib.Tgt.Support_For_Libraries /= Prj.None
4818         and then (Do_Bind_Step
4819                    or Unique_Compile_All_Projects
4820                    or not Compile_Only)
4821         and then (Do_Link_Step or Is_Last_Main)
4822       then
4823          Library_Phase
4824            (Stand_Alone_Libraries => Stand_Alone_Libraries,
4825             Library_Rebuilt       => Library_Rebuilt);
4826       end if;
4827 
4828       if List_Dependencies then
4829          if First_Compiled_File /= No_File then
4830             Inform
4831               (First_Compiled_File,
4832                "must be recompiled. Can't generate dependence list.");
4833          else
4834             List_Depend;
4835          end if;
4836 
4837       elsif First_Compiled_File = No_File
4838         and then not Do_Bind_Step
4839         and then not Quiet_Output
4840         and then not Library_Rebuilt
4841         and then Osint.Number_Of_Files = 1
4842       then
4843          Inform (Msg => "objects up to date.");
4844          Stop_Compile := True;
4845          return;
4846 
4847       elsif Do_Not_Execute and then First_Compiled_File /= No_File then
4848          Write_Name (First_Compiled_File);
4849          Write_Eol;
4850       end if;
4851 
4852       --  Stop after compile step if any of:
4853 
4854       --    1) -n (Do_Not_Execute) specified
4855 
4856       --    2) -M (List_Dependencies) specified (also sets
4857       --       Do_Not_Execute above, so this is probably superfluous).
4858 
4859       --    3) -c (Compile_Only) specified, but not -b (Bind_Only)
4860 
4861       --    4) Made unit cannot be a main unit
4862 
4863       if ((Do_Not_Execute
4864             or List_Dependencies
4865             or not Do_Bind_Step
4866             or not Is_Main_Unit)
4867           and not No_Main_Subprogram
4868           and not Build_Bind_And_Link_Full_Project)
4869         or Unique_Compile
4870       then
4871          Stop_Compile := True;
4872          return;
4873       end if;
4874 
4875       --  If the objects were up-to-date check if the executable file is also
4876       --  up-to-date. For now always bind and link in CodePeer mode where there
4877       --  is no executable.
4878 
4879       if not CodePeer_Mode
4880         and then First_Compiled_File = No_File
4881       then
4882          Executable_Stamp := File_Stamp (Executable);
4883 
4884          if not Executable_Obsolete then
4885             Executable_Obsolete := Youngest_Obj_Stamp > Executable_Stamp;
4886          end if;
4887 
4888          if not Executable_Obsolete then
4889             for Index in reverse 1 .. Dependencies.Last loop
4890                if Is_In_Obsoleted (Dependencies.Table (Index).Depends_On) then
4891                   Enter_Into_Obsoleted (Dependencies.Table (Index).This);
4892                end if;
4893             end loop;
4894 
4895             Executable_Obsolete := Is_In_Obsoleted (Main_Source_File);
4896             Dependencies.Init;
4897          end if;
4898 
4899          if not Executable_Obsolete then
4900 
4901             --  If no Ada object files obsolete the executable, check
4902             --  for younger or missing linker files.
4903 
4904             Check_Linker_Options
4905               (Executable_Stamp,
4906                Youngest_Obj_File,
4907                Youngest_Obj_Stamp);
4908 
4909             Executable_Obsolete := Youngest_Obj_File /= No_File;
4910          end if;
4911 
4912          --  Check if any library file is more recent than the
4913          --  executable: there may be an externally built library
4914          --  file that has been modified.
4915 
4916          if not Executable_Obsolete and then Main_Project /= No_Project then
4917             declare
4918                Proj1 : Project_List;
4919 
4920             begin
4921                Proj1 := Project_Tree.Projects;
4922                while Proj1 /= null loop
4923                   if Proj1.Project.Library
4924                     and then Proj1.Project.Library_TS > Executable_Stamp
4925                   then
4926                      Executable_Obsolete := True;
4927                      Youngest_Obj_Stamp := Proj1.Project.Library_TS;
4928                      Name_Len := 0;
4929                      Add_Str_To_Name_Buffer ("library ");
4930                      Add_Str_To_Name_Buffer
4931                        (Get_Name_String (Proj1.Project.Library_Name));
4932                      Youngest_Obj_File := Name_Find;
4933                      exit;
4934                   end if;
4935 
4936                   Proj1 := Proj1.Next;
4937                end loop;
4938             end;
4939          end if;
4940 
4941          --  Return if the executable is up to date and otherwise
4942          --  motivate the relink/rebind.
4943 
4944          if not Executable_Obsolete then
4945             if not Quiet_Output then
4946                Inform (Executable, "up to date.");
4947             end if;
4948 
4949             Stop_Compile := True;
4950             return;
4951          end if;
4952 
4953          if Executable_Stamp (1) = ' ' then
4954             if not No_Main_Subprogram then
4955                Verbose_Msg (Executable, "missing.", Prefix => "  ");
4956             end if;
4957 
4958          elsif Youngest_Obj_Stamp (1) = ' ' then
4959             Verbose_Msg
4960               (Youngest_Obj_File, "missing.",  Prefix => "  ");
4961 
4962          elsif Youngest_Obj_Stamp > Executable_Stamp then
4963             Verbose_Msg
4964               (Youngest_Obj_File,
4965                "(" & String (Youngest_Obj_Stamp) & ") newer than",
4966                Executable,
4967                "(" & String (Executable_Stamp) & ")");
4968 
4969          else
4970             Verbose_Msg
4971               (Executable, "needs to be rebuilt", Prefix => "  ");
4972 
4973          end if;
4974       end if;
4975    end Compilation_Phase;
4976 
4977    ----------------------------------------
4978    -- Resolve_Relative_Names_In_Switches --
4979    ----------------------------------------
4980 
4981    procedure Resolve_Relative_Names_In_Switches (Current_Work_Dir : String) is
4982    begin
4983       --  If a relative path output file has been specified, we add the
4984       --  exec directory.
4985 
4986       for J in reverse 1 .. Saved_Linker_Switches.Last - 1 loop
4987          if Saved_Linker_Switches.Table (J).all = Output_Flag.all then
4988             declare
4989                Exec_File_Name : constant String :=
4990                                   Saved_Linker_Switches.Table (J + 1).all;
4991 
4992             begin
4993                if not Is_Absolute_Path (Exec_File_Name) then
4994                   Get_Name_String (Main_Project.Exec_Directory.Display_Name);
4995                   Add_Str_To_Name_Buffer (Exec_File_Name);
4996                   Saved_Linker_Switches.Table (J + 1) :=
4997                     new String'(Name_Buffer (1 .. Name_Len));
4998                end if;
4999             end;
5000 
5001             exit;
5002          end if;
5003       end loop;
5004 
5005       --  If we are using a project file, for relative paths we add the
5006       --  current working directory for any relative path on the command
5007       --  line and the project directory, for any relative path in the
5008       --  project file.
5009 
5010       declare
5011          Dir_Path : constant String :=
5012                       Get_Name_String (Main_Project.Directory.Display_Name);
5013       begin
5014          for J in 1 .. Binder_Switches.Last loop
5015             Ensure_Absolute_Path
5016               (Binder_Switches.Table (J),
5017                Do_Fail => Make_Failed'Access,
5018                Parent => Dir_Path, For_Gnatbind => True);
5019          end loop;
5020 
5021          for J in 1 .. Saved_Binder_Switches.Last loop
5022             Ensure_Absolute_Path
5023               (Saved_Binder_Switches.Table (J),
5024                Do_Fail             => Make_Failed'Access,
5025                Parent              => Current_Work_Dir,
5026                For_Gnatbind        => True);
5027          end loop;
5028 
5029          for J in 1 .. Linker_Switches.Last loop
5030             Ensure_Absolute_Path
5031               (Linker_Switches.Table (J),
5032                Parent  => Dir_Path,
5033                Do_Fail => Make_Failed'Access);
5034          end loop;
5035 
5036          for J in 1 .. Saved_Linker_Switches.Last loop
5037             Ensure_Absolute_Path
5038               (Saved_Linker_Switches.Table (J),
5039                Do_Fail => Make_Failed'Access,
5040                Parent  => Current_Work_Dir);
5041          end loop;
5042 
5043          for J in 1 .. Gcc_Switches.Last loop
5044             Ensure_Absolute_Path
5045               (Gcc_Switches.Table (J),
5046                Do_Fail              => Make_Failed'Access,
5047                Parent               => Dir_Path,
5048                Including_Non_Switch => False);
5049          end loop;
5050 
5051          for J in 1 .. Saved_Gcc_Switches.Last loop
5052             Ensure_Absolute_Path
5053               (Saved_Gcc_Switches.Table (J),
5054                Parent               => Current_Work_Dir,
5055                Do_Fail              => Make_Failed'Access,
5056                Including_Non_Switch => False);
5057          end loop;
5058       end;
5059    end Resolve_Relative_Names_In_Switches;
5060 
5061    -----------------------------------
5062    -- Queue_Library_Project_Sources --
5063    -----------------------------------
5064 
5065    procedure Queue_Library_Project_Sources is
5066    begin
5067       if not Unique_Compile
5068         and then MLib.Tgt.Support_For_Libraries /= Prj.None
5069       then
5070          declare
5071             Proj : Project_List;
5072 
5073          begin
5074             Proj := Project_Tree.Projects;
5075             while Proj /= null loop
5076                if Proj.Project.Library then
5077                   Proj.Project.Need_To_Build_Lib :=
5078                     not MLib.Tgt.Library_Exists_For
5079                           (Proj.Project, Project_Tree)
5080                     and then not Proj.Project.Externally_Built;
5081 
5082                   if Proj.Project.Need_To_Build_Lib then
5083 
5084                      --  If there is no object directory, then it will be
5085                      --  impossible to build the library, so fail immediately.
5086 
5087                      if Proj.Project.Object_Directory = No_Path_Information
5088                      then
5089                         Make_Failed
5090                           ("no object files to build library for"
5091                            & " project """
5092                            & Get_Name_String (Proj.Project.Name)
5093                            & """");
5094                         Proj.Project.Need_To_Build_Lib := False;
5095 
5096                      else
5097                         if Verbose_Mode then
5098                            Write_Str
5099                              ("Library file does not exist for "
5100                               & "project """);
5101                            Write_Str
5102                              (Get_Name_String (Proj.Project.Name));
5103                            Write_Line ("""");
5104                         end if;
5105 
5106                         Insert_Project_Sources
5107                           (The_Project  => Proj.Project,
5108                            All_Projects => False,
5109                            Into_Q       => True);
5110                      end if;
5111                   end if;
5112                end if;
5113 
5114                Proj := Proj.Next;
5115             end loop;
5116          end;
5117       end if;
5118    end Queue_Library_Project_Sources;
5119 
5120    ------------------------
5121    -- Compute_Executable --
5122    ------------------------
5123 
5124    procedure Compute_Executable
5125      (Main_Source_File   : File_Name_Type;
5126       Executable         : out File_Name_Type;
5127       Non_Std_Executable : out Boolean)
5128    is
5129    begin
5130       Executable          := No_File;
5131       Non_Std_Executable  :=
5132         Targparm.Executable_Extension_On_Target /= No_Name;
5133 
5134       --  Look inside the linker switches to see if the name of the final
5135       --  executable program was specified.
5136 
5137       for J in reverse Linker_Switches.First .. Linker_Switches.Last loop
5138          if Linker_Switches.Table (J).all = Output_Flag.all then
5139             pragma Assert (J < Linker_Switches.Last);
5140 
5141             --  We cannot specify a single executable for several main
5142             --  subprograms
5143 
5144             if Osint.Number_Of_Files > 1 then
5145                Fail ("cannot specify a single executable for several mains");
5146             end if;
5147 
5148             Name_Len := 0;
5149             Add_Str_To_Name_Buffer (Linker_Switches.Table (J + 1).all);
5150             Executable := Name_Enter;
5151 
5152             Verbose_Msg (Executable, "final executable");
5153          end if;
5154       end loop;
5155 
5156       --  If the name of the final executable program was not specified then
5157       --  construct it from the main input file.
5158 
5159       if Executable = No_File then
5160          if Main_Project = No_Project then
5161             Executable := Executable_Name (Strip_Suffix (Main_Source_File));
5162 
5163          else
5164             --  If we are using a project file, we attempt to remove the body
5165             --  (or spec) termination of the main subprogram. We find it the
5166             --  naming scheme of the project file. This avoids generating an
5167             --  executable "main.2" for a main subprogram "main.2.ada", when
5168             --  the body termination is ".2.ada".
5169 
5170             Executable :=
5171               Prj.Util.Executable_Of
5172                 (Main_Project, Project_Tree.Shared,
5173                  Main_Source_File, Main_Index);
5174          end if;
5175       end if;
5176 
5177       if Main_Project /= No_Project
5178         and then Main_Project.Exec_Directory /= No_Path_Information
5179       then
5180          declare
5181             Exec_File_Name : constant String := Get_Name_String (Executable);
5182          begin
5183             if not Is_Absolute_Path (Exec_File_Name) then
5184                Get_Name_String (Main_Project.Exec_Directory.Display_Name);
5185                Add_Str_To_Name_Buffer (Exec_File_Name);
5186                Executable := Name_Find;
5187             end if;
5188 
5189             Non_Std_Executable := True;
5190          end;
5191       end if;
5192    end Compute_Executable;
5193 
5194    -------------------------------
5195    -- Compute_Switches_For_Main --
5196    -------------------------------
5197 
5198    procedure Compute_Switches_For_Main
5199      (Main_Source_File  : in out File_Name_Type;
5200       Root_Environment  : in out Prj.Tree.Environment;
5201       Compute_Builder   : Boolean;
5202       Current_Work_Dir  : String)
5203    is
5204       function Add_Global_Switches
5205         (Switch      : String;
5206          For_Lang    : Name_Id;
5207          For_Builder : Boolean;
5208          Has_Global_Compilation_Switches : Boolean) return Boolean;
5209       --  Handles builder and global compilation switches, as read from the
5210       --  project file.
5211 
5212       -------------------------
5213       -- Add_Global_Switches --
5214       -------------------------
5215 
5216       function Add_Global_Switches
5217         (Switch      : String;
5218          For_Lang    : Name_Id;
5219          For_Builder : Boolean;
5220          Has_Global_Compilation_Switches : Boolean) return Boolean
5221       is
5222          pragma Unreferenced (For_Lang);
5223 
5224       begin
5225          if For_Builder then
5226             Program_Args := None;
5227             Switch_May_Be_Passed_To_The_Compiler :=
5228               not Has_Global_Compilation_Switches;
5229             Scan_Make_Arg (Root_Environment, Switch, And_Save => False);
5230 
5231             return Gnatmake_Switch_Found
5232               or else Switch_May_Be_Passed_To_The_Compiler;
5233          else
5234             Add_Switch (Switch, Compiler, And_Save => False);
5235             return True;
5236          end if;
5237       end Add_Global_Switches;
5238 
5239       procedure Do_Compute_Builder_Switches
5240       is new Makeutl.Compute_Builder_Switches (Add_Global_Switches);
5241 
5242    --  Start of processing for Compute_Switches_For_Main
5243 
5244    begin
5245       if Main_Project /= No_Project then
5246          declare
5247             Main_Source_File_Name : constant String :=
5248                                       Get_Name_String (Main_Source_File);
5249 
5250             Main_Unit_File_Name   : constant String :=
5251               Prj.Env.File_Name_Of_Library_Unit_Body
5252                 (Name              => Main_Source_File_Name,
5253                  Project           => Main_Project,
5254                  In_Tree           => Project_Tree,
5255                  Main_Project_Only => not Unique_Compile);
5256 
5257             The_Packages : constant Package_Id := Main_Project.Decl.Packages;
5258 
5259             Binder_Package : constant Prj.Package_Id :=
5260                                Prj.Util.Value_Of
5261                                  (Name        => Name_Binder,
5262                                   In_Packages => The_Packages,
5263                                   Shared      => Project_Tree.Shared);
5264 
5265             Linker_Package : constant Prj.Package_Id :=
5266                                Prj.Util.Value_Of
5267                                  (Name        => Name_Linker,
5268                                   In_Packages => The_Packages,
5269                                   Shared      => Project_Tree.Shared);
5270 
5271          begin
5272             --  We fail if we cannot find the main source file
5273 
5274             if Main_Unit_File_Name = "" then
5275                Make_Failed ('"' & Main_Source_File_Name
5276                             & """ is not a unit of project "
5277                             & Project_File_Name.all & ".");
5278             end if;
5279 
5280             --  Remove any directory information from the main source file
5281             --  file name.
5282 
5283             declare
5284                Pos : Natural := Main_Unit_File_Name'Last;
5285 
5286             begin
5287                loop
5288                   exit when Pos < Main_Unit_File_Name'First
5289                     or else Main_Unit_File_Name (Pos) = Directory_Separator;
5290                   Pos := Pos - 1;
5291                end loop;
5292 
5293                Name_Len := Main_Unit_File_Name'Last - Pos;
5294 
5295                Name_Buffer (1 .. Name_Len) :=
5296                  Main_Unit_File_Name (Pos + 1 .. Main_Unit_File_Name'Last);
5297 
5298                Main_Source_File := Name_Find;
5299 
5300                --  We only output the main source file if there is only one
5301 
5302                if Verbose_Mode and then Osint.Number_Of_Files = 1 then
5303                   Write_Str ("Main source file: """);
5304                   Write_Str (Main_Unit_File_Name
5305                              (Pos + 1 .. Main_Unit_File_Name'Last));
5306                   Write_Line (""".");
5307                end if;
5308             end;
5309 
5310             if Compute_Builder then
5311                Do_Compute_Builder_Switches
5312                  (Project_Tree     => Project_Tree,
5313                   Env              => Root_Environment,
5314                   Main_Project     => Main_Project,
5315                   Only_For_Lang    => Name_Ada);
5316 
5317                Resolve_Relative_Names_In_Switches
5318                  (Current_Work_Dir => Current_Work_Dir);
5319 
5320                --  Record current last switch index for tables Binder_Switches
5321                --  and Linker_Switches, so that these tables may be reset
5322                --  before each main, before adding switches from the project
5323                --  file and from the command line.
5324 
5325                Last_Binder_Switch := Binder_Switches.Last;
5326                Last_Linker_Switch := Linker_Switches.Last;
5327 
5328             else
5329                --  Reset the tables Binder_Switches and Linker_Switches
5330 
5331                Binder_Switches.Set_Last (Last_Binder_Switch);
5332                Linker_Switches.Set_Last (Last_Linker_Switch);
5333             end if;
5334 
5335             --  We now deal with the binder and linker switches. If no project
5336             --  file is used, there is nothing to do because the binder and
5337             --  linker switches are the same for all mains.
5338 
5339             --  Add binder switches from the project file for the first main
5340 
5341             if Do_Bind_Step and then Binder_Package /= No_Package then
5342                if Verbose_Mode then
5343                   Write_Str ("Adding binder switches for """);
5344                   Write_Str (Main_Unit_File_Name);
5345                   Write_Line (""".");
5346                end if;
5347 
5348                Add_Switches
5349                  (Env               => Root_Environment,
5350                   File_Name         => Main_Unit_File_Name,
5351                   The_Package       => Binder_Package,
5352                   Program           => Binder);
5353             end if;
5354 
5355             --  Add linker switches from the project file for the first main
5356 
5357             if Do_Link_Step and then Linker_Package /= No_Package then
5358                if Verbose_Mode then
5359                   Write_Str ("Adding linker switches for""");
5360                   Write_Str (Main_Unit_File_Name);
5361                   Write_Line (""".");
5362                end if;
5363 
5364                Add_Switches
5365                  (Env               => Root_Environment,
5366                   File_Name         => Main_Unit_File_Name,
5367                   The_Package       => Linker_Package,
5368                   Program           => Linker);
5369             end if;
5370 
5371             --  As we are using a project file, for relative paths we add the
5372             --  current working directory for any relative path on the command
5373             --  line and the project directory, for any relative path in the
5374             --  project file.
5375 
5376             declare
5377                Dir_Path : constant String :=
5378                  Get_Name_String (Main_Project.Directory.Display_Name);
5379 
5380             begin
5381                for J in Last_Binder_Switch + 1 .. Binder_Switches.Last loop
5382                   Ensure_Absolute_Path
5383                     (Binder_Switches.Table (J),
5384                      Do_Fail => Make_Failed'Access,
5385                      Parent  => Dir_Path, For_Gnatbind => True);
5386                end loop;
5387 
5388                for J in Last_Linker_Switch + 1 .. Linker_Switches.Last loop
5389                   Ensure_Absolute_Path
5390                     (Linker_Switches.Table (J),
5391                      Parent  => Dir_Path,
5392                      Do_Fail => Make_Failed'Access);
5393                end loop;
5394             end;
5395          end;
5396 
5397       else
5398          if not Compute_Builder then
5399 
5400             --  Reset the tables Binder_Switches and Linker_Switches
5401 
5402             Binder_Switches.Set_Last (Last_Binder_Switch);
5403             Linker_Switches.Set_Last (Last_Linker_Switch);
5404          end if;
5405       end if;
5406 
5407       Check_Steps;
5408 
5409       if Compute_Builder then
5410          Display_Commands (not Quiet_Output);
5411       end if;
5412 
5413       --  We now put in the Binder_Switches and Linker_Switches tables, the
5414       --  binder and linker switches of the command line that have been put in
5415       --  the Saved_ tables. If a project file was used, then the command line
5416       --  switches will follow the project file switches.
5417 
5418       for J in 1 .. Saved_Binder_Switches.Last loop
5419          Add_Switch
5420            (Saved_Binder_Switches.Table (J),
5421             Binder,
5422             And_Save => False);
5423       end loop;
5424 
5425       for J in 1 .. Saved_Linker_Switches.Last loop
5426          Add_Switch
5427            (Saved_Linker_Switches.Table (J),
5428             Linker,
5429             And_Save => False);
5430       end loop;
5431    end Compute_Switches_For_Main;
5432 
5433    --------------
5434    -- Gnatmake --
5435    --------------
5436 
5437    procedure Gnatmake is
5438       Main_Source_File : File_Name_Type;
5439       --  The source file containing the main compilation unit
5440 
5441       Total_Compilation_Failures : Natural := 0;
5442 
5443       Main_ALI_File : File_Name_Type;
5444       --  The ali file corresponding to Main_Source_File
5445 
5446       Executable : File_Name_Type := No_File;
5447       --  The file name of an executable
5448 
5449       Non_Std_Executable : Boolean := False;
5450       --  Non_Std_Executable is set to True when there is a possibility that
5451       --  the linker will not choose the correct executable file name.
5452 
5453       Current_Work_Dir : constant String_Access :=
5454                                     new String'(Get_Current_Dir);
5455       --  The current working directory, used to modify some relative path
5456       --  switches on the command line when a project file is used.
5457 
5458       Current_Main_Index : Int := 0;
5459       --  If not zero, the index of the current main unit in its source file
5460 
5461       Is_First_Main : Boolean;
5462       --  Whether we are processing the first main
5463 
5464       Stand_Alone_Libraries : Boolean := False;
5465       --  Set to True when there are Stand-Alone Libraries, so that gnatbind
5466       --  is invoked with the -F switch to force checking of elaboration flags.
5467 
5468       Project_Node_Tree : Project_Node_Tree_Ref;
5469 
5470       Stop_Compile : Boolean;
5471 
5472       Discard : Boolean;
5473       pragma Warnings (Off, Discard);
5474 
5475       procedure Check_Mains;
5476       --  Check that the main subprograms do exist and that they all
5477       --  belong to the same project file.
5478 
5479       -----------------
5480       -- Check_Mains --
5481       -----------------
5482 
5483       procedure Check_Mains is
5484          Real_Main_Project : Project_Id := No_Project;
5485          Info              : Main_Info;
5486          Proj              : Project_Id;
5487 
5488       begin
5489          if Mains.Number_Of_Mains (Project_Tree) = 0
5490            and then not Unique_Compile
5491          then
5492             Mains.Fill_From_Project (Main_Project, Project_Tree);
5493          end if;
5494 
5495          Mains.Complete_Mains
5496            (Root_Environment.Flags, Main_Project, Project_Tree);
5497 
5498          --  If we have multiple mains on the command line, they need not
5499          --  belong to the root project, but they must all belong to the same
5500          --  project.
5501 
5502          if not Unique_Compile then
5503             Mains.Reset;
5504             loop
5505                Info := Mains.Next_Main;
5506                exit when Info = No_Main_Info;
5507 
5508                Proj := Ultimate_Extending_Project_Of (Info.Project);
5509 
5510                if Real_Main_Project = No_Project then
5511                   Real_Main_Project := Proj;
5512                elsif Real_Main_Project /= Proj then
5513                   Make_Failed
5514                     ("""" & Get_Name_String (Info.File) &
5515                      """ is not a source of project " &
5516                      Get_Name_String (Real_Main_Project.Name));
5517                end if;
5518             end loop;
5519 
5520             if Real_Main_Project /= No_Project then
5521                Main_Project := Real_Main_Project;
5522             end if;
5523 
5524             Debug_Output ("After checking mains, main project is",
5525                           Main_Project.Name);
5526 
5527          else
5528             --  For all mains on the command line, make sure they were in
5529             --  osint. In particular, if the user has specified a multi-unit
5530             --  source file, the call to Complete_Mains will have expanded
5531             --  the list of mains to all its units, and we must now put them
5532             --  back on the command line.
5533             --  ??? This will not be necessary when gnatmake shares the same
5534             --  queue as gprbuild and processes the file directly on the queue.
5535 
5536             Mains.Reset;
5537             loop
5538                Info := Mains.Next_Main;
5539                exit when Info = No_Main_Info;
5540 
5541                if Info.Index /= 0 then
5542                   Debug_Output ("Add to command line index="
5543                                 & Info.Index'Img, Name_Id (Info.File));
5544                   Osint.Add_File (Get_Name_String (Info.File), Info.Index);
5545                end if;
5546             end loop;
5547          end if;
5548       end Check_Mains;
5549 
5550    --  Start of processing for Gnatmake
5551 
5552    --  This body is very long, should be broken down???
5553 
5554    begin
5555       Install_Int_Handler (Sigint_Intercepted'Access);
5556 
5557       Do_Compile_Step := True;
5558       Do_Bind_Step    := True;
5559       Do_Link_Step    := True;
5560 
5561       Obsoleted.Reset;
5562 
5563       Make.Initialize (Project_Node_Tree, Root_Environment);
5564 
5565       Bind_Shared := No_Shared_Switch'Access;
5566       Link_With_Shared_Libgcc := No_Shared_Libgcc_Switch'Access;
5567 
5568       Failed_Links.Set_Last (0);
5569       Successful_Links.Set_Last (0);
5570 
5571       --  Special case when switch -B was specified
5572 
5573       if Build_Bind_And_Link_Full_Project then
5574 
5575          --  When switch -B is specified, there must be a project file
5576 
5577          if Main_Project = No_Project then
5578             Make_Failed ("-B cannot be used without a project file");
5579 
5580          --  No main program may be specified on the command line
5581 
5582          elsif Osint.Number_Of_Files /= 0 then
5583             Make_Failed
5584               ("-B cannot be used with a main specified on the command line");
5585 
5586          --  And the project file cannot be a library project file
5587 
5588          elsif Main_Project.Library then
5589             Make_Failed ("-B cannot be used for a library project file");
5590 
5591          else
5592             No_Main_Subprogram := True;
5593             Insert_Project_Sources
5594               (The_Project  => Main_Project,
5595                All_Projects => Unique_Compile_All_Projects,
5596                Into_Q       => False);
5597 
5598             --  If there are no sources to compile, we fail
5599 
5600             if Osint.Number_Of_Files = 0 then
5601                Make_Failed ("no sources to compile");
5602             end if;
5603 
5604             --  Specify -n for gnatbind and add the ALI files of all the
5605             --  sources, except the one which is a fake main subprogram: this
5606             --  is the one for the binder generated file and it will be
5607             --  transmitted to gnatlink. These sources are those that are in
5608             --  the queue.
5609 
5610             Add_Switch ("-n", Binder, And_Save => True);
5611 
5612             for J in 1 .. Queue.Size loop
5613                Add_Switch
5614                  (Get_Name_String (Lib_File_Name (Queue.Element (J))),
5615                   Binder, And_Save => True);
5616             end loop;
5617          end if;
5618 
5619       elsif Main_Index /= 0 and then Osint.Number_Of_Files > 1 then
5620          Make_Failed ("cannot specify several mains with a multi-unit index");
5621 
5622       elsif Main_Project /= No_Project then
5623 
5624          --  If the main project file is a library project file, main(s) cannot
5625          --  be specified on the command line.
5626 
5627          if Osint.Number_Of_Files /= 0 then
5628             if Main_Project.Library
5629               and then not Unique_Compile
5630               and then ((not Make_Steps) or else Bind_Only or else Link_Only)
5631             then
5632                Make_Failed
5633                  ("cannot specify a main program "
5634                   & "on the command line for a library project file");
5635             end if;
5636 
5637          --  If no mains have been specified on the command line, and we are
5638          --  using a project file, we either find the main(s) in attribute Main
5639          --  of the main project, or we put all the sources of the project file
5640          --  as mains.
5641 
5642          else
5643             if Main_Index /= 0 then
5644                Make_Failed ("cannot specify a multi-unit index but no main "
5645                             & "on the command line");
5646             end if;
5647 
5648             declare
5649                Value : String_List_Id := Main_Project.Mains;
5650 
5651             begin
5652                --  The attribute Main is an empty list or not specified, or
5653                --  else gnatmake was invoked with the switch "-u".
5654 
5655                if Value = Prj.Nil_String or else Unique_Compile then
5656                   if not Make_Steps
5657                     or Compile_Only
5658                     or not Main_Project.Library
5659                   then
5660                      --  First make sure that the binder and the linker will
5661                      --  not be invoked.
5662 
5663                      Do_Bind_Step := False;
5664                      Do_Link_Step := False;
5665 
5666                      --  Put all the sources in the queue
5667 
5668                      No_Main_Subprogram := True;
5669                      Insert_Project_Sources
5670                        (The_Project  => Main_Project,
5671                         All_Projects => Unique_Compile_All_Projects,
5672                         Into_Q       => False);
5673 
5674                      --  If no sources to compile, then there is nothing to do
5675 
5676                      if Osint.Number_Of_Files = 0 then
5677                         if not Quiet_Output then
5678                            Osint.Write_Program_Name;
5679                            Write_Line (": no sources to compile");
5680                         end if;
5681 
5682                         Finish_Program (Project_Tree, E_Success);
5683                      end if;
5684                   end if;
5685 
5686                else
5687                   --  The attribute Main is not an empty list. Put all the main
5688                   --  subprograms in the list as if they were specified on the
5689                   --  command line. However, if attribute Languages includes a
5690                   --  language other than Ada, only include the Ada mains; if
5691                   --  there is no Ada main, compile all sources of the project.
5692 
5693                   declare
5694                      Languages : constant Variable_Value :=
5695                                    Prj.Util.Value_Of
5696                                      (Name_Languages,
5697                                       Main_Project.Decl.Attributes,
5698                                       Project_Tree.Shared);
5699 
5700                      Current : String_List_Id;
5701                      Element : String_Element;
5702 
5703                      Foreign_Language  : Boolean := False;
5704                      At_Least_One_Main : Boolean := False;
5705 
5706                   begin
5707                      --  First, determine if there is a foreign language in
5708                      --  attribute Languages.
5709 
5710                      if not Languages.Default then
5711                         Current := Languages.Values;
5712                         Look_For_Foreign :
5713                         while Current /= Nil_String loop
5714                            Element := Project_Tree.Shared.String_Elements.
5715                                         Table (Current);
5716                            Get_Name_String (Element.Value);
5717                            To_Lower (Name_Buffer (1 .. Name_Len));
5718 
5719                            if Name_Buffer (1 .. Name_Len) /= "ada" then
5720                               Foreign_Language := True;
5721                               exit Look_For_Foreign;
5722                            end if;
5723 
5724                            Current := Element.Next;
5725                         end loop Look_For_Foreign;
5726                      end if;
5727 
5728                      --  Then, find all mains, or if there is a foreign
5729                      --  language, all the Ada mains.
5730 
5731                      while Value /= Prj.Nil_String loop
5732                         --  To know if a main is an Ada main, get its project.
5733                         --  It should be the project specified on the command
5734                         --  line.
5735 
5736                         Get_Name_String
5737                           (Project_Tree.Shared.String_Elements.Table
5738                              (Value).Value);
5739 
5740                         declare
5741                            Main_Name : constant String :=
5742                                          Get_Name_String
5743                                            (Project_Tree.Shared.
5744                                              String_Elements.
5745                                                Table (Value).Value);
5746 
5747                            Proj : constant Project_Id :=
5748                                     Prj.Env.Project_Of
5749                                      (Main_Name, Main_Project, Project_Tree);
5750 
5751                         begin
5752                            if Proj = Main_Project then
5753                               At_Least_One_Main := True;
5754                               Osint.Add_File
5755                                 (Get_Name_String
5756                                    (Project_Tree.Shared.String_Elements.Table
5757                                       (Value).Value),
5758                                  Index =>
5759                                    Project_Tree.Shared.String_Elements.Table
5760                                      (Value).Index);
5761 
5762                            elsif not Foreign_Language then
5763                               Make_Failed
5764                                 ("""" & Main_Name &
5765                                  """ is not a source of project " &
5766                                  Get_Name_String (Main_Project.Display_Name));
5767                            end if;
5768                         end;
5769 
5770                         Value := Project_Tree.Shared.String_Elements.Table
5771                                    (Value).Next;
5772                      end loop;
5773 
5774                      --  If we did not get any main, it means that all mains
5775                      --  in attribute Mains are in a foreign language and -B
5776                      --  was not specified to gnatmake; so, we fail.
5777 
5778                      if not At_Least_One_Main then
5779                         Make_Failed
5780                           ("no Ada mains, use -B to build foreign main");
5781                      end if;
5782                   end;
5783 
5784                end if;
5785             end;
5786          end if;
5787 
5788          --  Check that each main on the command line is a source of a
5789          --  project file and, if there are several mains, each of them
5790          --  is a source of the same project file.
5791 
5792          Check_Mains;
5793       end if;
5794 
5795       if Verbose_Mode then
5796          Write_Eol;
5797          Display_Version ("GNATMAKE", "1992");
5798       end if;
5799 
5800       if Osint.Number_Of_Files = 0 then
5801          if Main_Project /= No_Project and then Main_Project.Library then
5802             if Do_Bind_Step and then Main_Project.Standalone_Library = No then
5803                Make_Failed ("only stand-alone libraries may be bound");
5804             end if;
5805 
5806             --  Add the default search directories to be able to find libgnat
5807 
5808             Osint.Add_Default_Search_Dirs;
5809 
5810             --  And bind and or link the library
5811 
5812             MLib.Prj.Build_Library
5813               (For_Project   => Main_Project,
5814                In_Tree       => Project_Tree,
5815                Gnatbind      => Gnatbind.all,
5816                Gnatbind_Path => Gnatbind_Path,
5817                Gcc           => Gcc.all,
5818                Gcc_Path      => Gcc_Path,
5819                Bind          => Bind_Only,
5820                Link          => Link_Only);
5821 
5822             Finish_Program (Project_Tree, E_Success);
5823 
5824          else
5825             --  Call Get_Target_Parameters to ensure that flags are properly
5826             --  set before calling Usage.
5827 
5828             Targparm.Get_Target_Parameters;
5829 
5830             --  Output usage information if no argument on the command line
5831 
5832             if Argument_Count = 0 then
5833                Usage;
5834             else
5835                Try_Help;
5836             end if;
5837 
5838             Finish_Program (Project_Tree, E_Success);
5839          end if;
5840       end if;
5841 
5842       --  Get the first executable.
5843       --  ??? This needs to be done early, because Osint.Next_Main_File also
5844       --  initializes the primary search directory, used below to initialize
5845       --  the "-I" parameter
5846 
5847       Main_Source_File := Next_Main_Source;  --  No directory information
5848 
5849       --  If -M was specified, behave as if -n was specified
5850 
5851       if List_Dependencies then
5852          Do_Not_Execute := True;
5853       end if;
5854 
5855       Add_Switch ("-I-", Compiler, And_Save => True);
5856 
5857       if Main_Project = No_Project then
5858          if Look_In_Primary_Dir then
5859             Add_Switch
5860               ("-I" &
5861                Normalize_Directory_Name
5862                  (Get_Primary_Src_Search_Directory.all).all,
5863                   Compiler,
5864                   Append_Switch => False,
5865                   And_Save      => False);
5866 
5867          end if;
5868 
5869       else
5870          --  If we use a project file, we have already checked that a main
5871          --  specified on the command line with directory information has the
5872          --  path name corresponding to a correct source in the project tree.
5873          --  So, we don't need the directory information to be taken into
5874          --  account by Find_File, and in fact it may lead to take the wrong
5875          --  sources for other compilation units, when there are extending
5876          --  projects.
5877 
5878          Look_In_Primary_Dir := False;
5879       end if;
5880 
5881       --  If the user wants a program without a main subprogram, add the
5882       --  appropriate switch to the binder.
5883 
5884       if No_Main_Subprogram then
5885          Add_Switch ("-z", Binder, And_Save => True);
5886       end if;
5887 
5888       if Main_Project /= No_Project then
5889 
5890          if Main_Project.Object_Directory /= No_Path_Information then
5891 
5892             --  Change current directory to object directory of main project
5893 
5894             Project_Of_Current_Object_Directory := No_Project;
5895             Change_To_Object_Directory (Main_Project);
5896          end if;
5897 
5898          --  Source file lookups should be cached for efficiency. Source files
5899          --  are not supposed to change.
5900 
5901          Osint.Source_File_Data (Cache => True);
5902 
5903          Queue_Library_Project_Sources;
5904       end if;
5905 
5906       --  The combination of -f -u and one or several mains on the command line
5907       --  implies -a.
5908 
5909       if Force_Compilations
5910         and then Unique_Compile
5911         and then not Unique_Compile_All_Projects
5912         and then Main_On_Command_Line
5913       then
5914          Must_Compile := True;
5915       end if;
5916 
5917       if Main_Project /= No_Project
5918         and then not Must_Compile
5919         and then Main_Project.Externally_Built
5920       then
5921          Make_Failed
5922            ("nothing to do for a main project that is externally built");
5923       end if;
5924 
5925       --  If no project file is used, we just put the gcc switches
5926       --  from the command line in the Gcc_Switches table.
5927 
5928       if Main_Project = No_Project then
5929          for J in 1 .. Saved_Gcc_Switches.Last loop
5930             Add_Switch
5931               (Saved_Gcc_Switches.Table (J), Compiler, And_Save => False);
5932          end loop;
5933 
5934       else
5935          --  If there is a project, put the command line gcc switches in the
5936          --  variable The_Saved_Gcc_Switches. They are going to be used later
5937          --  in procedure Compile_Sources.
5938 
5939          The_Saved_Gcc_Switches :=
5940            new Argument_List (1 .. Saved_Gcc_Switches.Last + 1);
5941 
5942          for J in 1 .. Saved_Gcc_Switches.Last loop
5943             The_Saved_Gcc_Switches (J) := Saved_Gcc_Switches.Table (J);
5944          end loop;
5945 
5946          --  We never use gnat.adc when a project file is used
5947 
5948          The_Saved_Gcc_Switches (The_Saved_Gcc_Switches'Last) := No_gnat_adc;
5949       end if;
5950 
5951       --  If there was a --GCC, --GNATBIND or --GNATLINK switch on the command
5952       --  line, then we have to use it, even if there was another switch in
5953       --  the project file.
5954 
5955       if Saved_Gcc /= null then
5956          Gcc := Saved_Gcc;
5957       end if;
5958 
5959       if Saved_Gnatbind /= null then
5960          Gnatbind := Saved_Gnatbind;
5961       end if;
5962 
5963       if Saved_Gnatlink /= null then
5964          Gnatlink := Saved_Gnatlink;
5965       end if;
5966 
5967       Bad_Compilation.Init;
5968 
5969       --  If project files are used, create the mapping of all the sources, so
5970       --  that the correct paths will be found. Otherwise, if there is a file
5971       --  which is not a source with the same name in a source directory this
5972       --  file may be incorrectly found.
5973 
5974       if Main_Project /= No_Project then
5975          Prj.Env.Create_Mapping (Project_Tree);
5976       end if;
5977 
5978       --  Here is where the make process is started
5979 
5980       Queue.Initialize
5981         (Main_Project /= No_Project and then One_Compilation_Per_Obj_Dir);
5982 
5983       Is_First_Main := True;
5984 
5985       Multiple_Main_Loop : for N_File in 1 .. Osint.Number_Of_Files loop
5986          if Current_File_Index /= No_Index then
5987             Main_Index := Current_File_Index;
5988          end if;
5989 
5990          Current_Main_Index := Main_Index;
5991 
5992          if Current_Main_Index = 0
5993            and then Unique_Compile
5994            and then Main_Project /= No_Project
5995          then
5996             --  If this is a multi-unit source, do not compile it as is (ie
5997             --  without specifying which unit to compile)
5998             --  Insert_Project_Sources has added each of the unit separately.
5999 
6000             declare
6001                Source : constant Prj.Source_Id := Find_Source
6002                  (In_Tree   => Project_Tree,
6003                   Project   => Main_Project,
6004                   Base_Name => Main_Source_File,
6005                   Index     => Current_Main_Index,
6006                   In_Imported_Only => True);
6007             begin
6008                if Source /= No_Source and then Source.Index /= 0 then
6009                   goto Next_Main;
6010                end if;
6011             end;
6012          end if;
6013 
6014          Compute_Switches_For_Main
6015            (Main_Source_File,
6016             Root_Environment,
6017             Compute_Builder  => Is_First_Main,
6018             Current_Work_Dir => Current_Work_Dir.all);
6019 
6020          if Is_First_Main then
6021 
6022             --  Put the default source dirs in the source path only now, so
6023             --  that we take the correct ones in the case where --RTS= is
6024             --  specified in the Builder switches.
6025 
6026             Osint.Add_Default_Search_Dirs;
6027 
6028             --  Get the target parameters, which are only needed for a couple
6029             --  of cases in gnatmake. Protect against an exception, such as the
6030             --  case of system.ads missing from the library, and fail
6031             --  gracefully.
6032 
6033             begin
6034                Targparm.Get_Target_Parameters;
6035             exception
6036                when Unrecoverable_Error =>
6037                   Make_Failed ("*** make failed.");
6038             end;
6039 
6040             Gcc_Path       := GNAT.OS_Lib.Locate_Exec_On_Path (Gcc.all);
6041             Gnatbind_Path  := GNAT.OS_Lib.Locate_Exec_On_Path (Gnatbind.all);
6042             Gnatlink_Path  := GNAT.OS_Lib.Locate_Exec_On_Path (Gnatlink.all);
6043 
6044             --  If we have specified -j switch both from the project file
6045             --  and on the command line, the one from the command line takes
6046             --  precedence.
6047 
6048             if Saved_Maximum_Processes = 0 then
6049                Saved_Maximum_Processes := Maximum_Processes;
6050             end if;
6051 
6052             if Debug.Debug_Flag_M then
6053                Write_Line ("Maximum number of simultaneous compilations =" &
6054                            Saved_Maximum_Processes'Img);
6055             end if;
6056 
6057             --  Allocate as many temporary mapping file names as the maximum
6058             --  number of compilations processed, for each possible project.
6059 
6060             declare
6061                Data : Project_Compilation_Access;
6062                Proj : Project_List;
6063 
6064             begin
6065                Proj := Project_Tree.Projects;
6066                while Proj /= null loop
6067                   Data :=
6068                     new Project_Compilation_Data'
6069                       (Mapping_File_Names        =>
6070                          new Temp_Path_Names (1 .. Saved_Maximum_Processes),
6071                        Last_Mapping_File_Names   => 0,
6072                        Free_Mapping_File_Indexes =>
6073                          new Free_File_Indexes (1 .. Saved_Maximum_Processes),
6074                        Last_Free_Indexes         => 0);
6075 
6076                   Project_Compilation_Htable.Set
6077                     (Project_Compilation, Proj.Project, Data);
6078                   Proj := Proj.Next;
6079                end loop;
6080 
6081                Data :=
6082                  new Project_Compilation_Data'
6083                    (Mapping_File_Names        =>
6084                       new Temp_Path_Names (1 .. Saved_Maximum_Processes),
6085                     Last_Mapping_File_Names   => 0,
6086                     Free_Mapping_File_Indexes =>
6087                       new Free_File_Indexes (1 .. Saved_Maximum_Processes),
6088                     Last_Free_Indexes         => 0);
6089 
6090                Project_Compilation_Htable.Set
6091                  (Project_Compilation, No_Project, Data);
6092             end;
6093 
6094             Is_First_Main := False;
6095          end if;
6096 
6097          Executable_Obsolete := False;
6098 
6099          Compute_Executable
6100            (Main_Source_File   => Main_Source_File,
6101             Executable         => Executable,
6102             Non_Std_Executable => Non_Std_Executable);
6103 
6104          if Do_Compile_Step then
6105             Compilation_Phase
6106               (Main_Source_File           => Main_Source_File,
6107                Current_Main_Index         => Current_Main_Index,
6108                Total_Compilation_Failures => Total_Compilation_Failures,
6109                Stand_Alone_Libraries      => Stand_Alone_Libraries,
6110                Executable                 => Executable,
6111                Is_Last_Main               => N_File = Osint.Number_Of_Files,
6112                Stop_Compile               => Stop_Compile);
6113 
6114             if Stop_Compile then
6115                if Total_Compilation_Failures /= 0 then
6116                   if Keep_Going then
6117                      goto Next_Main;
6118 
6119                   else
6120                      List_Bad_Compilations;
6121                      Report_Compilation_Failed;
6122                   end if;
6123 
6124                elsif Osint.Number_Of_Files = 1 then
6125                   exit Multiple_Main_Loop;
6126                else
6127                   goto Next_Main;
6128                end if;
6129             end if;
6130          end if;
6131 
6132          --  For binding and linking, we need to be in the object directory of
6133          --  the main project.
6134 
6135          if Main_Project /= No_Project then
6136             Change_To_Object_Directory (Main_Project);
6137          end if;
6138 
6139          --  If we are here, it means that we need to rebuilt the current main,
6140          --  so we set Executable_Obsolete to True to make sure that subsequent
6141          --  mains will be rebuilt.
6142 
6143          Main_ALI_In_Place_Mode_Step : declare
6144             ALI_File : File_Name_Type;
6145             Src_File : File_Name_Type;
6146 
6147          begin
6148             Src_File      := Strip_Directory (Main_Source_File);
6149             ALI_File      := Lib_File_Name (Src_File, Current_Main_Index);
6150             Main_ALI_File := Full_Lib_File_Name (ALI_File);
6151 
6152             --  When In_Place_Mode, the library file can be located in the
6153             --  Main_Source_File directory which may not be present in the
6154             --  library path. If it is not present then use the corresponding
6155             --  library file name.
6156 
6157             if Main_ALI_File = No_File and then In_Place_Mode then
6158                Get_Name_String (Get_Directory (Full_Source_Name (Src_File)));
6159                Get_Name_String_And_Append (ALI_File);
6160                Main_ALI_File := Name_Find;
6161                Main_ALI_File := Full_Lib_File_Name (Main_ALI_File);
6162             end if;
6163 
6164             if Main_ALI_File = No_File then
6165                Make_Failed ("could not find the main ALI file");
6166             end if;
6167          end Main_ALI_In_Place_Mode_Step;
6168 
6169          if Do_Bind_Step then
6170             Binding_Phase
6171               (Stand_Alone_Libraries => Stand_Alone_Libraries,
6172                Main_ALI_File         => Main_ALI_File);
6173          end if;
6174 
6175          if Do_Link_Step then
6176             Linking_Phase
6177               (Non_Std_Executable => Non_Std_Executable,
6178                Executable         => Executable,
6179                Main_ALI_File      => Main_ALI_File);
6180          end if;
6181 
6182          --  We go to here when we skip the bind and link steps
6183 
6184          <<Next_Main>>
6185 
6186          Queue.Remove_Marks;
6187 
6188          if N_File < Osint.Number_Of_Files then
6189             Main_Source_File := Next_Main_Source;  --  No directory information
6190          end if;
6191       end loop Multiple_Main_Loop;
6192 
6193       if CodePeer_Mode then
6194          declare
6195             Success : Boolean := False;
6196          begin
6197             Globalize (Success);
6198 
6199             if not Success then
6200                Set_Standard_Error;
6201                Write_Str ("*** globalize failed.");
6202 
6203                if Commands_To_Stdout then
6204                   Set_Standard_Output;
6205                end if;
6206             end if;
6207          end;
6208       end if;
6209 
6210       if Failed_Links.Last > 0 then
6211          for Index in 1 .. Successful_Links.Last loop
6212             Write_Str ("Linking of """);
6213             Write_Str (Get_Name_String (Successful_Links.Table (Index)));
6214             Write_Line (""" succeeded.");
6215          end loop;
6216 
6217          Set_Standard_Error;
6218 
6219          for Index in 1 .. Failed_Links.Last loop
6220             Write_Str ("Linking of """);
6221             Write_Str (Get_Name_String (Failed_Links.Table (Index)));
6222             Write_Line (""" failed.");
6223          end loop;
6224 
6225          if Commands_To_Stdout then
6226             Set_Standard_Output;
6227          end if;
6228 
6229          if Total_Compilation_Failures = 0 then
6230             Report_Compilation_Failed;
6231          end if;
6232       end if;
6233 
6234       if Total_Compilation_Failures /= 0 then
6235          List_Bad_Compilations;
6236          Report_Compilation_Failed;
6237       end if;
6238 
6239       Finish_Program (Project_Tree, E_Success);
6240 
6241    exception
6242       when X : others =>
6243          Set_Standard_Error;
6244          Write_Line (Exception_Information (X));
6245          Make_Failed ("INTERNAL ERROR. Please report.");
6246    end Gnatmake;
6247 
6248    ----------
6249    -- Hash --
6250    ----------
6251 
6252    function Hash (F : File_Name_Type) return Header_Num is
6253    begin
6254       return Header_Num (1 + F mod Max_Header);
6255    end Hash;
6256 
6257    --------------------
6258    -- In_Ada_Lib_Dir --
6259    --------------------
6260 
6261    function In_Ada_Lib_Dir (File : File_Name_Type) return Boolean is
6262       D : constant File_Name_Type := Get_Directory (File);
6263       B : constant Byte           := Get_Name_Table_Byte (D);
6264    begin
6265       return (B and Ada_Lib_Dir) /= 0;
6266    end In_Ada_Lib_Dir;
6267 
6268    -----------------------
6269    -- Init_Mapping_File --
6270    -----------------------
6271 
6272    procedure Init_Mapping_File
6273      (Project    : Project_Id;
6274       Data       : in out Project_Compilation_Data;
6275       File_Index : in out Natural)
6276    is
6277       FD     : File_Descriptor;
6278       Status : Boolean;
6279       --  For call to Close
6280 
6281    begin
6282       --  Increase the index of the last mapping file for this project
6283 
6284       Data.Last_Mapping_File_Names := Data.Last_Mapping_File_Names + 1;
6285 
6286       --  If there is a project file, call Create_Mapping_File with
6287       --  the project id.
6288 
6289       if Project /= No_Project then
6290          Prj.Env.Create_Mapping_File
6291            (Project,
6292             In_Tree  => Project_Tree,
6293             Language => Name_Ada,
6294             Name     => Data.Mapping_File_Names
6295                           (Data.Last_Mapping_File_Names));
6296 
6297       --  Otherwise, just create an empty file
6298 
6299       else
6300          Tempdir.Create_Temp_File
6301            (FD, Data.Mapping_File_Names (Data.Last_Mapping_File_Names));
6302 
6303          if FD = Invalid_FD then
6304             Make_Failed ("disk full");
6305          else
6306             Record_Temp_File
6307               (Project_Tree.Shared,
6308                Data.Mapping_File_Names (Data.Last_Mapping_File_Names));
6309          end if;
6310 
6311          Close (FD, Status);
6312 
6313          if not Status then
6314             Make_Failed ("disk full");
6315          end if;
6316       end if;
6317 
6318       --  And return the index of the newly created file
6319 
6320       File_Index := Data.Last_Mapping_File_Names;
6321    end Init_Mapping_File;
6322 
6323    ----------------
6324    -- Initialize --
6325    ----------------
6326 
6327    procedure Initialize
6328       (Project_Node_Tree : out Project_Node_Tree_Ref;
6329        Env               : out Prj.Tree.Environment)
6330    is
6331       procedure Check_Version_And_Help is
6332         new Check_Version_And_Help_G (Makeusg);
6333 
6334    --  Start of processing for Initialize
6335 
6336    begin
6337       --  Prepare the project's tree, since this is used to hold external
6338       --  references, project path and other attributes that can be impacted by
6339       --  the command line switches
6340 
6341       Prj.Tree.Initialize (Env, Gnatmake_Flags);
6342 
6343       Project_Node_Tree := new Project_Node_Tree_Data;
6344       Prj.Tree.Initialize (Project_Node_Tree);
6345 
6346       --  Override default initialization of Check_Object_Consistency since
6347       --  this is normally False for GNATBIND, but is True for GNATMAKE since
6348       --  we do not need to check source consistency again once GNATMAKE has
6349       --  looked at the sources to check.
6350 
6351       Check_Object_Consistency := True;
6352 
6353       --  Package initializations (the order of calls is important here)
6354 
6355       Output.Set_Standard_Error;
6356 
6357       Gcc_Switches.Init;
6358       Binder_Switches.Init;
6359       Linker_Switches.Init;
6360 
6361       Csets.Initialize;
6362       Snames.Initialize;
6363       Stringt.Initialize;
6364 
6365       Prj.Initialize (Project_Tree);
6366 
6367       Dependencies.Init;
6368 
6369       RTS_Specified := null;
6370       N_M_Switch := 0;
6371 
6372       Mains.Delete;
6373 
6374       --  Add the directory where gnatmake is invoked in front of the path,
6375       --  if gnatmake is invoked from a bin directory or with directory
6376       --  information.
6377 
6378       declare
6379          Prefix  : constant String := Executable_Prefix_Path;
6380          Command : constant String := Command_Name;
6381 
6382       begin
6383          if Prefix'Length > 0 then
6384             declare
6385                PATH : constant String :=
6386                         Prefix & Directory_Separator & "bin" & Path_Separator
6387                         & Getenv ("PATH").all;
6388             begin
6389                Setenv ("PATH", PATH);
6390             end;
6391 
6392          else
6393             for Index in reverse Command'Range loop
6394                if Command (Index) = Directory_Separator then
6395                   declare
6396                      Absolute_Dir : constant String :=
6397                                       Normalize_Pathname
6398                                         (Command (Command'First .. Index));
6399                      PATH         : constant String :=
6400                                       Absolute_Dir &
6401                                       Path_Separator &
6402                                       Getenv ("PATH").all;
6403                   begin
6404                      Setenv ("PATH", PATH);
6405                   end;
6406 
6407                   exit;
6408                end if;
6409             end loop;
6410          end if;
6411       end;
6412 
6413       --  Scan the switches and arguments
6414 
6415       --  First, scan to detect --version and/or --help
6416 
6417       Check_Version_And_Help ("GNATMAKE", "1995");
6418 
6419       --  Scan again the switch and arguments, now that we are sure that they
6420       --  do not include --version or --help.
6421 
6422       --  First, check for switch -P and, if found and gprbuild is available,
6423       --  silently invoke gprbuild, with switch --target if not on a native
6424       --  platform.
6425 
6426       declare
6427          Arg_Len       : Natural       := Argument_Count;
6428          Call_Gprbuild : Boolean       := False;
6429          Gprbuild      : String_Access := null;
6430          Pos           : Natural       := 0;
6431          Success       : Boolean;
6432          Target        : String_Access := null;
6433 
6434       begin
6435          Find_Program_Name;
6436 
6437          if Name_Len >= 8
6438            and then Name_Buffer (Name_Len - 7 .. Name_Len) = "gnatmake"
6439          then
6440             if Name_Len > 8 then
6441                Target  := new String'(Name_Buffer (1 .. Name_Len - 9));
6442                Arg_Len := Arg_Len + 1;
6443             end if;
6444 
6445             for J in 1 .. Argument_Count loop
6446                declare
6447                   Arg : constant String := Argument (J);
6448                begin
6449                   if Arg'Length >= 2
6450                     and then Arg (Arg'First .. Arg'First + 1) = "-P"
6451                   then
6452                      Call_Gprbuild := True;
6453                      exit;
6454                   end if;
6455                end;
6456             end loop;
6457 
6458             if Call_Gprbuild then
6459                Gprbuild := Locate_Exec_On_Path (Exec_Name => "gprbuild");
6460 
6461                if Gprbuild /= null then
6462                   declare
6463                      Args : Argument_List (1 .. Arg_Len);
6464                   begin
6465                      if Target /= null then
6466                         Args (1) := new String'("--target=" & Target.all);
6467                         Pos := 1;
6468                      end if;
6469 
6470                      for J in 1 .. Argument_Count loop
6471                         Pos := Pos + 1;
6472                         Args (Pos) := new String'(Argument (J));
6473                      end loop;
6474 
6475                      Spawn (Gprbuild.all, Args, Success);
6476 
6477                      Free (Gprbuild);
6478 
6479                      if Success then
6480                         Exit_Program (E_Success);
6481                      end if;
6482                   end;
6483                end if;
6484             end if;
6485          end if;
6486       end;
6487 
6488       Scan_Args : for Next_Arg in 1 .. Argument_Count loop
6489          Scan_Make_Arg (Env, Argument (Next_Arg), And_Save => True);
6490       end loop Scan_Args;
6491 
6492       if N_M_Switch > 0 and RTS_Specified = null then
6493          Process_Multilib (Env);
6494       end if;
6495 
6496       if Commands_To_Stdout then
6497          Set_Standard_Output;
6498       end if;
6499 
6500       if Usage_Requested then
6501          Usage;
6502       end if;
6503 
6504       --  Add the default project search directories now, after the directories
6505       --  that have been specified by switches -aP<dir>.
6506 
6507       Prj.Env.Initialize_Default_Project_Path
6508         (Env.Project_Path, Target_Name => Sdefault.Target_Name.all);
6509 
6510       --  Test for trailing -P switch
6511 
6512       if Project_File_Name_Present and then Project_File_Name = null then
6513          Make_Failed ("project file name missing after -P");
6514 
6515       --  Test for trailing -o switch
6516 
6517       elsif Output_File_Name_Present and then not Output_File_Name_Seen then
6518          Make_Failed ("output file name missing after -o");
6519 
6520       --  Test for trailing -D switch
6521 
6522       elsif Object_Directory_Present and then not Object_Directory_Seen then
6523          Make_Failed ("object directory missing after -D");
6524       end if;
6525 
6526       --  Test for simultaneity of -i and -D
6527 
6528       if Object_Directory_Path /= null and then In_Place_Mode then
6529          Make_Failed ("-i and -D cannot be used simultaneously");
6530       end if;
6531 
6532       --  If --subdirs= is specified, but not -P, this is equivalent to -D,
6533       --  except that the directory is created if it does not exist.
6534 
6535       if Prj.Subdirs /= null and then Project_File_Name = null then
6536          if Object_Directory_Path /= null then
6537             Make_Failed ("--subdirs and -D cannot be used simultaneously");
6538 
6539          elsif In_Place_Mode then
6540             Make_Failed ("--subdirs and -i cannot be used simultaneously");
6541 
6542          else
6543             if not Is_Directory (Prj.Subdirs.all) then
6544                begin
6545                   Ada.Directories.Create_Path (Prj.Subdirs.all);
6546                exception
6547                   when others =>
6548                      Make_Failed ("unable to create object directory " &
6549                                   Prj.Subdirs.all);
6550                end;
6551             end if;
6552 
6553             Object_Directory_Present := True;
6554 
6555             declare
6556                Argv : constant String (1 .. Prj.Subdirs'Length) :=
6557                         Prj.Subdirs.all;
6558             begin
6559                Scan_Make_Arg (Env, Argv, And_Save => False);
6560             end;
6561          end if;
6562       end if;
6563 
6564       --  Deal with -C= switch
6565 
6566       if Gnatmake_Mapping_File /= null then
6567 
6568          --  First, check compatibility with other switches
6569 
6570          if Project_File_Name /= null then
6571             Make_Failed ("-C= switch is not compatible with -P switch");
6572 
6573          elsif Saved_Maximum_Processes > 1 then
6574             Make_Failed ("-C= switch is not compatible with -jnnn switch");
6575          end if;
6576 
6577          Fmap.Initialize (Gnatmake_Mapping_File.all);
6578          Add_Switch
6579            ("-gnatem=" & Gnatmake_Mapping_File.all,
6580             Compiler,
6581             And_Save => True);
6582       end if;
6583 
6584       if Project_File_Name /= null then
6585 
6586          --  A project file was specified by a -P switch
6587 
6588          if Verbose_Mode then
6589             Write_Eol;
6590             Write_Str ("Parsing project file """);
6591             Write_Str (Project_File_Name.all);
6592             Write_Str (""".");
6593             Write_Eol;
6594          end if;
6595 
6596          --  Avoid looking in the current directory for ALI files
6597 
6598          --  Look_In_Primary_Dir := False;
6599 
6600          --  Set the project parsing verbosity to whatever was specified
6601          --  by a possible -vP switch.
6602 
6603          Prj.Pars.Set_Verbosity (To => Current_Verbosity);
6604 
6605          --  Parse the project file.
6606          --  If there is an error, Main_Project will still be No_Project.
6607 
6608          Prj.Pars.Parse
6609            (Project           => Main_Project,
6610             In_Tree           => Project_Tree,
6611             Project_File_Name => Project_File_Name.all,
6612             Packages_To_Check => Packages_To_Check_By_Gnatmake,
6613             Env               => Env,
6614             In_Node_Tree      => Project_Node_Tree);
6615 
6616          --  The parsing of project files may have changed the current output
6617 
6618          if Commands_To_Stdout then
6619             Set_Standard_Output;
6620          else
6621             Set_Standard_Error;
6622          end if;
6623 
6624          if Main_Project = No_Project then
6625             Make_Failed
6626               ("""" & Project_File_Name.all & """ processing failed");
6627          end if;
6628 
6629          if Main_Project.Qualifier = Aggregate then
6630             Make_Failed ("aggregate projects are not supported");
6631 
6632          elsif Aggregate_Libraries_In (Project_Tree) then
6633             Make_Failed ("aggregate library projects are not supported");
6634          end if;
6635 
6636          Create_Mapping_File := True;
6637 
6638          if Verbose_Mode then
6639             Write_Eol;
6640             Write_Str ("Parsing of project file """);
6641             Write_Str (Project_File_Name.all);
6642             Write_Str (""" is finished.");
6643             Write_Eol;
6644          end if;
6645 
6646          --  We add the source directories and the object directories to the
6647          --  search paths.
6648 
6649          --  ??? Why do we need these search directories, we already know the
6650          --  locations from parsing the project, except for the runtime which
6651          --  has its own directories anyway
6652 
6653          Add_Source_Directories (Main_Project, Project_Tree);
6654          Add_Object_Directories (Main_Project, Project_Tree);
6655 
6656          Recursive_Compute_Depth (Main_Project);
6657          Compute_All_Imported_Projects (Main_Project, Project_Tree);
6658 
6659       else
6660 
6661          Osint.Add_Default_Search_Dirs;
6662 
6663          --  Source file lookups should be cached for efficiency. Source files
6664          --  are not supposed to change. However, we do that now only if no
6665          --  project file is used; if a project file is used, we do it just
6666          --  after changing the directory to the object directory.
6667 
6668          Osint.Source_File_Data (Cache => True);
6669 
6670          --  Read gnat.adc file to initialize Fname.UF
6671 
6672          Fname.UF.Initialize;
6673 
6674          if Config_File then
6675             begin
6676                Fname.SF.Read_Source_File_Name_Pragmas;
6677 
6678             exception
6679                when Err : SFN_Scan.Syntax_Error_In_GNAT_ADC =>
6680                   Make_Failed (Exception_Message (Err));
6681             end;
6682          end if;
6683       end if;
6684 
6685       --  Make sure no project object directory is recorded
6686 
6687       Project_Of_Current_Object_Directory := No_Project;
6688 
6689       if Debug.Debug_Flag_N then
6690          Opt.Keep_Temporary_Files := True;
6691       end if;
6692    end Initialize;
6693 
6694    ----------------------------
6695    -- Insert_Project_Sources --
6696    ----------------------------
6697 
6698    procedure Insert_Project_Sources
6699      (The_Project  : Project_Id;
6700       All_Projects : Boolean;
6701       Into_Q       : Boolean)
6702    is
6703       Put_In_Q : Boolean := Into_Q;
6704       Unit     : Unit_Index;
6705       Sfile    : File_Name_Type;
6706       Sid      : Prj.Source_Id;
6707       Index    : Int;
6708       Project  : Project_Id;
6709 
6710    begin
6711       --  Loop through all the sources in the project files
6712 
6713       Unit := Units_Htable.Get_First (Project_Tree.Units_HT);
6714       while Unit /= null loop
6715          Sfile   := No_File;
6716          Sid     := No_Source;
6717          Index   := 0;
6718          Project := No_Project;
6719 
6720          --  If there is a source for the body, and the body has not been
6721          --  locally removed.
6722 
6723          if Unit.File_Names (Impl) /= null
6724            and then not Unit.File_Names (Impl).Locally_Removed
6725          then
6726             --  And it is a source for the specified project
6727 
6728             if All_Projects
6729               or else
6730                 Is_Extending (The_Project, Unit.File_Names (Impl).Project)
6731             then
6732                Project := Unit.File_Names (Impl).Project;
6733 
6734                --  If we don't have a spec, we cannot consider the source
6735                --  if it is a subunit.
6736 
6737                if Unit.File_Names (Spec) = null then
6738                   declare
6739                      Src_Ind : Source_File_Index;
6740 
6741                      --  Here we are cheating a little bit: we don't want to
6742                      --  use Sinput.L, because it depends on the GNAT tree
6743                      --  (Atree, Sinfo, ...). So, we pretend that it is a
6744                      --  project file, and we use Sinput.P.
6745 
6746                      --  Source_File_Is_Subunit is just scanning through the
6747                      --  file until it finds one of the reserved words
6748                      --  separate, procedure, function, generic or package.
6749                      --  Fortunately, these Ada reserved words are also
6750                      --  reserved for project files.
6751 
6752                   begin
6753                      Src_Ind := Sinput.P.Load_Project_File
6754                                   (Get_Name_String
6755                                    (Unit.File_Names (Impl).Path.Display_Name));
6756 
6757                      --  If it is a subunit, discard it
6758 
6759                      if Sinput.P.Source_File_Is_Subunit (Src_Ind) then
6760                         Sfile := No_File;
6761                         Index := 0;
6762                         Sid   := No_Source;
6763                      else
6764                         Sfile := Unit.File_Names (Impl).Display_File;
6765                         Index := Unit.File_Names (Impl).Index;
6766                         Sid   := Unit.File_Names (Impl);
6767                      end if;
6768                   end;
6769 
6770                else
6771                   Sfile := Unit.File_Names (Impl).Display_File;
6772                   Index := Unit.File_Names (Impl).Index;
6773                   Sid   := Unit.File_Names (Impl);
6774                end if;
6775             end if;
6776 
6777          elsif Unit.File_Names (Spec) /= null
6778            and then not Unit.File_Names (Spec).Locally_Removed
6779            and then
6780              (All_Projects
6781                or else
6782                  Is_Extending (The_Project, Unit.File_Names (Spec).Project))
6783          then
6784             --  If there is no source for the body, but there is one for the
6785             --  spec which has not been locally removed, then we take this one.
6786 
6787             Sfile := Unit.File_Names (Spec).Display_File;
6788             Index := Unit.File_Names (Spec).Index;
6789             Sid   := Unit.File_Names (Spec);
6790             Project := Unit.File_Names (Spec).Project;
6791          end if;
6792 
6793          --  For the first source inserted into the Q, we need to initialize
6794          --  the Q, but not for the subsequent sources.
6795 
6796          Queue.Initialize
6797                  (Main_Project /= No_Project and then
6798                   One_Compilation_Per_Obj_Dir);
6799 
6800          if Sfile /= No_File then
6801             Queue.Insert
6802               ((Format   => Format_Gnatmake,
6803                 File     => Sfile,
6804                 Project  => Project,
6805                 Unit     => No_Unit_Name,
6806                 Index    => Index,
6807                 Sid      => Sid));
6808          end if;
6809 
6810          if not Put_In_Q and then Sfile /= No_File then
6811 
6812             --  If Put_In_Q is False, we add the source as if it were specified
6813             --  on the command line, and we set Put_In_Q to True, so that the
6814             --  following sources will only be put in the queue. The source is
6815             --  already in the Q, but we need at least one fake main to call
6816             --  Compile_Sources.
6817 
6818             if Verbose_Mode then
6819                Write_Str ("Adding """);
6820                Write_Str (Get_Name_String (Sfile));
6821                Write_Line (""" as if on the command line");
6822             end if;
6823 
6824             Osint.Add_File (Get_Name_String (Sfile), Index);
6825             Put_In_Q := True;
6826          end if;
6827 
6828          Unit := Units_Htable.Get_Next (Project_Tree.Units_HT);
6829       end loop;
6830    end Insert_Project_Sources;
6831 
6832    ---------------------
6833    -- Is_In_Obsoleted --
6834    ---------------------
6835 
6836    function Is_In_Obsoleted (F : File_Name_Type) return Boolean is
6837    begin
6838       if F = No_File then
6839          return False;
6840 
6841       else
6842          declare
6843             Name  : constant String := Get_Name_String (F);
6844             First : Natural;
6845             F2    : File_Name_Type;
6846 
6847          begin
6848             First := Name'Last;
6849             while First > Name'First
6850               and then not Is_Directory_Separator (Name (First - 1))
6851             loop
6852                First := First - 1;
6853             end loop;
6854 
6855             if First /= Name'First then
6856                Name_Len := 0;
6857                Add_Str_To_Name_Buffer (Name (First .. Name'Last));
6858                F2 := Name_Find;
6859 
6860             else
6861                F2 := F;
6862             end if;
6863 
6864             return Obsoleted.Get (F2);
6865          end;
6866       end if;
6867    end Is_In_Obsoleted;
6868 
6869    ----------------------------
6870    -- Is_In_Object_Directory --
6871    ----------------------------
6872 
6873    function Is_In_Object_Directory
6874      (Source_File   : File_Name_Type;
6875       Full_Lib_File : File_Name_Type) return Boolean
6876    is
6877    begin
6878       --  There is something to check only when using project files. Otherwise,
6879       --  this function returns True (last line of the function).
6880 
6881       if Main_Project /= No_Project then
6882          declare
6883             Source_File_Name : constant String :=
6884                                  Get_Name_String (Source_File);
6885             Saved_Verbosity  : constant Verbosity := Current_Verbosity;
6886             Project          : Project_Id         := No_Project;
6887 
6888             Path_Name : Path_Name_Type := No_Path;
6889             pragma Warnings (Off, Path_Name);
6890 
6891          begin
6892             --  Call Get_Reference to know the ultimate extending project of
6893             --  the source. Call it with verbosity default to avoid verbose
6894             --  messages.
6895 
6896             Current_Verbosity := Default;
6897             Prj.Env.Get_Reference
6898               (Source_File_Name => Source_File_Name,
6899                Project          => Project,
6900                In_Tree          => Project_Tree,
6901                Path             => Path_Name);
6902             Current_Verbosity := Saved_Verbosity;
6903 
6904             --  If this source is in a project, check that the ALI file is in
6905             --  its object directory. If it is not, return False, so that the
6906             --  ALI file will not be skipped.
6907 
6908             if Project /= No_Project then
6909                declare
6910                   Object_Directory : constant String :=
6911                                        Normalize_Pathname
6912                                         (Get_Name_String
6913                                          (Project.
6914                                             Object_Directory.Display_Name));
6915 
6916                   Olast : Natural := Object_Directory'Last;
6917 
6918                   Lib_File_Directory : constant String :=
6919                                          Normalize_Pathname (Dir_Name
6920                                            (Get_Name_String (Full_Lib_File)));
6921 
6922                   Llast : Natural := Lib_File_Directory'Last;
6923 
6924                begin
6925                   --  For directories, Normalize_Pathname may or may not put
6926                   --  a directory separator at the end, depending on its input.
6927                   --  Remove any last directory separator before comparison.
6928                   --  Returns True only if the two directories are the same.
6929 
6930                   if Object_Directory (Olast) = Directory_Separator then
6931                      Olast := Olast - 1;
6932                   end if;
6933 
6934                   if Lib_File_Directory (Llast) = Directory_Separator then
6935                      Llast := Llast - 1;
6936                   end if;
6937 
6938                   return Object_Directory (Object_Directory'First .. Olast) =
6939                         Lib_File_Directory (Lib_File_Directory'First .. Llast);
6940                end;
6941             end if;
6942          end;
6943       end if;
6944 
6945       --  When the source is not in a project file, always return True
6946 
6947       return True;
6948    end Is_In_Object_Directory;
6949 
6950    ----------
6951    -- Link --
6952    ----------
6953 
6954    procedure Link
6955      (ALI_File : File_Name_Type;
6956       Args     : Argument_List;
6957       Success  : out Boolean)
6958    is
6959       Link_Args : Argument_List (1 .. Args'Length + 1);
6960 
6961    begin
6962       Get_Name_String (ALI_File);
6963       Link_Args (1) := new String'(Name_Buffer (1 .. Name_Len));
6964 
6965       Link_Args (2 .. Args'Length + 1) := Args;
6966 
6967       GNAT.OS_Lib.Normalize_Arguments (Link_Args);
6968 
6969       Display (Gnatlink.all, Link_Args);
6970 
6971       if Gnatlink_Path = null then
6972          Make_Failed ("error, unable to locate " & Gnatlink.all);
6973       end if;
6974 
6975       GNAT.OS_Lib.Spawn (Gnatlink_Path.all, Link_Args, Success);
6976    end Link;
6977 
6978    ---------------------------
6979    -- List_Bad_Compilations --
6980    ---------------------------
6981 
6982    procedure List_Bad_Compilations is
6983    begin
6984       if not No_Exit_Message then
6985          for J in Bad_Compilation.First .. Bad_Compilation.Last loop
6986             if Bad_Compilation.Table (J).File = No_File then
6987                null;
6988             elsif not Bad_Compilation.Table (J).Found then
6989                Inform (Bad_Compilation.Table (J).File, "not found");
6990             else
6991                Inform (Bad_Compilation.Table (J).File, "compilation error");
6992             end if;
6993          end loop;
6994       end if;
6995    end List_Bad_Compilations;
6996 
6997    -----------------
6998    -- List_Depend --
6999    -----------------
7000 
7001    procedure List_Depend is
7002       Lib_Name  : File_Name_Type;
7003       Obj_Name  : File_Name_Type;
7004       Src_Name  : File_Name_Type;
7005 
7006       Len       : Natural;
7007       Line_Pos  : Natural;
7008       Line_Size : constant := 77;
7009 
7010    begin
7011       Set_Standard_Output;
7012 
7013       for A in ALIs.First .. ALIs.Last loop
7014          Lib_Name := ALIs.Table (A).Afile;
7015 
7016          --  We have to provide the full library file name in In_Place_Mode
7017 
7018          if In_Place_Mode then
7019             Lib_Name := Full_Lib_File_Name (Lib_Name);
7020          end if;
7021 
7022          Obj_Name := Object_File_Name (Lib_Name);
7023          Write_Name (Obj_Name);
7024          Write_Str (" :");
7025 
7026          Get_Name_String (Obj_Name);
7027          Len := Name_Len;
7028          Line_Pos := Len + 2;
7029 
7030          for D in ALIs.Table (A).First_Sdep .. ALIs.Table (A).Last_Sdep loop
7031             Src_Name := Sdep.Table (D).Sfile;
7032 
7033             if Is_Internal_File_Name (Src_Name)
7034               and then not Check_Readonly_Files
7035             then
7036                null;
7037             else
7038                if not Quiet_Output then
7039                   Src_Name := Full_Source_Name (Src_Name);
7040                end if;
7041 
7042                Get_Name_String (Src_Name);
7043                Len := Name_Len;
7044 
7045                if Line_Pos + Len + 1 > Line_Size then
7046                   Write_Str (" \");
7047                   Write_Eol;
7048                   Line_Pos := 0;
7049                end if;
7050 
7051                Line_Pos := Line_Pos + Len + 1;
7052 
7053                Write_Str (" ");
7054                Write_Name (Src_Name);
7055             end if;
7056          end loop;
7057 
7058          Write_Eol;
7059       end loop;
7060 
7061       if not Commands_To_Stdout then
7062          Set_Standard_Error;
7063       end if;
7064    end List_Depend;
7065 
7066    -----------------
7067    -- Make_Failed --
7068    -----------------
7069 
7070    procedure Make_Failed (S : String) is
7071    begin
7072       Fail_Program (Project_Tree, S);
7073    end Make_Failed;
7074 
7075    --------------------
7076    -- Mark_Directory --
7077    --------------------
7078 
7079    procedure Mark_Directory
7080      (Dir             : String;
7081       Mark            : Lib_Mark_Type;
7082       On_Command_Line : Boolean)
7083    is
7084       N : Name_Id;
7085       B : Byte;
7086 
7087       function Base_Directory return String;
7088       --  If Dir comes from the command line, empty string (relative paths are
7089       --  resolved with respect to the current directory), else return the main
7090       --  project's directory.
7091 
7092       --------------------
7093       -- Base_Directory --
7094       --------------------
7095 
7096       function Base_Directory return String is
7097       begin
7098          if On_Command_Line then
7099             return "";
7100          else
7101             return Get_Name_String (Main_Project.Directory.Display_Name);
7102          end if;
7103       end Base_Directory;
7104 
7105       Real_Path : constant String := Normalize_Pathname (Dir, Base_Directory);
7106 
7107    --  Start of processing for Mark_Directory
7108 
7109    begin
7110       Name_Len := 0;
7111 
7112       if Real_Path'Length = 0 then
7113          Add_Str_To_Name_Buffer (Dir);
7114 
7115       else
7116          Add_Str_To_Name_Buffer (Real_Path);
7117       end if;
7118 
7119       --  Last character is supposed to be a directory separator
7120 
7121       if not Is_Directory_Separator (Name_Buffer (Name_Len)) then
7122          Add_Char_To_Name_Buffer (Directory_Separator);
7123       end if;
7124 
7125       --  Add flags to the already existing flags
7126 
7127       N := Name_Find;
7128       B := Get_Name_Table_Byte (N);
7129       Set_Name_Table_Byte (N, B or Mark);
7130    end Mark_Directory;
7131 
7132    ----------------------
7133    -- Process_Multilib --
7134    ----------------------
7135 
7136    procedure Process_Multilib (Env : in out Prj.Tree.Environment) is
7137       Output_FD         : File_Descriptor;
7138       Output_Name       : String_Access;
7139       Arg_Index         : Natural := 0;
7140       Success           : Boolean := False;
7141       Return_Code       : Integer := 0;
7142       Multilib_Gcc_Path : String_Access;
7143       Multilib_Gcc      : String_Access;
7144       N_Read            : Integer := 0;
7145       Line              : String (1 .. 1000);
7146       Args              : Argument_List (1 .. N_M_Switch + 1);
7147 
7148    begin
7149       pragma Assert (N_M_Switch > 0 and RTS_Specified = null);
7150 
7151       --  In case we detected a multilib switch and the user has not
7152       --  manually specified a specific RTS we emulate the following command:
7153       --  gnatmake $FLAGS --RTS=$(gcc -print-multi-directory $FLAGS)
7154 
7155       --  First select the flags which might have an impact on multilib
7156       --  processing. Note that this is an heuristic selection and it
7157       --  will need to be maintained over time. The condition has to
7158       --  be kept synchronized with N_M_Switch counting in Scan_Make_Arg.
7159 
7160       for Next_Arg in 1 .. Argument_Count loop
7161          declare
7162             Argv : constant String := Argument (Next_Arg);
7163 
7164          begin
7165             if Argv'Length > 2
7166               and then Argv (1) = '-'
7167               and then Argv (2) = 'm'
7168               and then Argv /= "-margs"
7169 
7170               --  Ignore -mieee to avoid spawning an extra gcc in this case
7171 
7172               and then Argv /= "-mieee"
7173             then
7174                Arg_Index := Arg_Index + 1;
7175                Args (Arg_Index) := new String'(Argv);
7176             end if;
7177          end;
7178       end loop;
7179 
7180       pragma Assert (Arg_Index = N_M_Switch);
7181 
7182       Args (Args'Last) := new String'("-print-multi-directory");
7183 
7184       --  Call the GCC driver with the collected flags and save its
7185       --  output. Alternate design would be to link in gnatmake the
7186       --  relevant part of the GCC driver.
7187 
7188       if Saved_Gcc /= null then
7189          Multilib_Gcc := Saved_Gcc;
7190       else
7191          Multilib_Gcc := Gcc;
7192       end if;
7193 
7194       Multilib_Gcc_Path := GNAT.OS_Lib.Locate_Exec_On_Path (Multilib_Gcc.all);
7195 
7196       Create_Temp_Output_File (Output_FD, Output_Name);
7197 
7198       if Output_FD = Invalid_FD then
7199          return;
7200       end if;
7201 
7202       GNAT.OS_Lib.Spawn
7203         (Multilib_Gcc_Path.all, Args, Output_FD, Return_Code, False);
7204       Close (Output_FD);
7205 
7206       if Return_Code /= 0 then
7207          return;
7208       end if;
7209 
7210       --  Parse the GCC driver output which is a single line, removing CR/LF
7211 
7212       Output_FD := Open_Read (Output_Name.all, Binary);
7213 
7214       if Output_FD = Invalid_FD then
7215          return;
7216       end if;
7217 
7218       N_Read := Read (Output_FD, Line (1)'Address, Line'Length);
7219       Close (Output_FD);
7220       Delete_File (Output_Name.all, Success);
7221 
7222       for J in reverse 1 .. N_Read loop
7223          if Line (J) = ASCII.CR or else Line (J) = ASCII.LF then
7224             N_Read := N_Read - 1;
7225          else
7226             exit;
7227          end if;
7228       end loop;
7229 
7230       --  In case the standard RTS is selected do nothing
7231 
7232       if N_Read = 0 or else Line (1 .. N_Read) = "." then
7233          return;
7234       end if;
7235 
7236       --  Otherwise add -margs --RTS=output
7237 
7238       Scan_Make_Arg (Env, "-margs", And_Save => True);
7239       Scan_Make_Arg (Env, "--RTS=" & Line (1 .. N_Read), And_Save => True);
7240    end Process_Multilib;
7241 
7242    -----------------------------
7243    -- Recursive_Compute_Depth --
7244    -----------------------------
7245 
7246    procedure Recursive_Compute_Depth (Project : Project_Id) is
7247       use Project_Boolean_Htable;
7248       Seen : Project_Boolean_Htable.Instance := Project_Boolean_Htable.Nil;
7249 
7250       procedure Recurse (Prj : Project_Id; Depth : Natural);
7251       --  Recursive procedure that does the work, keeping track of the depth
7252 
7253       -------------
7254       -- Recurse --
7255       -------------
7256 
7257       procedure Recurse (Prj : Project_Id; Depth : Natural) is
7258          List : Project_List;
7259          Proj : Project_Id;
7260 
7261       begin
7262          if Prj.Depth >= Depth or else Get (Seen, Prj) then
7263             return;
7264          end if;
7265 
7266          --  We need a test to avoid infinite recursions with limited withs:
7267          --  If we have A -> B -> A, then when set level of A to n, we try and
7268          --  set level of B to n+1, and then level of A to n + 2, ...
7269 
7270          Set (Seen, Prj, True);
7271 
7272          Prj.Depth := Depth;
7273 
7274          --  Visit each imported project
7275 
7276          List := Prj.Imported_Projects;
7277          while List /= null loop
7278             Proj := List.Project;
7279             List := List.Next;
7280             Recurse (Prj => Proj, Depth => Depth + 1);
7281          end loop;
7282 
7283          --  We again allow changing the depth of this project later on if it
7284          --  is in fact imported by a lower-level project.
7285 
7286          Set (Seen, Prj, False);
7287       end Recurse;
7288 
7289       Proj : Project_List;
7290 
7291    --  Start of processing for Recursive_Compute_Depth
7292 
7293    begin
7294       Proj := Project_Tree.Projects;
7295       while Proj /= null loop
7296          Proj.Project.Depth := 0;
7297          Proj := Proj.Next;
7298       end loop;
7299 
7300       Recurse (Project, Depth => 1);
7301       Reset (Seen);
7302    end Recursive_Compute_Depth;
7303 
7304    -------------------------------
7305    -- Report_Compilation_Failed --
7306    -------------------------------
7307 
7308    procedure Report_Compilation_Failed is
7309    begin
7310       Fail_Program (Project_Tree, "");
7311    end Report_Compilation_Failed;
7312 
7313    ------------------------
7314    -- Sigint_Intercepted --
7315    ------------------------
7316 
7317    procedure Sigint_Intercepted is
7318    begin
7319       Set_Standard_Error;
7320       Write_Line ("*** Interrupted ***");
7321 
7322       --  Send SIGINT to all outstanding compilation processes spawned
7323 
7324       for J in 1 .. Outstanding_Compiles loop
7325          Kill (Running_Compile (J).Pid, Hard_Kill => False);
7326       end loop;
7327 
7328       Finish_Program (Project_Tree, E_No_Compile);
7329    end Sigint_Intercepted;
7330 
7331    -------------------
7332    -- Scan_Make_Arg --
7333    -------------------
7334 
7335    procedure Scan_Make_Arg
7336      (Env               : in out Prj.Tree.Environment;
7337       Argv              : String;
7338       And_Save          : Boolean)
7339    is
7340       Success : Boolean;
7341 
7342    begin
7343       Gnatmake_Switch_Found := True;
7344 
7345       pragma Assert (Argv'First = 1);
7346 
7347       if Argv'Length = 0 then
7348          return;
7349       end if;
7350 
7351       --  If the previous switch has set the Project_File_Name_Present flag
7352       --  (that is we have seen a -P alone), then the next argument is the name
7353       --  of the project file.
7354 
7355       if Project_File_Name_Present and then Project_File_Name = null then
7356          if Argv (1) = '-' then
7357             Make_Failed ("project file name missing after -P");
7358 
7359          else
7360             Project_File_Name_Present := False;
7361             Project_File_Name := new String'(Argv);
7362          end if;
7363 
7364       --  If the previous switch has set the Output_File_Name_Present flag
7365       --  (that is we have seen a -o), then the next argument is the name of
7366       --  the output executable.
7367 
7368       elsif Output_File_Name_Present
7369         and then not Output_File_Name_Seen
7370       then
7371          Output_File_Name_Seen := True;
7372 
7373          if Argv (1) = '-' then
7374             Make_Failed ("output file name missing after -o");
7375 
7376          else
7377             Add_Switch ("-o", Linker, And_Save => And_Save);
7378             Add_Switch (Executable_Name (Argv), Linker, And_Save => And_Save);
7379          end if;
7380 
7381       --  If the previous switch has set the Object_Directory_Present flag
7382       --  (that is we have seen a -D), then the next argument is the path name
7383       --  of the object directory.
7384 
7385       elsif Object_Directory_Present
7386         and then not Object_Directory_Seen
7387       then
7388          Object_Directory_Seen := True;
7389 
7390          if Argv (1) = '-' then
7391             Make_Failed ("object directory path name missing after -D");
7392 
7393          elsif not Is_Directory (Argv) then
7394             Make_Failed ("cannot find object directory """ & Argv & """");
7395 
7396          else
7397             --  Record the object directory. Make sure it ends with a directory
7398             --  separator.
7399 
7400             declare
7401                Norm : constant String := Normalize_Pathname (Argv);
7402 
7403             begin
7404                if Norm (Norm'Last) = Directory_Separator then
7405                   Object_Directory_Path := new String'(Norm);
7406                else
7407                   Object_Directory_Path :=
7408                     new String'(Norm & Directory_Separator);
7409                end if;
7410 
7411                Add_Lib_Search_Dir (Norm);
7412 
7413                --  Specify the object directory to the binder
7414 
7415                Add_Switch ("-aO" & Norm, Binder, And_Save => And_Save);
7416             end;
7417 
7418          end if;
7419 
7420       --  Then check if we are dealing with -cargs/-bargs/-largs/-margs. These
7421       --  options are taken as is when found in package Compiler, Binder or
7422       --  Linker of the main project file.
7423 
7424       elsif (And_Save or else Program_Args = None)
7425         and then (Argv = "-bargs" or else
7426                   Argv = "-cargs" or else
7427                   Argv = "-largs" or else
7428                   Argv = "-margs")
7429       then
7430          case Argv (2) is
7431             when 'c' => Program_Args := Compiler;
7432             when 'b' => Program_Args := Binder;
7433             when 'l' => Program_Args := Linker;
7434             when 'm' => Program_Args := None;
7435 
7436             when others =>
7437                raise Program_Error;
7438          end case;
7439 
7440       --  A special test is needed for the -o switch within a -largs since that
7441       --  is another way to specify the name of the final executable.
7442 
7443       elsif Program_Args = Linker and then Argv = "-o" then
7444          Make_Failed
7445            ("switch -o not allowed within a -largs. Use -o directly.");
7446 
7447       --  Check to see if we are reading switches after a -cargs, -bargs or
7448       --  -largs switch. If so, save it.
7449 
7450       elsif Program_Args /= None then
7451 
7452          --  Check to see if we are reading -I switches in order to take into
7453          --  account in the src & lib search directories.
7454 
7455          if Argv'Length > 2 and then Argv (1 .. 2) = "-I" then
7456             if Argv (3 .. Argv'Last) = "-" then
7457                Look_In_Primary_Dir := False;
7458 
7459             elsif Program_Args = Compiler then
7460                if Argv (3 .. Argv'Last) /= "-" then
7461                   Add_Source_Search_Dir (Argv (3 .. Argv'Last), And_Save);
7462                end if;
7463 
7464             elsif Program_Args = Binder then
7465                Add_Library_Search_Dir (Argv (3 .. Argv'Last), And_Save);
7466             end if;
7467          end if;
7468 
7469          Add_Switch (Argv, Program_Args, And_Save => And_Save);
7470 
7471          --  Make sure that all significant switches -m on the command line
7472          --  are counted.
7473 
7474          if Argv'Length > 2
7475            and then Argv (1 .. 2) = "-m"
7476            and then Argv /= "-mieee"
7477          then
7478             N_M_Switch := N_M_Switch + 1;
7479          end if;
7480 
7481       --  Handle non-default compiler, binder, linker, and handle --RTS switch
7482 
7483       elsif Argv'Length > 2 and then Argv (1 .. 2) = "--" then
7484          if Argv'Length > 6
7485            and then Argv (1 .. 6) = "--GCC="
7486          then
7487             declare
7488                Program_Args : constant Argument_List_Access :=
7489                                 Argument_String_To_List
7490                                   (Argv (7 .. Argv'Last));
7491 
7492             begin
7493                if And_Save then
7494                   Saved_Gcc := new String'(Program_Args.all (1).all);
7495                else
7496                   Gcc := new String'(Program_Args.all (1).all);
7497                end if;
7498 
7499                for J in 2 .. Program_Args.all'Last loop
7500                   Add_Switch
7501                     (Program_Args.all (J).all, Compiler, And_Save => And_Save);
7502                end loop;
7503             end;
7504 
7505          elsif Argv'Length > 11
7506            and then Argv (1 .. 11) = "--GNATBIND="
7507          then
7508             declare
7509                Program_Args : constant Argument_List_Access :=
7510                                 Argument_String_To_List
7511                                   (Argv (12 .. Argv'Last));
7512 
7513             begin
7514                if And_Save then
7515                   Saved_Gnatbind := new String'(Program_Args.all (1).all);
7516                else
7517                   Gnatbind := new String'(Program_Args.all (1).all);
7518                end if;
7519 
7520                for J in 2 .. Program_Args.all'Last loop
7521                   Add_Switch
7522                     (Program_Args.all (J).all, Binder, And_Save => And_Save);
7523                end loop;
7524             end;
7525 
7526          elsif Argv'Length > 11
7527            and then Argv (1 .. 11) = "--GNATLINK="
7528          then
7529             declare
7530                Program_Args : constant Argument_List_Access :=
7531                                 Argument_String_To_List
7532                                   (Argv (12 .. Argv'Last));
7533             begin
7534                if And_Save then
7535                   Saved_Gnatlink := new String'(Program_Args.all (1).all);
7536                else
7537                   Gnatlink := new String'(Program_Args.all (1).all);
7538                end if;
7539 
7540                for J in 2 .. Program_Args.all'Last loop
7541                   Add_Switch (Program_Args.all (J).all, Linker);
7542                end loop;
7543             end;
7544 
7545          elsif Argv'Length >= 5 and then
7546            Argv (1 .. 5) = "--RTS"
7547          then
7548             Add_Switch (Argv, Compiler, And_Save => And_Save);
7549             Add_Switch (Argv, Binder,   And_Save => And_Save);
7550 
7551             if Argv'Length <= 6 or else Argv (6) /= '=' then
7552                Make_Failed ("missing path for --RTS");
7553 
7554             else
7555                --  Check that this is the first time we see this switch or
7556                --  if it is not the first time, the same path is specified.
7557 
7558                if RTS_Specified = null then
7559                   RTS_Specified := new String'(Argv (7 .. Argv'Last));
7560 
7561                elsif RTS_Specified.all /= Argv (7 .. Argv'Last) then
7562                   Make_Failed ("--RTS cannot be specified multiple times");
7563                end if;
7564 
7565                --  Valid --RTS switch
7566 
7567                No_Stdinc := True;
7568                No_Stdlib := True;
7569                RTS_Switch := True;
7570 
7571                declare
7572                   Src_Path_Name : constant String_Ptr :=
7573                                     Get_RTS_Search_Dir
7574                                       (Argv (7 .. Argv'Last), Include);
7575 
7576                   Lib_Path_Name : constant String_Ptr :=
7577                                     Get_RTS_Search_Dir
7578                                       (Argv (7 .. Argv'Last), Objects);
7579 
7580                begin
7581                   if Src_Path_Name /= null
7582                     and then Lib_Path_Name /= null
7583                   then
7584                      --  Set RTS_*_Path_Name variables, so that correct direct-
7585                      --  ories will be set when Osint.Add_Default_Search_Dirs
7586                      --  is called later.
7587 
7588                      RTS_Src_Path_Name := Src_Path_Name;
7589                      RTS_Lib_Path_Name := Lib_Path_Name;
7590 
7591                   elsif Src_Path_Name = null
7592                     and then Lib_Path_Name = null
7593                   then
7594                      Make_Failed
7595                        ("RTS path not valid: missing adainclude and adalib "
7596                         & "directories");
7597 
7598                   elsif Src_Path_Name = null then
7599                      Make_Failed
7600                        ("RTS path not valid: missing adainclude directory");
7601 
7602                   elsif Lib_Path_Name = null then
7603                      Make_Failed
7604                        ("RTS path not valid: missing adalib directory");
7605                   end if;
7606                end;
7607             end if;
7608 
7609          elsif Argv'Length > Source_Info_Option'Length
7610            and then Argv (1 .. Source_Info_Option'Length) = Source_Info_Option
7611          then
7612             Project_Tree.Source_Info_File_Name :=
7613               new String'(Argv (Source_Info_Option'Length + 1 .. Argv'Last));
7614 
7615          elsif Argv'Length >= 8 and then Argv (1 .. 8) = "--param=" then
7616             Add_Switch (Argv, Compiler, And_Save => And_Save);
7617             Add_Switch (Argv, Linker,   And_Save => And_Save);
7618 
7619          elsif Argv = Create_Map_File_Switch then
7620             Map_File := new String'("");
7621 
7622          elsif Argv'Length > Create_Map_File_Switch'Length + 1
7623            and then
7624              Argv (1 .. Create_Map_File_Switch'Length) = Create_Map_File_Switch
7625            and then
7626              Argv (Create_Map_File_Switch'Length + 1) = '='
7627          then
7628             Map_File :=
7629               new String'
7630                 (Argv (Create_Map_File_Switch'Length + 2 .. Argv'Last));
7631 
7632          else
7633             Scan_Make_Switches (Env, Argv, Success);
7634          end if;
7635 
7636       --  If we have seen a regular switch process it
7637 
7638       elsif Argv (1) = '-' then
7639          if Argv'Length = 1 then
7640             Make_Failed ("switch character cannot be followed by a blank");
7641 
7642          --  Incorrect switches that should start with "--"
7643 
7644          elsif     (Argv'Length > 5  and then Argv (1 .. 5) = "-RTS=")
7645            or else (Argv'Length > 5  and then Argv (1 .. 5) = "-GCC=")
7646            or else (Argv'Length > 8  and then Argv (1 .. 7) = "-param=")
7647            or else (Argv'Length > 10 and then Argv (1 .. 10) = "-GNATLINK=")
7648            or else (Argv'Length > 10 and then Argv (1 .. 10) = "-GNATBIND=")
7649          then
7650             Make_Failed ("option " & Argv & " should start with '--'");
7651 
7652          --  -I-
7653 
7654          elsif Argv (2 .. Argv'Last) = "I-" then
7655             Look_In_Primary_Dir := False;
7656 
7657          --  Forbid  -?-  or  -??-  where ? is any character
7658 
7659          elsif (Argv'Length = 3 and then Argv (3) = '-')
7660            or else (Argv'Length = 4 and then Argv (4) = '-')
7661          then
7662             Make_Failed
7663               ("trailing ""-"" at the end of " & Argv & " forbidden.");
7664 
7665          --  -Idir
7666 
7667          elsif Argv (2) = 'I' then
7668             Add_Source_Search_Dir  (Argv (3 .. Argv'Last), And_Save);
7669             Add_Library_Search_Dir (Argv (3 .. Argv'Last), And_Save);
7670             Add_Switch (Argv, Compiler, And_Save => And_Save);
7671             Add_Switch (Argv, Binder,   And_Save => And_Save);
7672 
7673          --  -aIdir (to gcc this is like a -I switch)
7674 
7675          elsif Argv'Length >= 3 and then Argv (2 .. 3) = "aI" then
7676             Add_Source_Search_Dir (Argv (4 .. Argv'Last), And_Save);
7677             Add_Switch
7678               ("-I" & Argv (4 .. Argv'Last), Compiler, And_Save => And_Save);
7679             Add_Switch (Argv, Binder, And_Save => And_Save);
7680 
7681          --  -aOdir
7682 
7683          elsif Argv'Length >= 3 and then Argv (2 .. 3) = "aO" then
7684             Add_Library_Search_Dir (Argv (4 .. Argv'Last), And_Save);
7685             Add_Switch (Argv, Binder, And_Save => And_Save);
7686 
7687          --  -aLdir (to gnatbind this is like a -aO switch)
7688 
7689          elsif Argv'Length >= 3 and then Argv (2 .. 3) = "aL" then
7690             Mark_Directory (Argv (4 .. Argv'Last), Ada_Lib_Dir, And_Save);
7691             Add_Library_Search_Dir (Argv (4 .. Argv'Last), And_Save);
7692             Add_Switch
7693               ("-aO" & Argv (4 .. Argv'Last), Binder, And_Save => And_Save);
7694 
7695          --  -aamp_target=...
7696 
7697          elsif Argv'Length >= 13 and then Argv (2 .. 13) = "aamp_target=" then
7698             Add_Switch (Argv, Compiler, And_Save => And_Save);
7699 
7700             --  Set the aamp_target environment variable so that the binder and
7701             --  linker will use the proper target library. This is consistent
7702             --  with how things work when -aamp_target is passed on the command
7703             --  line to gnaampmake.
7704 
7705             Setenv ("aamp_target", Argv (14 .. Argv'Last));
7706 
7707          --  -Adir (to gnatbind this is like a -aO switch, to gcc like a -I)
7708 
7709          elsif Argv (2) = 'A' then
7710             Mark_Directory (Argv (3 .. Argv'Last), Ada_Lib_Dir, And_Save);
7711             Add_Source_Search_Dir  (Argv (3 .. Argv'Last), And_Save);
7712             Add_Library_Search_Dir (Argv (3 .. Argv'Last), And_Save);
7713             Add_Switch
7714               ("-I"  & Argv (3 .. Argv'Last), Compiler, And_Save => And_Save);
7715             Add_Switch
7716               ("-aO" & Argv (3 .. Argv'Last), Binder,   And_Save => And_Save);
7717 
7718          --  -Ldir
7719 
7720          elsif Argv (2) = 'L' then
7721             Add_Switch (Argv, Linker, And_Save => And_Save);
7722 
7723          --  For -gxxx, -pg, -mxxx, -fxxx, -Oxxx, pass the switch to both the
7724          --  compiler and the linker (except for -gnatxxx which is only for the
7725          --  compiler). Some of the -mxxx (for example -m64) and -fxxx (for
7726          --  example -ftest-coverage for gcov) need to be used when compiling
7727          --  the binder generated files, and using all these gcc switches for
7728          --  them should not be a problem. Pass -Oxxx to the linker for LTO.
7729 
7730          elsif
7731            (Argv (2) = 'g' and then (Argv'Last < 5
7732                                        or else Argv (2 .. 5) /= "gnat"))
7733              or else Argv (2 .. Argv'Last) = "pg"
7734              or else (Argv (2) = 'm' and then Argv'Last > 2)
7735              or else (Argv (2) = 'f' and then Argv'Last > 2)
7736              or else Argv (2) = 'O'
7737          then
7738             Add_Switch (Argv, Compiler, And_Save => And_Save);
7739             Add_Switch (Argv, Linker,   And_Save => And_Save);
7740 
7741             --  The following condition has to be kept synchronized with
7742             --  the Process_Multilib one.
7743 
7744             if Argv (2) = 'm'
7745               and then Argv /= "-mieee"
7746             then
7747                N_M_Switch := N_M_Switch + 1;
7748             end if;
7749 
7750          --  -C=<mapping file>
7751 
7752          elsif Argv'Last > 2 and then Argv (2) = 'C' then
7753             if And_Save then
7754                if Argv (3) /= '=' or else Argv'Last <= 3 then
7755                   Make_Failed ("illegal switch " & Argv);
7756                end if;
7757 
7758                Gnatmake_Mapping_File := new String'(Argv (4 .. Argv'Last));
7759             end if;
7760 
7761          --  -D
7762 
7763          elsif Argv'Last = 2 and then Argv (2) = 'D' then
7764             if Project_File_Name /= null then
7765                Make_Failed
7766                  ("-D cannot be used in conjunction with a project file");
7767 
7768             else
7769                Scan_Make_Switches (Env, Argv, Success);
7770             end if;
7771 
7772          --  -d
7773 
7774          elsif Argv (2) = 'd' and then Argv'Last = 2 then
7775             Display_Compilation_Progress := True;
7776 
7777          --  -i
7778 
7779          elsif Argv'Last = 2 and then Argv (2) = 'i' then
7780             if Project_File_Name /= null then
7781                Make_Failed
7782                  ("-i cannot be used in conjunction with a project file");
7783             else
7784                Scan_Make_Switches (Env, Argv, Success);
7785             end if;
7786 
7787          --  -j (need to save the result)
7788 
7789          elsif Argv (2) = 'j' then
7790             Scan_Make_Switches (Env, Argv, Success);
7791 
7792             if And_Save then
7793                Saved_Maximum_Processes := Maximum_Processes;
7794             end if;
7795 
7796          --  -m
7797 
7798          elsif Argv (2) = 'm' and then Argv'Last = 2 then
7799             Minimal_Recompilation := True;
7800 
7801          --  -u
7802 
7803          elsif Argv (2) = 'u' and then Argv'Last = 2 then
7804             Unique_Compile := True;
7805             Compile_Only   := True;
7806             Do_Bind_Step   := False;
7807             Do_Link_Step   := False;
7808 
7809          --  -U
7810 
7811          elsif Argv (2) = 'U'
7812            and then Argv'Last = 2
7813          then
7814             Unique_Compile_All_Projects := True;
7815             Unique_Compile := True;
7816             Compile_Only   := True;
7817             Do_Bind_Step   := False;
7818             Do_Link_Step   := False;
7819 
7820          --  -Pprj or -P prj (only once, and only on the command line)
7821 
7822          elsif Argv (2) = 'P' then
7823             if Project_File_Name /= null then
7824                Make_Failed ("cannot have several project files specified");
7825 
7826             elsif Object_Directory_Path /= null then
7827                Make_Failed
7828                  ("-D cannot be used in conjunction with a project file");
7829 
7830             elsif In_Place_Mode then
7831                Make_Failed
7832                  ("-i cannot be used in conjunction with a project file");
7833 
7834             elsif not And_Save then
7835 
7836                --  It could be a tool other than gnatmake (e.g. gnatdist)
7837                --  or a -P switch inside a project file.
7838 
7839                Fail
7840                  ("either the tool is not ""project-aware"" or "
7841                   & "a project file is specified inside a project file");
7842 
7843             elsif Argv'Last = 2 then
7844 
7845                --  -P is used alone: the project file name is the next option
7846 
7847                Project_File_Name_Present := True;
7848 
7849             else
7850                Project_File_Name := new String'(Argv (3 .. Argv'Last));
7851             end if;
7852 
7853          --  -vPx  (verbosity of the parsing of the project files)
7854 
7855          elsif Argv'Length >= 3 and then Argv (2 .. 3) = "vP" then
7856             if Argv'Last /= 4 or else Argv (4) not in '0' .. '2' then
7857                Make_Failed
7858                  ("invalid verbosity level " & Argv (4 .. Argv'Last));
7859 
7860             elsif And_Save then
7861                case Argv (4) is
7862                   when '0' =>
7863                      Current_Verbosity := Prj.Default;
7864                   when '1' =>
7865                      Current_Verbosity := Prj.Medium;
7866                   when '2' =>
7867                      Current_Verbosity := Prj.High;
7868                   when others =>
7869                      null;
7870                end case;
7871             end if;
7872 
7873          --  -Xext=val  (External assignment)
7874 
7875          elsif Argv (2) = 'X'
7876            and then Is_External_Assignment (Env, Argv)
7877          then
7878             --  Is_External_Assignment has side effects when it returns True
7879 
7880             null;
7881 
7882          --  If -gnath is present, then generate the usage information right
7883          --  now and do not pass this option on to the compiler calls.
7884 
7885          elsif Argv = "-gnath" then
7886             Usage;
7887 
7888          --  If -gnatc is specified, make sure the bind and link steps are not
7889          --  executed.
7890 
7891          elsif Argv'Length >= 6 and then Argv (2 .. 6) = "gnatc" then
7892 
7893             --  If -gnatc is specified, make sure the bind and link steps are
7894             --  not executed.
7895 
7896             Add_Switch (Argv, Compiler, And_Save => And_Save);
7897             Operating_Mode           := Check_Semantics;
7898             Check_Object_Consistency := False;
7899 
7900             --  Except in CodePeer mode (set by -gnatcC), where we do want to
7901             --  call bind/link in CodePeer mode (-P switch).
7902 
7903             if Argv'Last >= 7 and then Argv (7) = 'C' then
7904                CodePeer_Mode := True;
7905             else
7906                Compile_Only := True;
7907                Do_Bind_Step := False;
7908                Do_Link_Step := False;
7909             end if;
7910 
7911          --  If -gnatA is specified, make sure that gnat.adc is never read
7912 
7913          elsif Argv'Length >= 6 and then Argv (2 .. 6) = "gnatA" then
7914             Add_Switch (Argv, Compiler, And_Save => And_Save);
7915             Opt.Config_File := False;
7916 
7917          elsif Argv (2 .. Argv'Last) = "nostdlib" then
7918 
7919             --  Pass -nstdlib to gnatbind and gnatlink
7920 
7921             No_Stdlib := True;
7922             Add_Switch (Argv, Binder, And_Save => And_Save);
7923             Add_Switch (Argv, Linker, And_Save => And_Save);
7924 
7925          elsif Argv (2 .. Argv'Last) = "nostdinc" then
7926 
7927             --  Pass -nostdinc to the Compiler and to gnatbind
7928 
7929             No_Stdinc := True;
7930             Add_Switch (Argv, Compiler, And_Save => And_Save);
7931             Add_Switch (Argv, Binder,   And_Save => And_Save);
7932 
7933          --  All other switches are processed by Scan_Make_Switches. If the
7934          --  call returns with Gnatmake_Switch_Found = False, then the switch
7935          --  is passed to the compiler.
7936 
7937          else
7938             Scan_Make_Switches (Env, Argv, Gnatmake_Switch_Found);
7939 
7940             if not Gnatmake_Switch_Found then
7941                Add_Switch (Argv, Compiler, And_Save => And_Save);
7942             end if;
7943          end if;
7944 
7945       --  If not a switch it must be a file name
7946 
7947       else
7948          if And_Save then
7949             Main_On_Command_Line := True;
7950          end if;
7951 
7952          Add_File (Argv);
7953          Mains.Add_Main (Argv);
7954       end if;
7955    end Scan_Make_Arg;
7956 
7957    -----------------
7958    -- Switches_Of --
7959    -----------------
7960 
7961    function Switches_Of
7962      (Source_File      : File_Name_Type;
7963       Project          : Project_Id;
7964       In_Package       : Package_Id;
7965       Allow_ALI        : Boolean) return Variable_Value
7966    is
7967       Switches : Variable_Value;
7968       Is_Default : Boolean;
7969 
7970    begin
7971       Makeutl.Get_Switches
7972         (Source_File  => Source_File,
7973          Source_Lang  => Name_Ada,
7974          Source_Prj   => Project,
7975          Pkg_Name     => Project_Tree.Shared.Packages.Table (In_Package).Name,
7976          Project_Tree => Project_Tree,
7977          Value        => Switches,
7978          Is_Default   => Is_Default,
7979          Test_Without_Suffix => True,
7980          Check_ALI_Suffix => Allow_ALI);
7981       return Switches;
7982    end Switches_Of;
7983 
7984    -----------
7985    -- Usage --
7986    -----------
7987 
7988    procedure Usage is
7989    begin
7990       if Usage_Needed then
7991          Usage_Needed := False;
7992          Makeusg;
7993       end if;
7994    end Usage;
7995 
7996 begin
7997    --  Make sure that in case of failure, the temp files will be deleted
7998 
7999    Prj.Com.Fail    := Make_Failed'Access;
8000    MLib.Fail       := Make_Failed'Access;
8001 end Make;