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