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