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