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