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