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