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