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