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
3367               and then not Unique_Compile
3368               and then ((not Make_Steps) or else Bind_Only or else Link_Only)
3369             then
3370                Make_Failed ("cannot specify a main program " &
3371                             "on the command line for a library project file");
3372
3373             else
3374                --  Check that each main on the command line is a source of a
3375                --  project file and, if there are several mains, each of them
3376                --  is a source of the same project file.
3377
3378                Mains.Reset;
3379
3380                declare
3381                   Real_Main_Project : Project_Id := No_Project;
3382                   --  The project of the first main
3383
3384                   Proj : Project_Id := No_Project;
3385                   --  The project of the current main
3386
3387                begin
3388                   --  Check each main
3389
3390                   loop
3391                      declare
3392                         Main : constant String := Mains.Next_Main;
3393                         --  The name specified on the command line may include
3394                         --  directory information.
3395
3396                         File_Name : constant String := Base_Name (Main);
3397                         --  The simple file name of the current main main
3398
3399                      begin
3400                         exit when Main = "";
3401
3402                         --  Get the project of the current main
3403
3404                         Proj := Prj.Env.Project_Of (File_Name, Main_Project);
3405
3406                         --  Fail if the current main is not a source of a
3407                         --  project.
3408
3409                         if Proj = No_Project then
3410                            Make_Failed
3411                              ("""" & Main &
3412                               """ is not a source of any project");
3413
3414                         else
3415                            --  If there is directory information, check that
3416                            --  the source exists and, if it does, that the path
3417                            --  is the actual path of a source of a project.
3418
3419                            if Main /= File_Name then
3420                               declare
3421                                  Data : constant Project_Data :=
3422                                           Projects.Table (Main_Project);
3423
3424                                  Project_Path : constant String :=
3425                                    Prj.Env.File_Name_Of_Library_Unit_Body
3426                                      (Name              => File_Name,
3427                                       Project           => Main_Project,
3428                                       Main_Project_Only => False,
3429                                       Full_Path         => True);
3430                                  Real_Path : String_Access :=
3431                                    Locate_Regular_File
3432                                      (Main &
3433                                       Get_Name_String
3434                                         (Data.Naming.Current_Body_Suffix),
3435                                       "");
3436                               begin
3437                                  if Real_Path = null then
3438                                     Real_Path :=
3439                                       Locate_Regular_File
3440                                         (Main &
3441                                          Get_Name_String
3442                                            (Data.Naming.Current_Spec_Suffix),
3443                                          "");
3444                                  end if;
3445
3446                                  if Real_Path = null then
3447                                     Real_Path :=
3448                                       Locate_Regular_File (Main, "");
3449                                  end if;
3450
3451                                  --  Fail if the file cannot be found
3452
3453                                  if Real_Path = null then
3454                                     Make_Failed
3455                                       ("file """ & Main & """ does not exist");
3456                                  end if;
3457
3458                                  declare
3459                                     Normed_Path : constant String :=
3460                                       Normalize_Pathname
3461                                         (Real_Path.all,
3462                                          Case_Sensitive => False);
3463                                  begin
3464                                     Free (Real_Path);
3465
3466                                     --  Fail if it is not the correct path
3467
3468                                     if Normed_Path /= Project_Path then
3469                                        if Verbose_Mode then
3470                                           Write_Str (Normed_Path);
3471                                           Write_Str (" /= ");
3472                                           Write_Line (Project_Path);
3473                                        end if;
3474
3475                                        Make_Failed
3476                                          ("""" & Main &
3477                                           """ is not a source of any project");
3478                                     end if;
3479                                  end;
3480                               end;
3481                            end if;
3482
3483                            if not Unique_Compile then
3484
3485                               --  Record the project, if it is the first main
3486
3487                               if Real_Main_Project = No_Project then
3488                                  Real_Main_Project := Proj;
3489
3490                               elsif Proj /= Real_Main_Project then
3491
3492                                  --  Fail, as the current main is not a source
3493                                  --  of the same project as the first main.
3494
3495                                  Make_Failed
3496                                    ("""" & Main &
3497                                     """ is not a source of project " &
3498                                     Get_Name_String
3499                                       (Projects.Table
3500                                          (Real_Main_Project).Name));
3501                               end if;
3502                            end if;
3503                         end if;
3504
3505                         --  If -u and -U are not used, we may have mains that
3506                         --  are sources of a project that is not the one
3507                         --  specified with switch -P.
3508
3509                         if not Unique_Compile then
3510                            Main_Project := Real_Main_Project;
3511                         end if;
3512                      end;
3513                   end loop;
3514                end;
3515             end if;
3516
3517          --  If no mains have been specified on the command line,
3518          --  and we are using a project file, we either find the main(s)
3519          --  in the attribute Main of the main project, or we put all
3520          --  the sources of the project file as mains.
3521
3522          else
3523             declare
3524                Value : String_List_Id := Projects.Table (Main_Project).Mains;
3525
3526             begin
3527                --  The attribute Main is an empty list or not specified,
3528                --  or else gnatmake was invoked with the switch "-u".
3529
3530                if Value = Prj.Nil_String or else Unique_Compile then
3531
3532                   if (not Make_Steps) or else Compile_Only
3533                     or else not Projects.Table (Main_Project).Library
3534                   then
3535                      --  First make sure that the binder and the linker
3536                      --  will not be invoked.
3537
3538                      Do_Bind_Step := False;
3539                      Do_Link_Step := False;
3540
3541                      --  Put all the sources in the queue
3542
3543                      Insert_Project_Sources
3544                        (The_Project  => Main_Project,
3545                         All_Projects => Unique_Compile_All_Projects,
3546                         Into_Q       => False);
3547
3548                      --  If there are no sources to compile, we fail
3549
3550                      if Osint.Number_Of_Files = 0 then
3551                         Make_Failed ("no sources to compile");
3552                      end if;
3553                   end if;
3554
3555                else
3556                   --  The attribute Main is not an empty list.
3557                   --  Put all the main subprograms in the list as if there
3558                   --  were specified on the command line. However, if attribute
3559                   --  Languages includes a language other than Ada, only
3560                   --  include the Ada mains; if there is no Ada main, compile
3561                   --  all the sources of the project.
3562
3563                   declare
3564                      Data : Project_Data := Projects.Table (Main_Project);
3565
3566                      Languages : Variable_Value :=
3567                                    Prj.Util.Value_Of
3568                                      (Name_Languages, Data.Decl.Attributes);
3569
3570                      Current : String_List_Id;
3571                      Element : String_Element;
3572
3573                      Foreign_Language  : Boolean := False;
3574                      At_Least_One_Main : Boolean := False;
3575
3576                   begin
3577                      --  First, determine if there is a foreign language in
3578                      --  attribute Languages.
3579
3580                      if not Languages.Default then
3581                         Current := Languages.Values;
3582
3583                         Look_For_Foreign :
3584                         while Current /= Nil_String loop
3585                            Element := String_Elements.Table (Current);
3586                            Get_Name_String (Element.Value);
3587                            To_Lower (Name_Buffer (1 .. Name_Len));
3588
3589                            if Name_Buffer (1 .. Name_Len) /= "ada" then
3590                               Foreign_Language := True;
3591                               exit Look_For_Foreign;
3592                            end if;
3593
3594                            Current := Element.Next;
3595                         end loop Look_For_Foreign;
3596                      end if;
3597
3598                      --  The, find all mains, or if there is a foreign
3599                      --  language, all the Ada mains.
3600
3601                      while Value /= Prj.Nil_String loop
3602                         Get_Name_String (String_Elements.Table (Value).Value);
3603
3604                         --  To know if a main is an Ada main, get its project.
3605                         --  It should be the project specified on the command
3606                         --  line.
3607
3608                         if (not Foreign_Language) or else
3609                             Prj.Env.Project_Of
3610                               (Name_Buffer (1 .. Name_Len), Main_Project) =
3611                              Main_Project
3612                         then
3613                            At_Least_One_Main := True;
3614                            Osint.Add_File
3615                              (Get_Name_String
3616                                 (String_Elements.Table (Value).Value));
3617                         end if;
3618
3619                         Value := String_Elements.Table (Value).Next;
3620                      end loop;
3621
3622                      --  If we did not get any main, it means that all mains
3623                      --  in attribute Mains are in a foreign language. So,
3624                      --  we put all sources of the main project in the Q.
3625
3626                      if not At_Least_One_Main then
3627
3628                         --  First make sure that the binder and the linker
3629                         --  will not be invoked if -z is not used.
3630
3631                         if not No_Main_Subprogram then
3632                            Do_Bind_Step := False;
3633                            Do_Link_Step := False;
3634                         end if;
3635
3636                         --  Put all the sources in the queue
3637
3638                         Insert_Project_Sources
3639                           (The_Project  => Main_Project,
3640                            All_Projects => Unique_Compile_All_Projects,
3641                            Into_Q       => False);
3642
3643                         --  If there are no sources to compile, we fail
3644
3645                         if Osint.Number_Of_Files = 0 then
3646                            Make_Failed ("no sources to compile");
3647                         end if;
3648                      end if;
3649                   end;
3650
3651                end if;
3652             end;
3653          end if;
3654       end if;
3655
3656       if Opt.Verbose_Mode then
3657          Write_Eol;
3658          Write_Str ("GNATMAKE ");
3659          Write_Str (Gnatvsn.Gnat_Version_String);
3660          Write_Str (" Copyright 1995-2003 Free Software Foundation, Inc.");
3661          Write_Eol;
3662       end if;
3663
3664       if Osint.Number_Of_Files = 0 then
3665          if Main_Project /= No_Project
3666            and then Projects.Table (Main_Project).Library
3667          then
3668             if Do_Bind_Step
3669               and then not Projects.Table (Main_Project).Standalone_Library
3670             then
3671                Make_Failed ("only stand-alone libraries may be bound");
3672             end if;
3673
3674             --  Add the default search directories to be able to find libgnat
3675
3676             Osint.Add_Default_Search_Dirs;
3677
3678             --  And bind and or link the library
3679
3680             MLib.Prj.Build_Library
3681               (For_Project   => Main_Project,
3682                Gnatbind      => Gnatbind.all,
3683                Gnatbind_Path => Gnatbind_Path,
3684                Gcc           => Gcc.all,
3685                Gcc_Path      => Gcc_Path,
3686                Bind          => Bind_Only,
3687                Link          => Link_Only);
3688             Exit_Program (E_Success);
3689
3690          else
3691             --  Output usage information if no files to compile
3692
3693             Makeusg;
3694             Exit_Program (E_Fatal);
3695          end if;
3696       end if;
3697
3698       --  If -M was specified, behave as if -n was specified
3699
3700       if Opt.List_Dependencies then
3701          Opt.Do_Not_Execute := True;
3702       end if;
3703
3704       --  Note that Osint.Next_Main_Source will always return the (possibly
3705       --  abbreviated file) without any directory information.
3706
3707       Main_Source_File := Next_Main_Source;
3708
3709       Add_Switch ("-I-", Binder, And_Save => True);
3710       Add_Switch ("-I-", Compiler, And_Save => True);
3711
3712       if Main_Project = No_Project then
3713          if Opt.Look_In_Primary_Dir then
3714
3715             Add_Switch
3716               ("-I" &
3717                Normalize_Directory_Name
3718                (Get_Primary_Src_Search_Directory.all).all,
3719                Compiler, Append_Switch => False,
3720                And_Save => False);
3721
3722             Add_Switch ("-aO" & Normalized_CWD,
3723                         Binder,
3724                         Append_Switch => False,
3725                         And_Save => False);
3726          end if;
3727
3728       end if;
3729
3730       --  If the user wants a program without a main subprogram, add the
3731       --  appropriate switch to the binder.
3732
3733       if Opt.No_Main_Subprogram then
3734          Add_Switch ("-z", Binder, And_Save => True);
3735       end if;
3736
3737       if Main_Project /= No_Project then
3738
3739          if Projects.Table (Main_Project).Object_Directory = No_Name then
3740             Make_Failed ("no sources to compile");
3741          end if;
3742
3743          --  Change the current directory to the object directory of the main
3744          --  project.
3745
3746          begin
3747             Change_Dir
3748               (Get_Name_String
3749                  (Projects.Table (Main_Project).Object_Directory));
3750
3751          exception
3752             when Directory_Error =>
3753
3754                --  This should never happen. But, if it does, display the
3755                --  content of the parent directory of the obj dir.
3756
3757                declare
3758                   Parent : constant Dir_Name_Str :=
3759                     Dir_Name
3760                       (Get_Name_String
3761                            (Projects.Table (Main_Project).Object_Directory));
3762                   Dir : Dir_Type;
3763                   Str : String (1 .. 200);
3764                   Last : Natural;
3765
3766                begin
3767                   Write_Str ("Contents of directory """);
3768                   Write_Str (Parent);
3769                   Write_Line (""":");
3770
3771                   Open (Dir, Parent);
3772
3773                   loop
3774                      Read (Dir, Str, Last);
3775                      exit when Last = 0;
3776                      Write_Str ("   ");
3777                      Write_Line (Str (1 .. Last));
3778                   end loop;
3779
3780                   Close (Dir);
3781
3782                exception
3783                   when X : others =>
3784                      Write_Line ("(unexpected exception)");
3785                      Write_Line (Exception_Information (X));
3786
3787                      if Is_Open (Dir) then
3788                         Close (Dir);
3789                      end if;
3790                end;
3791
3792                Make_Failed ("unable to change working directory to """,
3793                             Get_Name_String
3794                              (Projects.Table (Main_Project).Object_Directory),
3795                             """");
3796          end;
3797
3798          --  Source file lookups should be cached for efficiency.
3799          --  Source files are not supposed to change.
3800
3801          Osint.Source_File_Data (Cache => True);
3802
3803          --  Find the file name of the (first) main unit
3804
3805          declare
3806             Main_Source_File_Name : constant String :=
3807                                       Get_Name_String (Main_Source_File);
3808             Main_Unit_File_Name   : constant String :=
3809                                       Prj.Env.File_Name_Of_Library_Unit_Body
3810                                         (Name    => Main_Source_File_Name,
3811                                          Project => Main_Project,
3812                                          Main_Project_Only =>
3813                                            not Unique_Compile);
3814
3815             The_Packages : constant Package_Id :=
3816               Projects.Table (Main_Project).Decl.Packages;
3817
3818             Builder_Package : constant Prj.Package_Id :=
3819                          Prj.Util.Value_Of
3820                            (Name        => Name_Builder,
3821                             In_Packages => The_Packages);
3822
3823             Binder_Package : constant Prj.Package_Id :=
3824                          Prj.Util.Value_Of
3825                            (Name        => Name_Binder,
3826                             In_Packages => The_Packages);
3827
3828             Linker_Package : constant Prj.Package_Id :=
3829                          Prj.Util.Value_Of
3830                            (Name       => Name_Linker,
3831                             In_Packages => The_Packages);
3832
3833          begin
3834             --  We fail if we cannot find the main source file
3835
3836             if Main_Unit_File_Name = "" then
3837                Make_Failed ('"' & Main_Source_File_Name,
3838                             """ is not a unit of project ",
3839                             Project_File_Name.all & ".");
3840             else
3841                --  Remove any directory information from the main
3842                --  source file name.
3843
3844                declare
3845                   Pos : Natural := Main_Unit_File_Name'Last;
3846
3847                begin
3848                   loop
3849                      exit when Pos < Main_Unit_File_Name'First or else
3850                        Main_Unit_File_Name (Pos) = Directory_Separator;
3851                      Pos := Pos - 1;
3852                   end loop;
3853
3854                   Name_Len := Main_Unit_File_Name'Last - Pos;
3855
3856                   Name_Buffer (1 .. Name_Len) :=
3857                     Main_Unit_File_Name
3858                     (Pos + 1 .. Main_Unit_File_Name'Last);
3859
3860                   Main_Source_File := Name_Find;
3861
3862                   --  We only output the main source file if there is only one
3863
3864                   if Opt.Verbose_Mode and then Osint.Number_Of_Files = 1 then
3865                      Write_Str ("Main source file: """);
3866                      Write_Str (Main_Unit_File_Name
3867                                 (Pos + 1 .. Main_Unit_File_Name'Last));
3868                      Write_Line (""".");
3869                   end if;
3870                end;
3871             end if;
3872
3873             --  If there is a package Builder in the main project file, add
3874             --  the switches from it.
3875
3876             if Builder_Package /= No_Package then
3877
3878                --  If there is only one main, we attempt to get the gnatmake
3879                --  switches for this main (if any). If there are no specific
3880                --  switch for this particular main, get the general gnatmake
3881                --  switches (if any).
3882
3883                if Osint.Number_Of_Files = 1 then
3884                   if Opt.Verbose_Mode then
3885                      Write_Str ("Adding gnatmake switches for """);
3886                      Write_Str (Main_Unit_File_Name);
3887                      Write_Line (""".");
3888                   end if;
3889
3890                   Add_Switches
3891                     (File_Name   => Main_Unit_File_Name,
3892                      The_Package => Builder_Package,
3893                      Program     => None);
3894
3895                else
3896                   --  If there are several mains, we always get the general
3897                   --  gnatmake switches (if any).
3898
3899                   --  Warn the user, if necessary, so that he is not surprized
3900                   --  that specific switches are not taken into account.
3901
3902                   declare
3903                      Defaults : constant Variable_Value :=
3904                        Prj.Util.Value_Of
3905                          (Name                    => Name_Ada,
3906                           Attribute_Or_Array_Name => Name_Default_Switches,
3907                           In_Package              => Builder_Package);
3908
3909                      Switches : constant Array_Element_Id :=
3910                           Prj.Util.Value_Of
3911                              (Name      => Name_Switches,
3912                               In_Arrays =>
3913                                 Packages.Table (Builder_Package).Decl.Arrays);
3914
3915                   begin
3916                      if Defaults /= Nil_Variable_Value then
3917                         if (not Opt.Quiet_Output)
3918                           and then Switches /= No_Array_Element
3919                         then
3920                            Write_Line
3921                              ("Warning: using Builder'Default_Switches" &
3922                               "(""Ada""), as there are several mains");
3923                         end if;
3924
3925                         --  As there is never a source with name " ", we are
3926                         --  guaranteed to always get the general switches.
3927
3928                         Add_Switches
3929                           (File_Name   => " ",
3930                            The_Package => Builder_Package,
3931                            Program     => None);
3932
3933                      elsif (not Opt.Quiet_Output)
3934                        and then Switches /= No_Array_Element
3935                      then
3936                         Write_Line
3937                           ("Warning: using no switches from package Builder," &
3938                            " as there are several mains");
3939                      end if;
3940                   end;
3941                end if;
3942             end if;
3943
3944             Osint.Add_Default_Search_Dirs;
3945
3946             --  Record the current last switch index for table Binder_Switches
3947             --  and Linker_Switches, so that these tables may be reset before
3948             --  for each main, before adding swiches from the project file
3949             --  and from the command line.
3950
3951             Last_Binder_Switch := Binder_Switches.Last;
3952             Last_Linker_Switch := Linker_Switches.Last;
3953
3954             Check_Steps;
3955
3956             --  Add binder switches from the project file for the first main
3957
3958             if Do_Bind_Step and Binder_Package /= No_Package then
3959                if Opt.Verbose_Mode then
3960                   Write_Str ("Adding binder switches for """);
3961                   Write_Str (Main_Unit_File_Name);
3962                   Write_Line (""".");
3963                end if;
3964
3965                Add_Switches
3966                  (File_Name   => Main_Unit_File_Name,
3967                   The_Package => Binder_Package,
3968                   Program     => Binder);
3969             end if;
3970
3971             --  Add linker switches from the project file for the first main
3972
3973             if Do_Link_Step and Linker_Package /= No_Package then
3974                if Opt.Verbose_Mode then
3975                   Write_Str ("Adding linker switches for""");
3976                   Write_Str (Main_Unit_File_Name);
3977                   Write_Line (""".");
3978                end if;
3979
3980                Add_Switches
3981                  (File_Name   => Main_Unit_File_Name,
3982                   The_Package => Linker_Package,
3983                   Program     => Linker);
3984             end if;
3985          end;
3986       end if;
3987
3988       --  Get the target parameters, which are only needed for a couple of
3989       --  cases in gnatmake. Protect against an exception, such as the case
3990       --  of system.ads missing from the library, and fail gracefully.
3991
3992       begin
3993          Targparm.Get_Target_Parameters;
3994
3995       exception
3996          when Unrecoverable_Error =>
3997             Make_Failed ("*** make failed.");
3998       end;
3999
4000       Display_Commands (not Opt.Quiet_Output);
4001
4002       Check_Steps;
4003
4004       if Main_Project /= No_Project then
4005
4006          --  For all library project, if the library file does not exist
4007          --  put all the project sources in the queue, and flag the project
4008          --  so that the library is generated.
4009
4010          if MLib.Tgt.Support_For_Libraries /= MLib.Tgt.None then
4011             for Proj in Projects.First .. Projects.Last loop
4012                if Projects.Table (Proj).Library then
4013                   Projects.Table (Proj).Flag1 :=
4014                     not MLib.Tgt.Library_Exists_For (Proj);
4015
4016                   if Projects.Table (Proj).Flag1 then
4017                      if Opt.Verbose_Mode then
4018                         Write_Str
4019                           ("Library file does not exist for project """);
4020                         Write_Str
4021                           (Get_Name_String (Projects.Table (Proj).Name));
4022                         Write_Line ("""");
4023                      end if;
4024
4025                      Insert_Project_Sources
4026                        (The_Project  => Proj,
4027                         All_Projects => False,
4028                         Into_Q       => True);
4029                   end if;
4030                end if;
4031             end loop;
4032          end if;
4033
4034          --  If a relative path output file has been specified, we add
4035          --  the exec directory.
4036
4037          for J in reverse 1 .. Saved_Linker_Switches.Last - 1 loop
4038             if Saved_Linker_Switches.Table (J).all = Output_Flag.all then
4039                declare
4040                   Exec_File_Name : constant String :=
4041                     Saved_Linker_Switches.Table (J + 1).all;
4042
4043                begin
4044                   if not Is_Absolute_Path (Exec_File_Name) then
4045                      for Index in Exec_File_Name'Range loop
4046                         if Exec_File_Name (Index) = Directory_Separator then
4047                            Make_Failed ("relative executable (""",
4048                                         Exec_File_Name,
4049                                         """) with directory part not " &
4050                                         "allowed when using project files");
4051                         end if;
4052                      end loop;
4053
4054                      Get_Name_String (Projects.Table
4055                                         (Main_Project).Exec_Directory);
4056
4057                      if Name_Buffer (Name_Len) /= Directory_Separator then
4058                         Name_Len := Name_Len + 1;
4059                         Name_Buffer (Name_Len) := Directory_Separator;
4060                      end if;
4061
4062                      Name_Buffer (Name_Len + 1 ..
4063                                     Name_Len + Exec_File_Name'Length) :=
4064                        Exec_File_Name;
4065                      Name_Len := Name_Len + Exec_File_Name'Length;
4066                      Saved_Linker_Switches.Table (J + 1) :=
4067                        new String'(Name_Buffer (1 .. Name_Len));
4068                   end if;
4069                end;
4070
4071                exit;
4072             end if;
4073          end loop;
4074
4075          --  If we are using a project file, for relative paths we add the
4076          --  current working directory for any relative path on the command
4077          --  line and the project directory, for any relative path in the
4078          --  project file.
4079
4080          declare
4081             Dir_Path : constant String_Access :=
4082               new String'(Get_Name_String
4083                             (Projects.Table (Main_Project).Directory));
4084          begin
4085             for J in 1 .. Binder_Switches.Last loop
4086                Test_If_Relative_Path
4087                  (Binder_Switches.Table (J),
4088                   Parent => Dir_Path, Including_L_Switch => False);
4089             end loop;
4090
4091             for J in 1 .. Saved_Binder_Switches.Last loop
4092                Test_If_Relative_Path
4093                  (Saved_Binder_Switches.Table (J),
4094                   Parent => Current_Work_Dir, Including_L_Switch => False);
4095             end loop;
4096
4097             for J in 1 .. Linker_Switches.Last loop
4098                Test_If_Relative_Path
4099                  (Linker_Switches.Table (J), Parent => Dir_Path);
4100             end loop;
4101
4102             for J in 1 .. Saved_Linker_Switches.Last loop
4103                Test_If_Relative_Path
4104                  (Saved_Linker_Switches.Table (J), Parent => Current_Work_Dir);
4105             end loop;
4106
4107             for J in 1 .. Gcc_Switches.Last loop
4108                Test_If_Relative_Path
4109                  (Gcc_Switches.Table (J), Parent => Dir_Path);
4110             end loop;
4111
4112             for J in 1 .. Saved_Gcc_Switches.Last loop
4113                Test_If_Relative_Path
4114                  (Saved_Gcc_Switches.Table (J), Parent => Current_Work_Dir);
4115             end loop;
4116          end;
4117       end if;
4118
4119       --  We now put in the Binder_Switches and Linker_Switches tables,
4120       --  the binder and linker switches of the command line that have been
4121       --  put in the Saved_ tables. If a project file was used, then the
4122       --  command line switches will follow the project file switches.
4123
4124       for J in 1 .. Saved_Binder_Switches.Last loop
4125          Add_Switch
4126            (Saved_Binder_Switches.Table (J),
4127             Binder,
4128             And_Save => False);
4129       end loop;
4130
4131       for J in 1 .. Saved_Linker_Switches.Last loop
4132          Add_Switch
4133            (Saved_Linker_Switches.Table (J),
4134             Linker,
4135             And_Save => False);
4136       end loop;
4137
4138       --  If no project file is used, we just put the gcc switches
4139       --  from the command line in the Gcc_Switches table.
4140
4141       if Main_Project = No_Project then
4142          for J in 1 .. Saved_Gcc_Switches.Last loop
4143             Add_Switch
4144               (Saved_Gcc_Switches.Table (J),
4145                Compiler,
4146               And_Save => False);
4147          end loop;
4148
4149       else
4150          --  And we put the command line gcc switches in the variable
4151          --  The_Saved_Gcc_Switches. They are going to be used later
4152          --  in procedure Compile_Sources.
4153
4154          The_Saved_Gcc_Switches :=
4155            new Argument_List (1 .. Saved_Gcc_Switches.Last + 1);
4156
4157          for J in 1 .. Saved_Gcc_Switches.Last loop
4158             The_Saved_Gcc_Switches (J) := Saved_Gcc_Switches.Table (J);
4159          end loop;
4160
4161          --  We never use gnat.adc when a project file is used
4162
4163          The_Saved_Gcc_Switches (The_Saved_Gcc_Switches'Last) :=
4164            No_gnat_adc;
4165
4166       end if;
4167
4168       --  If there was a --GCC, --GNATBIND or --GNATLINK switch on
4169       --  the command line, then we have to use it, even if there was
4170       --  another switch in the project file.
4171
4172       if Saved_Gcc /= null then
4173          Gcc := Saved_Gcc;
4174       end if;
4175
4176       if Saved_Gnatbind /= null then
4177          Gnatbind := Saved_Gnatbind;
4178       end if;
4179
4180       if Saved_Gnatlink /= null then
4181          Gnatlink := Saved_Gnatlink;
4182       end if;
4183
4184       Gcc_Path       := GNAT.OS_Lib.Locate_Exec_On_Path (Gcc.all);
4185       Gnatbind_Path  := GNAT.OS_Lib.Locate_Exec_On_Path (Gnatbind.all);
4186       Gnatlink_Path  := GNAT.OS_Lib.Locate_Exec_On_Path (Gnatlink.all);
4187
4188       --  If we have specified -j switch both from the project file
4189       --  and on the command line, the one from the command line takes
4190       --  precedence.
4191
4192       if Saved_Maximum_Processes = 0 then
4193          Saved_Maximum_Processes := Opt.Maximum_Processes;
4194       end if;
4195
4196       --  Allocate as many temporary mapping file names as the maximum
4197       --  number of compilation processed, for each possible project.
4198
4199       The_Mapping_File_Names :=
4200         new Temp_File_Names
4201               (No_Project .. Projects.Last, 1 .. Saved_Maximum_Processes);
4202       Last_Mapping_File_Names :=
4203         new Indices'(No_Project .. Projects.Last => 0);
4204
4205       The_Free_Mapping_File_Indices :=
4206         new Free_File_Indices
4207               (No_Project .. Projects.Last, 1 .. Saved_Maximum_Processes);
4208       Last_Free_Indices :=
4209         new Indices'(No_Project .. Projects.Last => 0);
4210
4211       Bad_Compilation.Init;
4212
4213       --  Here is where the make process is started
4214
4215       --  We do the same process for each main
4216
4217       Multiple_Main_Loop : for N_File in 1 .. Osint.Number_Of_Files loop
4218
4219          --  First, find the executable name and path
4220
4221          Executable          := No_File;
4222          Executable_Obsolete := False;
4223          Non_Std_Executable  := False;
4224
4225          --  Look inside the linker switches to see if the name
4226          --  of the final executable program was specified.
4227
4228          for
4229            J in reverse Linker_Switches.First .. Linker_Switches.Last
4230          loop
4231             if Linker_Switches.Table (J).all = Output_Flag.all then
4232                pragma Assert (J < Linker_Switches.Last);
4233
4234                --  We cannot specify a single executable for several
4235                --  main subprograms!
4236
4237                if Osint.Number_Of_Files > 1 then
4238                   Fail
4239                     ("cannot specify a single executable " &
4240                      "for several mains");
4241                end if;
4242
4243                Name_Len := Linker_Switches.Table (J + 1)'Length;
4244                Name_Buffer (1 .. Name_Len) :=
4245                  Linker_Switches.Table (J + 1).all;
4246
4247                --  Put in canonical case to detect suffixs such as ".EXE" on
4248                --  Windows or VMS.
4249
4250                Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
4251
4252                --  If target has an executable suffix and it has not been
4253                --  specified then it is added here.
4254
4255                if Executable_Suffix'Length /= 0
4256                  and then Name_Buffer
4257                           (Name_Len - Executable_Suffix'Length + 1 .. Name_Len)
4258                              /= Executable_Suffix
4259                then
4260                   --  Get back the original name to keep the case on Windows
4261
4262                   Name_Buffer (1 .. Name_Len) :=
4263                     Linker_Switches.Table (J + 1).all;
4264
4265                   --  Add the executable suffix
4266
4267                   Name_Buffer (Name_Len + 1 ..
4268                                        Name_Len + Executable_Suffix'Length) :=
4269                       Executable_Suffix;
4270                   Name_Len := Name_Len + Executable_Suffix'Length;
4271
4272                else
4273                   --  Get back the original name to keep the case on Windows
4274
4275                   Name_Buffer (1 .. Name_Len) :=
4276                     Linker_Switches.Table (J + 1).all;
4277                end if;
4278
4279                Executable := Name_Enter;
4280
4281                Verbose_Msg (Executable, "final executable");
4282             end if;
4283          end loop;
4284
4285          --  If the name of the final executable program was not
4286          --  specified then construct it from the main input file.
4287
4288          if Executable = No_File then
4289             if Main_Project = No_Project then
4290                Executable :=
4291                  Executable_Name (Strip_Suffix (Main_Source_File));
4292
4293             else
4294                --  If we are using a project file, we attempt to
4295                --  remove the body (or spec) termination of the main
4296                --  subprogram. We find it the the naming scheme of the
4297                --  project file. This will avoid to generate an
4298                --  executable "main.2" for a main subprogram
4299                --  "main.2.ada", when the body termination is ".2.ada".
4300
4301                Executable := Prj.Util.Executable_Of
4302                                         (Main_Project, Main_Source_File);
4303             end if;
4304          end if;
4305
4306          if Main_Project /= No_Project then
4307             declare
4308                Exec_File_Name : constant String :=
4309                  Get_Name_String (Executable);
4310
4311             begin
4312                if not Is_Absolute_Path (Exec_File_Name) then
4313                   for Index in Exec_File_Name'Range loop
4314                      if Exec_File_Name (Index) = Directory_Separator then
4315                         Make_Failed ("relative executable (""",
4316                                            Exec_File_Name,
4317                                            """) with directory part not " &
4318                                            "allowed when using project files");
4319                      end if;
4320                   end loop;
4321
4322                   Get_Name_String (Projects.Table
4323                                            (Main_Project).Exec_Directory);
4324
4325                   if
4326                     Name_Buffer (Name_Len) /= Directory_Separator
4327                   then
4328                      Name_Len := Name_Len + 1;
4329                      Name_Buffer (Name_Len) := Directory_Separator;
4330                   end if;
4331
4332                   Name_Buffer (Name_Len + 1 ..
4333                                        Name_Len + Exec_File_Name'Length) :=
4334                       Exec_File_Name;
4335                   Name_Len := Name_Len + Exec_File_Name'Length;
4336                   Executable := Name_Find;
4337                   Non_Std_Executable := True;
4338                end if;
4339             end;
4340
4341          end if;
4342
4343          if Do_Compile_Step then
4344             Recursive_Compilation_Step : declare
4345                Args : Argument_List (1 .. Gcc_Switches.Last);
4346
4347                First_Compiled_File : Name_Id;
4348                Youngest_Obj_File   : Name_Id;
4349                Youngest_Obj_Stamp  : Time_Stamp_Type;
4350
4351                Executable_Stamp : Time_Stamp_Type;
4352                --  Executable is the final executable program.
4353
4354                Library_Rebuilt : Boolean := False;
4355
4356             begin
4357                for J in 1 .. Gcc_Switches.Last loop
4358                   Args (J) := Gcc_Switches.Table (J);
4359                end loop;
4360
4361                --  Now we invoke Compile_Sources for the current main
4362
4363                Compile_Sources
4364                  (Main_Source           => Main_Source_File,
4365                   Args                  => Args,
4366                   First_Compiled_File   => First_Compiled_File,
4367                   Most_Recent_Obj_File  => Youngest_Obj_File,
4368                   Most_Recent_Obj_Stamp => Youngest_Obj_Stamp,
4369                   Main_Unit             => Is_Main_Unit,
4370                   Compilation_Failures  => Compilation_Failures,
4371                   Check_Readonly_Files  => Opt.Check_Readonly_Files,
4372                   Do_Not_Execute        => Opt.Do_Not_Execute,
4373                   Force_Compilations    => Opt.Force_Compilations,
4374                   In_Place_Mode         => Opt.In_Place_Mode,
4375                   Keep_Going            => Opt.Keep_Going,
4376                   Initialize_ALI_Data   => True,
4377                   Max_Process           => Saved_Maximum_Processes);
4378
4379                if Opt.Verbose_Mode then
4380                   Write_Str ("End of compilation");
4381                   Write_Eol;
4382                end if;
4383
4384                --  Make sure the queue will be reinitialized for the next round
4385
4386                First_Q_Initialization := True;
4387
4388                Total_Compilation_Failures :=
4389                  Total_Compilation_Failures + Compilation_Failures;
4390
4391                if Total_Compilation_Failures /= 0 then
4392                   if Opt.Keep_Going then
4393                      goto Next_Main;
4394
4395                   else
4396                      List_Bad_Compilations;
4397                      raise Compilation_Failed;
4398                   end if;
4399                end if;
4400
4401                --  Regenerate libraries, if any, and if object files
4402                --  have been regenerated.
4403
4404                if Main_Project /= No_Project
4405                  and then MLib.Tgt.Support_For_Libraries /= MLib.Tgt.None
4406                  and then (Do_Bind_Step or Unique_Compile_All_Projects
4407                            or not Compile_Only)
4408                  and then (Do_Link_Step or N_File = Osint.Number_Of_Files)
4409                then
4410                   Library_Projs.Init;
4411
4412                   declare
4413                      Proj2   : Project_Id;
4414                      Depth   : Natural;
4415                      Current : Natural;
4416
4417                   begin
4418                      --  Put in Library_Projs table all library project
4419                      --  file ids when the library need to be rebuilt.
4420
4421                      for Proj1 in Projects.First .. Projects.Last loop
4422
4423                         if Projects.Table (Proj1).Library
4424                           and then not Projects.Table (Proj1).Flag1
4425                         then
4426                            MLib.Prj.Check_Library (Proj1);
4427                         end if;
4428
4429                         if Projects.Table (Proj1).Flag1 then
4430                            Library_Projs.Increment_Last;
4431                            Current := Library_Projs.Last;
4432                            Depth := Projects.Table (Proj1).Depth;
4433
4434                            --  Put the projects in decreasing depth order,
4435                            --  so that if libA depends on libB, libB is first
4436                            --  in order.
4437
4438                            while Current > 1 loop
4439                               Proj2 := Library_Projs.Table (Current - 1);
4440                               exit when Projects.Table (Proj2).Depth >= Depth;
4441                               Library_Projs.Table (Current) := Proj2;
4442                               Current := Current - 1;
4443                            end loop;
4444
4445                            Library_Projs.Table (Current) := Proj1;
4446                            Projects.Table (Proj1).Flag1 := False;
4447                         end if;
4448                      end loop;
4449                   end;
4450
4451                   --  Build the libraries, if any need to be built
4452
4453                   for J in 1 .. Library_Projs.Last loop
4454                      Library_Rebuilt := True;
4455                      MLib.Prj.Build_Library
4456                        (For_Project   => Library_Projs.Table (J),
4457                         Gnatbind      => Gnatbind.all,
4458                         Gnatbind_Path => Gnatbind_Path,
4459                         Gcc           => Gcc.all,
4460                         Gcc_Path      => Gcc_Path);
4461                   end loop;
4462                end if;
4463
4464                if Opt.List_Dependencies then
4465                   if First_Compiled_File /= No_File then
4466                      Inform
4467                        (First_Compiled_File,
4468                         "must be recompiled. Can't generate dependence list.");
4469                   else
4470                      List_Depend;
4471                   end if;
4472
4473                elsif First_Compiled_File = No_File
4474                  and then not Do_Bind_Step
4475                  and then not Opt.Quiet_Output
4476                  and then not Library_Rebuilt
4477                  and then Osint.Number_Of_Files = 1
4478                then
4479                   Inform (Msg => "objects up to date.");
4480
4481                elsif Opt.Do_Not_Execute
4482                  and then First_Compiled_File /= No_File
4483                then
4484                   Write_Name (First_Compiled_File);
4485                   Write_Eol;
4486                end if;
4487
4488                --  Stop after compile step if any of:
4489
4490                --    1) -n (Do_Not_Execute) specified
4491
4492                --    2) -M (List_Dependencies) specified (also sets
4493                --       Do_Not_Execute above, so this is probably superfluous).
4494
4495                --    3) -c (Compile_Only) specified, but not -b (Bind_Only)
4496
4497                --    4) Made unit cannot be a main unit
4498
4499                if (Opt.Do_Not_Execute
4500                    or Opt.List_Dependencies
4501                    or not Do_Bind_Step
4502                    or not Is_Main_Unit)
4503                  and then not No_Main_Subprogram
4504                then
4505                   if Osint.Number_Of_Files = 1 then
4506                      exit Multiple_Main_Loop;
4507
4508                   else
4509                      goto Next_Main;
4510                   end if;
4511                end if;
4512
4513                --  If the objects were up-to-date check if the executable file
4514                --  is also up-to-date. For now always bind and link on the JVM
4515                --  since there is currently no simple way to check the
4516                --  up-to-date status of objects
4517
4518                if not Hostparm.Java_VM
4519                  and then First_Compiled_File = No_File
4520                then
4521                   Executable_Stamp    := File_Stamp (Executable);
4522
4523                   if not Executable_Obsolete then
4524                      Executable_Obsolete :=
4525                        Youngest_Obj_Stamp > Executable_Stamp;
4526                   end if;
4527
4528                   if not Executable_Obsolete then
4529                      for Index in reverse 1 .. Dependencies.Last loop
4530                         if Is_In_Obsoleted
4531                              (Dependencies.Table (Index).Depends_On)
4532                         then
4533                            Enter_Into_Obsoleted
4534                              (Dependencies.Table (Index).This);
4535                         end if;
4536                      end loop;
4537
4538                      Executable_Obsolete := Is_In_Obsoleted (Main_Source_File);
4539                      Dependencies.Init;
4540                   end if;
4541
4542                   if not Executable_Obsolete then
4543
4544                      --  If no Ada object files obsolete the executable, check
4545                      --  for younger or missing linker files.
4546
4547                      Check_Linker_Options
4548                        (Executable_Stamp,
4549                         Youngest_Obj_File,
4550                         Youngest_Obj_Stamp);
4551
4552                      Executable_Obsolete := Youngest_Obj_File /= No_File;
4553                   end if;
4554
4555                   --  Return if the executable is up to date
4556                   --  and otherwise motivate the relink/rebind.
4557
4558                   if not Executable_Obsolete then
4559                      if not Opt.Quiet_Output then
4560                         Inform (Executable, "up to date.");
4561                      end if;
4562
4563                      if Osint.Number_Of_Files = 1 then
4564                         exit Multiple_Main_Loop;
4565
4566                      else
4567                         goto Next_Main;
4568                      end if;
4569                   end if;
4570
4571                   if Executable_Stamp (1) = ' ' then
4572                      Verbose_Msg (Executable, "missing.", Prefix => "  ");
4573
4574                   elsif Youngest_Obj_Stamp (1) = ' ' then
4575                      Verbose_Msg
4576                        (Youngest_Obj_File,
4577                         "missing.",
4578                         Prefix => "  ");
4579
4580                   elsif Youngest_Obj_Stamp > Executable_Stamp then
4581                      Verbose_Msg
4582                        (Youngest_Obj_File,
4583                         "(" & String (Youngest_Obj_Stamp) & ") newer than",
4584                         Executable,
4585                         "(" & String (Executable_Stamp) & ")");
4586
4587                   else
4588                      Verbose_Msg
4589                        (Executable, "needs to be rebuild.",
4590                         Prefix => "  ");
4591
4592                   end if;
4593                end if;
4594             end Recursive_Compilation_Step;
4595          end if;
4596
4597          --  If we are here, it means that we need to rebuilt the current
4598          --  main. So we set Executable_Obsolete to True to make sure that
4599          --  the subsequent mains will be rebuilt.
4600
4601          Main_ALI_In_Place_Mode_Step : declare
4602             ALI_File : File_Name_Type;
4603             Src_File : File_Name_Type;
4604
4605          begin
4606             Src_File      := Strip_Directory (Main_Source_File);
4607             ALI_File      := Lib_File_Name (Src_File);
4608             Main_ALI_File := Full_Lib_File_Name (ALI_File);
4609
4610             --  When In_Place_Mode, the library file can be located in the
4611             --  Main_Source_File directory which may not be present in the
4612             --  library path. In this case, use the corresponding library file
4613             --  name.
4614
4615             if Main_ALI_File = No_File and then Opt.In_Place_Mode then
4616                Get_Name_String (Get_Directory (Full_Source_Name (Src_File)));
4617                Get_Name_String_And_Append (ALI_File);
4618                Main_ALI_File := Name_Find;
4619                Main_ALI_File := Full_Lib_File_Name (Main_ALI_File);
4620             end if;
4621
4622             if Main_ALI_File = No_File then
4623                Make_Failed ("could not find the main ALI file");
4624             end if;
4625          end Main_ALI_In_Place_Mode_Step;
4626
4627          if Do_Bind_Step then
4628             Bind_Step : declare
4629                Args : Argument_List
4630                         (Binder_Switches.First .. Binder_Switches.Last + 1);
4631                --  The arguments for the invocation of gnatbind
4632
4633                Last_Arg : Natural := Binder_Switches.Last;
4634                --  Index of the last argument in Args
4635
4636                Mapping_FD : File_Descriptor := Invalid_FD;
4637                --  A File Descriptor for an eventual mapping file
4638
4639                Mapping_Path : Name_Id := No_Name;
4640                --  The path name of the mapping file
4641
4642                ALI_Unit : Name_Id := No_Name;
4643                --  The unit name of an ALI file
4644
4645                ALI_Name : Name_Id := No_Name;
4646                --  The file name of the ALI file
4647
4648                ALI_Project  : Project_Id := No_Project;
4649                --  The project of the ALI file
4650
4651                Bytes : Integer;
4652                OK    : Boolean := True;
4653
4654                Status : Boolean;
4655                --  For call to Close
4656
4657             begin
4658                --  If it is the first time the bind step is performed,
4659                --  check if there are shared libraries, so that gnatbind is
4660                --  called with -shared.
4661
4662                if not Bind_Shared_Known then
4663                   if Main_Project /= No_Project
4664                      and then MLib.Tgt.Support_For_Libraries /= MLib.Tgt.None
4665                   then
4666                      for Proj in Projects.First .. Projects.Last loop
4667                         if Projects.Table (Proj).Library and then
4668                           Projects.Table (Proj).Library_Kind /= Static
4669                         then
4670                            Bind_Shared := Shared_Switch'Access;
4671                            exit;
4672                         end if;
4673                      end loop;
4674                   end if;
4675
4676                   Bind_Shared_Known := True;
4677                end if;
4678
4679                --  Get all the binder switches
4680
4681                for J in Binder_Switches.First .. Last_Arg loop
4682                   Args (J) := Binder_Switches.Table (J);
4683                end loop;
4684
4685                if Main_Project /= No_Project then
4686
4687                   --  Put all the source directories in ADA_INCLUDE_PATH,
4688                   --  and all the object directories in ADA_OBJECTS_PATH
4689
4690                   Prj.Env.Set_Ada_Paths (Main_Project, False);
4691
4692                   --  If switch -C was specified, create a binder mapping file
4693
4694                   if Create_Mapping_File then
4695                      Tempdir.Create_Temp_File (Mapping_FD, Mapping_Path);
4696
4697                      if Mapping_FD /= Invalid_FD then
4698
4699                         --  Traverse all units
4700
4701                         for J in Prj.Com.Units.First .. Prj.Com.Units.Last loop
4702                            declare
4703                               Unit : constant Prj.Com.Unit_Data :=
4704                                        Prj.Com.Units.Table (J);
4705                               use Prj.Com;
4706
4707                            begin
4708                               if Unit.Name /= No_Name then
4709
4710                                  --  If there is a body, put it in the mapping
4711
4712                                  if Unit.File_Names (Body_Part).Name /= No_Name
4713                                    and then Unit.File_Names (Body_Part).Project
4714                                                   /= No_Project
4715                                  then
4716                                     Get_Name_String (Unit.Name);
4717                                     Name_Buffer
4718                                       (Name_Len + 1 .. Name_Len + 2) := "%b";
4719                                     Name_Len := Name_Len + 2;
4720                                     ALI_Unit := Name_Find;
4721                                     ALI_Name :=
4722                                       Lib_File_Name
4723                                         (Unit.File_Names (Body_Part).Name);
4724                                     ALI_Project :=
4725                                       Unit.File_Names (Body_Part).Project;
4726
4727                                  --  Otherwise, if there is a spec, put it
4728                                  --  in the mapping.
4729
4730                                  elsif Unit.File_Names (Specification).Name
4731                                                  /= No_Name
4732                                    and then Unit.File_Names
4733                                              (Specification).Project
4734                                                 /= No_Project
4735                                  then
4736                                     Get_Name_String (Unit.Name);
4737                                     Name_Buffer
4738                                       (Name_Len + 1 .. Name_Len + 2) := "%s";
4739                                     Name_Len := Name_Len + 2;
4740                                     ALI_Unit := Name_Find;
4741                                     ALI_Name := Lib_File_Name
4742                                         (Unit.File_Names (Specification).Name);
4743                                     ALI_Project :=
4744                                       Unit.File_Names (Specification).Project;
4745
4746                                  else
4747                                     ALI_Name := No_Name;
4748                                  end if;
4749
4750                                  --  If we have something to put in the mapping
4751                                  --  then we do it now. However, if the project
4752                                  --  is extended, we don't put anything in the
4753                                  --  mapping file, because we do not know where
4754                                  --  the ALI file is: it might be in the ext-
4755                                  --  ended project obj dir as well as in the
4756                                  --  extending project obj dir.
4757
4758                                  if ALI_Name /= No_Name
4759                                     and then Projects.Table
4760                                                (ALI_Project).Extended_By
4761                                                         = No_Project
4762                                     and then Projects.Table
4763                                                (ALI_Project).Extends
4764                                                         = No_Project
4765                                  then
4766                                     --  First line is the unit name
4767
4768                                     Get_Name_String (ALI_Unit);
4769                                     Name_Len := Name_Len + 1;
4770                                     Name_Buffer (Name_Len) := ASCII.LF;
4771                                     Bytes :=
4772                                       Write
4773                                         (Mapping_FD,
4774                                          Name_Buffer (1)'Address,
4775                                          Name_Len);
4776                                     OK := Bytes = Name_Len;
4777
4778                                     if OK then
4779
4780                                        --  Second line it the ALI file name
4781
4782                                        Get_Name_String (ALI_Name);
4783                                        Name_Len := Name_Len + 1;
4784                                        Name_Buffer (Name_Len) := ASCII.LF;
4785                                        Bytes :=
4786                                          Write
4787                                            (Mapping_FD,
4788                                             Name_Buffer (1)'Address,
4789                                             Name_Len);
4790                                        OK := Bytes = Name_Len;
4791                                     end if;
4792
4793                                     if OK then
4794
4795                                        --  Third line it the ALI path name,
4796                                        --  concatenation of the project
4797                                        --  directory with the ALI file name.
4798
4799                                        declare
4800                                           ALI : constant String :=
4801                                                   Get_Name_String (ALI_Name);
4802                                        begin
4803                                           Get_Name_String
4804                                             (Projects.Table (ALI_Project).
4805                                                Object_Directory);
4806
4807                                           if Name_Buffer (Name_Len) /=
4808                                             Directory_Separator
4809                                           then
4810                                              Name_Len := Name_Len + 1;
4811                                              Name_Buffer (Name_Len) :=
4812                                                Directory_Separator;
4813                                           end if;
4814
4815                                           Name_Buffer
4816                                             (Name_Len + 1 ..
4817                                                Name_Len + ALI'Length) := ALI;
4818                                           Name_Len :=
4819                                             Name_Len + ALI'Length + 1;
4820                                           Name_Buffer (Name_Len) := ASCII.LF;
4821                                           Bytes :=
4822                                             Write
4823                                               (Mapping_FD,
4824                                                Name_Buffer (1)'Address,
4825                                                Name_Len);
4826                                           OK := Bytes = Name_Len;
4827                                        end;
4828                                     end if;
4829
4830                                     --  If OK is False, it means we were unable
4831                                     --  to write a line. No point in continuing
4832                                     --  with the other units.
4833
4834                                     exit when not OK;
4835                                  end if;
4836                               end if;
4837                            end;
4838                         end loop;
4839
4840                         Close (Mapping_FD, Status);
4841
4842                         OK := OK and Status;
4843
4844                         --  If the creation of the mapping file was successful,
4845                         --  we add the switch to the arguments of gnatbind.
4846
4847                         if OK then
4848                            Last_Arg := Last_Arg + 1;
4849                            Args (Last_Arg) := new String'
4850                                       ("-F=" & Get_Name_String (Mapping_Path));
4851                         end if;
4852                      end if;
4853                   end if;
4854
4855                end if;
4856
4857                begin
4858                   Bind (Main_ALI_File,
4859                         Bind_Shared.all & Args (Args'First .. Last_Arg));
4860
4861                exception
4862                   when others =>
4863
4864                      --  If -dn was not specified, delete the temporary mapping
4865                      --  file, if one was created.
4866
4867                      if not Debug.Debug_Flag_N
4868                        and then Mapping_Path /= No_Name
4869                      then
4870                         Delete_File (Get_Name_String (Mapping_Path), OK);
4871                      end if;
4872
4873                      --  And reraise the exception
4874
4875                      raise;
4876                end;
4877
4878                --  If -dn was not specified, delete the temporary mapping file,
4879                --  if one was created.
4880
4881                if not Debug.Debug_Flag_N and then Mapping_Path /= No_Name then
4882                   Delete_File (Get_Name_String (Mapping_Path), OK);
4883                end if;
4884             end Bind_Step;
4885          end if;
4886
4887          if Do_Link_Step then
4888             Link_Step : declare
4889                There_Are_Libraries  : Boolean := False;
4890                Linker_Switches_Last : constant Integer := Linker_Switches.Last;
4891                Path_Option : constant String_Access :=
4892                                MLib.Tgt.Linker_Library_Path_Option;
4893                Current : Natural;
4894                Proj2   : Project_Id;
4895                Depth   : Natural;
4896
4897             begin
4898                if not Run_Path_Option then
4899                   Linker_Switches.Increment_Last;
4900                   Linker_Switches.Table (Linker_Switches.Last) :=
4901                     new String'("-R");
4902                end if;
4903
4904                if Main_Project /= No_Project then
4905                   Library_Paths.Set_Last (0);
4906                   Library_Projs.Init;
4907
4908                   if MLib.Tgt.Support_For_Libraries /= MLib.Tgt.None then
4909                      --  Check for library projects
4910
4911                      for Proj1 in 1 .. Projects.Last loop
4912                         if Proj1 /= Main_Project
4913                           and then Projects.Table (Proj1).Library
4914                         then
4915                            --  Add this project to table Library_Projs
4916
4917                            There_Are_Libraries := True;
4918                            Depth := Projects.Table (Proj1).Depth;
4919                            Library_Projs.Increment_Last;
4920                            Current := Library_Projs.Last;
4921
4922                            --  Any project with a greater depth should be
4923                            --  after this project in the list.
4924
4925                            while Current > 1 loop
4926                               Proj2 := Library_Projs.Table (Current - 1);
4927                               exit when Projects.Table (Proj2).Depth <= Depth;
4928                               Library_Projs.Table (Current) := Proj2;
4929                               Current := Current - 1;
4930                            end loop;
4931
4932                            Library_Projs.Table (Current) := Proj1;
4933
4934                            --  If it is not a static library and path option
4935                            --  is set, add it to the Library_Paths table.
4936
4937                            if Projects.Table (Proj1).Library_Kind /= Static
4938                              and then Path_Option /= null
4939                            then
4940                               Library_Paths.Increment_Last;
4941                               Library_Paths.Table (Library_Paths.Last) :=
4942                                 new String'
4943                                   (Get_Name_String
4944                                        (Projects.Table (Proj1).Library_Dir));
4945                            end if;
4946                         end if;
4947                      end loop;
4948
4949                      for Index in 1 .. Library_Projs.Last loop
4950                         --  Add the -L switch
4951
4952                         Linker_Switches.Increment_Last;
4953                         Linker_Switches.Table (Linker_Switches.Last) :=
4954                           new String'("-L" &
4955                                       Get_Name_String
4956                                         (Projects.Table
4957                                            (Library_Projs.Table (Index)).
4958                                               Library_Dir));
4959
4960                         --  Add the -l switch
4961
4962                         Linker_Switches.Increment_Last;
4963                         Linker_Switches.Table (Linker_Switches.Last) :=
4964                           new String'("-l" &
4965                                       Get_Name_String
4966                                         (Projects.Table
4967                                            (Library_Projs.Table (Index)).
4968                                               Library_Name));
4969                      end loop;
4970                   end if;
4971
4972                   if There_Are_Libraries then
4973
4974                      --  If Path_Option is not null, create the switch
4975                      --  ("-Wl,-rpath," or equivalent) with all the non static
4976                      --  library dirs plus the standard GNAT library dir.
4977                      --  We do that only if Run_Path_Option is True
4978                      --  (not disabled by -R switch).
4979
4980                      if Run_Path_Option and Path_Option /= null then
4981                         declare
4982                            Option : String_Access;
4983                            Length : Natural := Path_Option'Length;
4984                            Current : Natural;
4985
4986                         begin
4987                            for Index in
4988                              Library_Paths.First .. Library_Paths.Last
4989                            loop
4990                               --  Add the length of the library dir plus one
4991                               --  for the directory separator.
4992
4993                               Length :=
4994                                 Length +
4995                                 Library_Paths.Table (Index)'Length + 1;
4996                            end loop;
4997
4998                            --  Finally, add the length of the standard GNAT
4999                            --  library dir.
5000
5001                            Length := Length + MLib.Utl.Lib_Directory'Length;
5002                            Option := new String (1 .. Length);
5003                            Option (1 .. Path_Option'Length) := Path_Option.all;
5004                            Current := Path_Option'Length;
5005
5006                            --  Put each library dir followed by a dir separator
5007
5008                            for Index in
5009                              Library_Paths.First .. Library_Paths.Last
5010                            loop
5011                               Option
5012                                 (Current + 1 ..
5013                                    Current +
5014                                    Library_Paths.Table (Index)'Length) :=
5015                                 Library_Paths.Table (Index).all;
5016                               Current :=
5017                                 Current +
5018                                 Library_Paths.Table (Index)'Length + 1;
5019                               Option (Current) := Path_Separator;
5020                            end loop;
5021
5022                            --  Finally put the standard GNAT library dir
5023
5024                            Option
5025                              (Current + 1 ..
5026                                 Current + MLib.Utl.Lib_Directory'Length) :=
5027                              MLib.Utl.Lib_Directory;
5028
5029                            --  And add the switch to the linker switches
5030
5031                            Linker_Switches.Increment_Last;
5032                            Linker_Switches.Table (Linker_Switches.Last) :=
5033                              Option;
5034                         end;
5035                      end if;
5036
5037                   end if;
5038
5039                   --  Put the object directories in ADA_OBJECTS_PATH
5040
5041                   Prj.Env.Set_Ada_Paths (Main_Project, False);
5042
5043                   --  Check for attributes Linker'Linker_Options in projects
5044                   --  other than the main project
5045
5046                   declare
5047                      Linker_Package : Package_Id;
5048                      Options : Variable_Value;
5049
5050                   begin
5051                      Linker_Opts.Init;
5052
5053                      for Index in 1 .. Projects.Last loop
5054                         if Index /= Main_Project then
5055                            Linker_Package :=
5056                              Prj.Util.Value_Of
5057                                (Name => Name_Linker,
5058                                 In_Packages =>
5059                                   Projects.Table (Index).Decl.Packages);
5060                            Options :=
5061                              Prj.Util.Value_Of
5062                                (Name => Name_Ada,
5063                                 Attribute_Or_Array_Name => Name_Linker_Options,
5064                                 In_Package => Linker_Package);
5065
5066                            --  If attribute is present, add the project with
5067                            --  the attribute to table Linker_Opts.
5068
5069                            if Options /= Nil_Variable_Value then
5070                               Linker_Opts.Increment_Last;
5071                               Linker_Opts.Table (Linker_Opts.Last) :=
5072                                 (Project => Index, Options => Options.Values);
5073                            end if;
5074                         end if;
5075                      end loop;
5076                   end;
5077
5078                   declare
5079                      Opt1    : Linker_Options_Data;
5080                      Opt2    : Linker_Options_Data;
5081                      Depth   : Natural;
5082                      Options : String_List_Id;
5083                      Option  : Name_Id;
5084                   begin
5085                      --  Sort the project by increasing depths
5086
5087                      for Index in 1 .. Linker_Opts.Last loop
5088                         Opt1 := Linker_Opts.Table (Index);
5089                         Depth := Projects.Table (Opt1.Project).Depth;
5090
5091                         for J in Index + 1 .. Linker_Opts.Last loop
5092                            Opt2 := Linker_Opts.Table (J);
5093
5094                            if
5095                              Projects.Table (Opt2.Project).Depth < Depth
5096                            then
5097                               Linker_Opts.Table (Index) := Opt2;
5098                               Linker_Opts.Table (J) := Opt1;
5099                               Opt1 := Opt2;
5100                               Depth :=
5101                                 Projects.Table (Opt1.Project).Depth;
5102                            end if;
5103                         end loop;
5104
5105                         --  If Dir_Path has not been computed for this project,
5106                         --  do it now.
5107
5108                         if Projects.Table (Opt1.Project).Dir_Path = null then
5109                            Projects.Table (Opt1.Project).Dir_Path :=
5110                              new String'
5111                                (Get_Name_String
5112                                   (Projects.Table (Opt1.Project). Directory));
5113                         end if;
5114
5115                         Options := Opt1.Options;
5116
5117                         --  Add each of the options to the linker switches
5118
5119                         while Options /= Nil_String loop
5120                            Option := String_Elements.Table (Options).Value;
5121                            Options := String_Elements.Table (Options).Next;
5122                            Linker_Switches.Increment_Last;
5123                            Linker_Switches.Table (Linker_Switches.Last) :=
5124                              new String'(Get_Name_String (Option));
5125
5126                            --  Object files and -L switches specified with
5127                            --  relative paths and must be converted to
5128                            --  absolute paths.
5129
5130                            Test_If_Relative_Path
5131                              (Switch =>
5132                                 Linker_Switches.Table (Linker_Switches.Last),
5133                               Parent => Projects.Table (Opt1.Project).Dir_Path,
5134                               Including_L_Switch => True);
5135                         end loop;
5136                      end loop;
5137                   end;
5138                end if;
5139
5140                declare
5141                   Args : Argument_List
5142                            (Linker_Switches.First .. Linker_Switches.Last + 2);
5143
5144                   Last_Arg : Integer := Linker_Switches.First - 1;
5145                   Skip     : Boolean := False;
5146
5147                begin
5148                   --  Get all the linker switches
5149
5150                   for J in Linker_Switches.First .. Linker_Switches.Last loop
5151                      if Skip then
5152                         Skip := False;
5153
5154                      elsif Non_Std_Executable
5155                        and then Linker_Switches.Table (J).all = "-o"
5156                      then
5157                         Skip := True;
5158
5159                      else
5160                         Last_Arg := Last_Arg + 1;
5161                         Args (Last_Arg) := Linker_Switches.Table (J);
5162                      end if;
5163                   end loop;
5164
5165                   --  If need be, add the -o switch
5166
5167                   if Non_Std_Executable then
5168                      Last_Arg := Last_Arg + 1;
5169                      Args (Last_Arg) := new String'("-o");
5170                      Last_Arg := Last_Arg + 1;
5171                      Args (Last_Arg) :=
5172                        new String'(Get_Name_String (Executable));
5173                   end if;
5174
5175                   --  And invoke the linker
5176
5177                   begin
5178                      Link (Main_ALI_File, Args (Args'First .. Last_Arg));
5179                      Successful_Links.Increment_Last;
5180                      Successful_Links.Table (Successful_Links.Last) :=
5181                        Main_ALI_File;
5182
5183                   exception
5184                      when Link_Failed =>
5185                         if Osint.Number_Of_Files = 1 or not Opt.Keep_Going then
5186                            raise;
5187
5188                         else
5189                            Write_Line ("*** link failed");
5190                            Failed_Links.Increment_Last;
5191                            Failed_Links.Table (Failed_Links.Last) :=
5192                              Main_ALI_File;
5193                         end if;
5194                   end;
5195                end;
5196
5197                Linker_Switches.Set_Last (Linker_Switches_Last);
5198             end Link_Step;
5199          end if;
5200
5201          --  We go to here when we skip the bind and link steps.
5202
5203          <<Next_Main>>
5204
5205          --  We go to the next main, if we did not process the last one
5206
5207          if N_File < Osint.Number_Of_Files then
5208             Main_Source_File := Next_Main_Source;
5209
5210             if Main_Project /= No_Project then
5211
5212                --  Find the file name of the main unit
5213
5214                declare
5215                   Main_Source_File_Name : constant String :=
5216                                             Get_Name_String (Main_Source_File);
5217
5218                   Main_Unit_File_Name : constant String :=
5219                                           Prj.Env.
5220                                             File_Name_Of_Library_Unit_Body
5221                                               (Name => Main_Source_File_Name,
5222                                                Project => Main_Project,
5223                                                Main_Project_Only =>
5224                                                  not Unique_Compile);
5225
5226                   The_Packages : constant Package_Id :=
5227                     Projects.Table (Main_Project).Decl.Packages;
5228
5229                   Binder_Package : constant Prj.Package_Id :=
5230                                Prj.Util.Value_Of
5231                                  (Name        => Name_Binder,
5232                                   In_Packages => The_Packages);
5233
5234                   Linker_Package : constant Prj.Package_Id :=
5235                                Prj.Util.Value_Of
5236                                  (Name       => Name_Linker,
5237                                  In_Packages => The_Packages);
5238
5239                begin
5240                   --  We fail if we cannot find the main source file
5241                   --  as an immediate source of the main project file.
5242
5243                   if Main_Unit_File_Name = "" then
5244                      Make_Failed ('"' & Main_Source_File_Name,
5245                                   """ is not a unit of project ",
5246                                   Project_File_Name.all & ".");
5247
5248                   else
5249                      --  Remove any directory information from the main
5250                      --  source file name.
5251
5252                      declare
5253                         Pos : Natural := Main_Unit_File_Name'Last;
5254
5255                      begin
5256                         loop
5257                            exit when Pos < Main_Unit_File_Name'First
5258                              or else
5259                              Main_Unit_File_Name (Pos) = Directory_Separator;
5260                            Pos := Pos - 1;
5261                         end loop;
5262
5263                         Name_Len := Main_Unit_File_Name'Last - Pos;
5264
5265                         Name_Buffer (1 .. Name_Len) :=
5266                           Main_Unit_File_Name
5267                           (Pos + 1 .. Main_Unit_File_Name'Last);
5268
5269                         Main_Source_File := Name_Find;
5270                      end;
5271                   end if;
5272
5273                   --  We now deal with the binder and linker switches.
5274                   --  If no project file is used, there is nothing to do
5275                   --  because the binder and linker switches are the same
5276                   --  for all mains.
5277
5278                   --  Reset the tables Binder_Switches and Linker_Switches
5279
5280                   Binder_Switches.Set_Last (Last_Binder_Switch);
5281                   Linker_Switches.Set_Last (Last_Linker_Switch);
5282
5283                   --  Add binder switches from the project file for this main,
5284                   --  if any.
5285
5286                   if Do_Bind_Step and Binder_Package /= No_Package then
5287                      if Opt.Verbose_Mode then
5288                         Write_Str ("Adding binder switches for """);
5289                         Write_Str (Main_Unit_File_Name);
5290                         Write_Line (""".");
5291                      end if;
5292
5293                      Add_Switches
5294                        (File_Name   => Main_Unit_File_Name,
5295                         The_Package => Binder_Package,
5296                         Program     => Binder);
5297                   end if;
5298
5299                   --  Add linker switches from the project file for this main,
5300                   --  if any.
5301
5302                   if Do_Link_Step and Linker_Package /= No_Package then
5303                      if Opt.Verbose_Mode then
5304                         Write_Str ("Adding linker switches for""");
5305                         Write_Str (Main_Unit_File_Name);
5306                         Write_Line (""".");
5307                      end if;
5308
5309                      Add_Switches
5310                        (File_Name   => Main_Unit_File_Name,
5311                         The_Package => Linker_Package,
5312                         Program     => Linker);
5313                   end if;
5314
5315                   --  As we are using a project file, for relative paths we add
5316                   --  the current working directory for any relative path on
5317                   --  the command line and the project directory, for any
5318                   --  relative path in the project file.
5319
5320                   declare
5321                      Dir_Path : constant String_Access :=
5322                        new String'(Get_Name_String
5323                                     (Projects.Table (Main_Project).Directory));
5324                   begin
5325                      for
5326                        J in Last_Binder_Switch + 1 .. Binder_Switches.Last
5327                      loop
5328                         Test_If_Relative_Path
5329                           (Binder_Switches.Table (J),
5330                            Parent => Dir_Path, Including_L_Switch => False);
5331                      end loop;
5332
5333                      for
5334                        J in Last_Linker_Switch + 1 .. Linker_Switches.Last
5335                      loop
5336                         Test_If_Relative_Path
5337                           (Linker_Switches.Table (J), Parent => Dir_Path);
5338                      end loop;
5339                   end;
5340
5341                   --  We now put in the Binder_Switches and Linker_Switches
5342                   --  tables, the binder and linker switches of the command
5343                   --  line that have been put in the Saved_ tables.
5344                   --  These switches will follow the project file switches.
5345
5346                   for J in 1 .. Saved_Binder_Switches.Last loop
5347                      Add_Switch
5348                        (Saved_Binder_Switches.Table (J),
5349                         Binder,
5350                         And_Save => False);
5351                   end loop;
5352
5353                   for J in 1 .. Saved_Linker_Switches.Last loop
5354                      Add_Switch
5355                        (Saved_Linker_Switches.Table (J),
5356                         Linker,
5357                         And_Save => False);
5358                   end loop;
5359                end;
5360             end if;
5361          end if;
5362       end loop Multiple_Main_Loop;
5363
5364       if Failed_Links.Last > 0 then
5365          for Index in 1 .. Successful_Links.Last loop
5366             Write_Str ("Linking of """);
5367             Write_Str (Get_Name_String (Successful_Links.Table (Index)));
5368             Write_Line (""" succeeded.");
5369          end loop;
5370
5371          for Index in 1 .. Failed_Links.Last loop
5372             Write_Str ("Linking of """);
5373             Write_Str (Get_Name_String (Failed_Links.Table (Index)));
5374             Write_Line (""" failed.");
5375          end loop;
5376
5377          if Total_Compilation_Failures = 0 then
5378             raise Compilation_Failed;
5379          end if;
5380       end if;
5381
5382       if Total_Compilation_Failures /= 0 then
5383          List_Bad_Compilations;
5384          raise Compilation_Failed;
5385       end if;
5386
5387       --  Delete the temporary mapping file that was created if we are
5388       --  using project files.
5389
5390       if not Debug.Debug_Flag_N then
5391          Delete_Mapping_Files;
5392          Prj.Env.Delete_All_Path_Files;
5393       end if;
5394
5395       Exit_Program (E_Success);
5396
5397    exception
5398       when Bind_Failed =>
5399          Make_Failed ("*** bind failed.");
5400
5401       when Compilation_Failed =>
5402          if not Debug.Debug_Flag_N then
5403             Delete_Mapping_Files;
5404             Prj.Env.Delete_All_Path_Files;
5405          end if;
5406
5407          Exit_Program (E_Fatal);
5408
5409       when Link_Failed =>
5410          Make_Failed ("*** link failed.");
5411
5412       when X : others =>
5413          Write_Line (Exception_Information (X));
5414          Make_Failed ("INTERNAL ERROR. Please report.");
5415
5416    end Gnatmake;
5417
5418    ----------
5419    -- Hash --
5420    ----------
5421
5422    function Hash (F : Name_Id) return Header_Num is
5423    begin
5424       return Header_Num (1 + F mod Max_Header);
5425    end Hash;
5426
5427    --------------------
5428    -- In_Ada_Lib_Dir --
5429    --------------------
5430
5431    function In_Ada_Lib_Dir (File : File_Name_Type) return Boolean is
5432       D : constant Name_Id := Get_Directory (File);
5433       B : constant Byte    := Get_Name_Table_Byte (D);
5434
5435    begin
5436       return (B and Ada_Lib_Dir) /= 0;
5437    end In_Ada_Lib_Dir;
5438
5439    ------------
5440    -- Inform --
5441    ------------
5442
5443    procedure Inform (N : Name_Id := No_Name; Msg : String) is
5444    begin
5445       Osint.Write_Program_Name;
5446
5447       Write_Str (": ");
5448
5449       if N /= No_Name then
5450          Write_Str ("""");
5451          Write_Name (N);
5452          Write_Str (""" ");
5453       end if;
5454
5455       Write_Str (Msg);
5456       Write_Eol;
5457    end Inform;
5458
5459    -----------------------
5460    -- Init_Mapping_File --
5461    -----------------------
5462
5463    procedure Init_Mapping_File
5464      (Project    : Project_Id;
5465       File_Index : in out Natural)
5466    is
5467       FD : File_Descriptor;
5468
5469       Status : Boolean;
5470       --  For call to Close
5471
5472    begin
5473       --  Increase the index of the last mapping file for this project
5474
5475       Last_Mapping_File_Names (Project) :=
5476         Last_Mapping_File_Names (Project) + 1;
5477
5478       --  If there is a project file, call Create_Mapping_File with
5479       --  the project id.
5480
5481       if Project /= No_Project then
5482          Prj.Env.Create_Mapping_File
5483            (Project,
5484             The_Mapping_File_Names
5485               (Project, Last_Mapping_File_Names (Project)));
5486
5487       --  Otherwise, just create an empty file
5488
5489       else
5490          Tempdir.Create_Temp_File
5491            (FD,
5492             The_Mapping_File_Names
5493               (No_Project, Last_Mapping_File_Names (No_Project)));
5494          if FD = Invalid_FD then
5495             Make_Failed ("disk full");
5496          end if;
5497
5498          Close (FD, Status);
5499
5500          if not Status then
5501             Make_Failed ("disk full");
5502          end if;
5503       end if;
5504
5505       --  And return the index of the newly created file
5506
5507       File_Index := Last_Mapping_File_Names (Project);
5508    end Init_Mapping_File;
5509
5510    ------------
5511    -- Init_Q --
5512    ------------
5513
5514    procedure Init_Q is
5515    begin
5516       First_Q_Initialization := False;
5517       Q_Front := Q.First;
5518       Q.Set_Last (Q.First);
5519    end Init_Q;
5520
5521    ----------------
5522    -- Initialize --
5523    ----------------
5524
5525    procedure Initialize is
5526       Next_Arg : Positive;
5527
5528    begin
5529       --  Override default initialization of Check_Object_Consistency
5530       --  since this is normally False for GNATBIND, but is True for
5531       --  GNATMAKE since we do not need to check source consistency
5532       --  again once GNATMAKE has looked at the sources to check.
5533
5534       Opt.Check_Object_Consistency := True;
5535
5536       --  Package initializations. The order of calls is important here.
5537
5538       Output.Set_Standard_Error;
5539
5540       Gcc_Switches.Init;
5541       Binder_Switches.Init;
5542       Linker_Switches.Init;
5543
5544       Csets.Initialize;
5545       Namet.Initialize;
5546
5547       Snames.Initialize;
5548
5549       Prj.Initialize;
5550
5551       Dependencies.Init;
5552
5553       RTS_Specified := null;
5554
5555       Mains.Delete;
5556
5557       Next_Arg := 1;
5558       Scan_Args : while Next_Arg <= Argument_Count loop
5559          Scan_Make_Arg (Argument (Next_Arg), And_Save => True);
5560          Next_Arg := Next_Arg + 1;
5561       end loop Scan_Args;
5562
5563       if Usage_Requested then
5564          Makeusg;
5565       end if;
5566
5567       --  Test for trailing -P switch
5568
5569       if Project_File_Name_Present and then Project_File_Name = null then
5570          Make_Failed ("project file name missing after -P");
5571
5572       --  Test for trailing -o switch
5573
5574       elsif Opt.Output_File_Name_Present
5575         and then not Output_File_Name_Seen
5576       then
5577          Make_Failed ("output file name missing after -o");
5578
5579       --  Test for trailing -D switch
5580
5581       elsif Opt.Object_Directory_Present
5582         and then not Object_Directory_Seen then
5583          Make_Failed ("object directory missing after -D");
5584       end if;
5585
5586       --  Test for simultaneity of -i and -D
5587
5588       if Object_Directory_Path /= null and then In_Place_Mode then
5589          Make_Failed ("-i and -D cannot be used simutaneously");
5590       end if;
5591
5592       --  Deal with -C= switch
5593
5594       if Gnatmake_Mapping_File /= null then
5595          --  First, check compatibility with other switches
5596
5597          if Project_File_Name /= null then
5598             Make_Failed ("-C= switch is not compatible with -P switch");
5599
5600          elsif Saved_Maximum_Processes > 1 then
5601             Make_Failed ("-C= switch is not compatible with -jnnn switch");
5602          end if;
5603
5604          Fmap.Initialize (Gnatmake_Mapping_File.all);
5605          Add_Switch
5606            ("-gnatem=" & Gnatmake_Mapping_File.all,
5607             Compiler,
5608             And_Save => True);
5609       end if;
5610
5611       if Project_File_Name /= null then
5612
5613          --  A project file was specified by a -P switch
5614
5615          if Opt.Verbose_Mode then
5616             Write_Eol;
5617             Write_Str ("Parsing Project File """);
5618             Write_Str (Project_File_Name.all);
5619             Write_Str (""".");
5620             Write_Eol;
5621          end if;
5622
5623          --  Avoid looking in the current directory for ALI files
5624
5625          --  Opt.Look_In_Primary_Dir := False;
5626
5627          --  Set the project parsing verbosity to whatever was specified
5628          --  by a possible -vP switch.
5629
5630          Prj.Pars.Set_Verbosity (To => Current_Verbosity);
5631
5632          --  Parse the project file.
5633          --  If there is an error, Main_Project will still be No_Project.
5634
5635          Prj.Pars.Parse
5636            (Project           => Main_Project,
5637             Project_File_Name => Project_File_Name.all,
5638             Packages_To_Check => Packages_To_Check_By_Gnatmake);
5639
5640          if Main_Project = No_Project then
5641             Make_Failed ("""", Project_File_Name.all, """ processing failed");
5642          end if;
5643
5644          if Opt.Verbose_Mode then
5645             Write_Eol;
5646             Write_Str ("Parsing of Project File """);
5647             Write_Str (Project_File_Name.all);
5648             Write_Str (""" is finished.");
5649             Write_Eol;
5650          end if;
5651
5652          --  We add the source directories and the object directories
5653          --  to the search paths.
5654
5655          Add_Source_Directories (Main_Project);
5656          Add_Object_Directories (Main_Project);
5657
5658          --  Compute depth of each project
5659
5660          Recursive_Compute_Depth
5661            (Main_Project, Visited => No_Projects, Depth => 0);
5662
5663       else
5664
5665          Osint.Add_Default_Search_Dirs;
5666
5667          --  Source file lookups should be cached for efficiency.
5668          --  Source files are not supposed to change. However, we do that now
5669          --  only if no project file is used; if a project file is used, we
5670          --  do it just after changing the directory to the object directory.
5671
5672          Osint.Source_File_Data (Cache => True);
5673
5674          --  Read gnat.adc file to initialize Fname.UF
5675
5676          Fname.UF.Initialize;
5677
5678          begin
5679             Fname.SF.Read_Source_File_Name_Pragmas;
5680
5681          exception
5682             when Err : SFN_Scan.Syntax_Error_In_GNAT_ADC =>
5683                Make_Failed (Exception_Message (Err));
5684          end;
5685       end if;
5686    end Initialize;
5687
5688    -----------------------------------
5689    -- Insert_Project_Sources_Into_Q --
5690    -----------------------------------
5691
5692    procedure Insert_Project_Sources
5693      (The_Project  : Project_Id;
5694       All_Projects : Boolean;
5695       Into_Q       : Boolean)
5696    is
5697       Put_In_Q : Boolean := Into_Q;
5698       Unit  : Com.Unit_Data;
5699       Sfile : Name_Id;
5700       Extending : constant Boolean :=
5701         Projects.Table (The_Project).Extends /= No_Project;
5702
5703       function Check_Project (P : Project_Id) return Boolean;
5704       --  Returns True if P is The_Project or a project extended by
5705       --  The_Project.
5706
5707       -------------------
5708       -- Check_Project --
5709       -------------------
5710
5711       function Check_Project (P : Project_Id) return Boolean is
5712       begin
5713          if All_Projects or P = The_Project then
5714             return True;
5715          elsif Extending then
5716             declare
5717                Data : Project_Data := Projects.Table (The_Project);
5718
5719             begin
5720                loop
5721                   if P = Data.Extends then
5722                      return True;
5723                   end if;
5724
5725                   Data := Projects.Table (Data.Extends);
5726                   exit when Data.Extends = No_Project;
5727                end loop;
5728             end;
5729          end if;
5730
5731          return False;
5732       end Check_Project;
5733
5734    --  Start of processing of Insert_Project_Sources
5735
5736    begin
5737       --  For all the sources in the project files,
5738
5739       for Id in Com.Units.First .. Com.Units.Last loop
5740          Unit  := Com.Units.Table (Id);
5741          Sfile := No_Name;
5742
5743          --  If there is a source for the body, and the body has not been
5744          --  locally removed,
5745
5746          if Unit.File_Names (Com.Body_Part).Name /= No_Name
5747            and then Unit.File_Names (Com.Body_Part).Path /= Slash
5748          then
5749
5750             --  And it is a source for the specified project
5751
5752             if Check_Project (Unit.File_Names (Com.Body_Part).Project) then
5753
5754                --  If we don't have a spec, we cannot consider the source
5755                --  if it is a subunit
5756
5757                if Unit.File_Names (Com.Specification).Name = No_Name then
5758                   declare
5759                      Src_Ind : Source_File_Index;
5760
5761                      --  Here we are cheating a little bit: we don't want to
5762                      --  use Sinput.L, because it depends on the GNAT tree
5763                      --  (Atree, Sinfo, ...). So, we pretend that it is
5764                      --  a project file, and we use Sinput.P.
5765                      --  Source_File_Is_Subunit is just scanning through
5766                      --  the file until it finds one of the reserved words
5767                      --  separate, procedure, function, generic or package.
5768                      --  Fortunately, these Ada reserved words are also
5769                      --  reserved for project files.
5770
5771                   begin
5772                      Src_Ind := Sinput.P.Load_Project_File
5773                                   (Get_Name_String
5774                                      (Unit.File_Names (Com.Body_Part).Path));
5775
5776                      --  If it is a subunit, discard it
5777
5778                      if Sinput.P.Source_File_Is_Subunit (Src_Ind) then
5779                         Sfile := No_Name;
5780
5781                      else
5782                         Sfile := Unit.File_Names (Com.Body_Part).Name;
5783                      end if;
5784                   end;
5785
5786                else
5787                   Sfile := Unit.File_Names (Com.Body_Part).Name;
5788                end if;
5789             end if;
5790
5791          elsif Unit.File_Names (Com.Specification).Name /= No_Name
5792            and then Unit.File_Names (Com.Specification).Path /= Slash
5793            and then Check_Project (Unit.File_Names (Com.Specification).Project)
5794          then
5795             --  If there is no source for the body, but there is a source
5796             --  for the spec which has not been locally removed, then we take
5797             --  this one.
5798
5799             Sfile := Unit.File_Names (Com.Specification).Name;
5800          end if;
5801
5802          --  If Put_In_Q is True, we insert into the Q
5803
5804          if Put_In_Q then
5805
5806             --  For the first source inserted into the Q, we need
5807             --  to initialize the Q, but not for the subsequent sources.
5808
5809             if First_Q_Initialization then
5810                Init_Q;
5811             end if;
5812
5813             --  And of course, we only insert in the Q if the source
5814             --  is not marked.
5815
5816             if Sfile /= No_Name and then not Is_Marked (Sfile) then
5817                if Opt.Verbose_Mode then
5818                   Write_Str ("Adding """);
5819                   Write_Str (Get_Name_String (Sfile));
5820                   Write_Line (""" to the queue");
5821                end if;
5822
5823                Insert_Q (Sfile);
5824                Mark (Sfile);
5825             end if;
5826
5827          elsif Sfile /= No_Name then
5828
5829             --  If Put_In_Q is False, we add the source as it it were
5830             --  specified on the command line, and we set Put_In_Q to True,
5831             --  so that the following sources will be put directly in the
5832             --  queue. This will allow parallel compilation processes if -jx
5833             --  switch is used.
5834
5835             if Opt.Verbose_Mode then
5836                Write_Str ("Adding """);
5837                Write_Str (Get_Name_String (Sfile));
5838                Write_Line (""" as if on the command line");
5839             end if;
5840
5841             Osint.Add_File (Get_Name_String (Sfile));
5842             Put_In_Q := True;
5843          end if;
5844       end loop;
5845    end Insert_Project_Sources;
5846
5847    --------------
5848    -- Insert_Q --
5849    --------------
5850
5851    procedure Insert_Q
5852      (Source_File : File_Name_Type;
5853       Source_Unit : Unit_Name_Type := No_Name)
5854    is
5855    begin
5856       if Debug.Debug_Flag_Q then
5857          Write_Str ("   Q := Q + [ ");
5858          Write_Name (Source_File);
5859          Write_Str (" ] ");
5860          Write_Eol;
5861       end if;
5862
5863       Q.Table (Q.Last).File := Source_File;
5864       Q.Table (Q.Last).Unit := Source_Unit;
5865       Q.Increment_Last;
5866    end Insert_Q;
5867
5868    ----------------------------
5869    -- Is_External_Assignment --
5870    ----------------------------
5871
5872    function Is_External_Assignment (Argv : String) return Boolean is
5873       Start     : Positive := 3;
5874       Finish    : Natural := Argv'Last;
5875       Equal_Pos : Natural;
5876
5877    begin
5878       if Argv'Last < 5 then
5879          return False;
5880
5881       elsif Argv (3) = '"' then
5882          if Argv (Argv'Last) /= '"' or else Argv'Last < 7 then
5883             return False;
5884          else
5885             Start := 4;
5886             Finish := Argv'Last - 1;
5887          end if;
5888       end if;
5889
5890       Equal_Pos := Start;
5891
5892       while Equal_Pos <= Finish and then Argv (Equal_Pos) /= '=' loop
5893          Equal_Pos := Equal_Pos + 1;
5894       end loop;
5895
5896       if Equal_Pos = Start
5897         or else Equal_Pos >= Finish
5898       then
5899          return False;
5900
5901       else
5902          Prj.Ext.Add
5903            (External_Name => Argv (Start .. Equal_Pos - 1),
5904             Value         => Argv (Equal_Pos + 1 .. Finish));
5905          return True;
5906       end if;
5907    end Is_External_Assignment;
5908
5909    ---------------------
5910    -- Is_In_Obsoleted --
5911    ---------------------
5912
5913    function Is_In_Obsoleted (F : Name_Id) return Boolean is
5914    begin
5915       if F = No_File then
5916          return False;
5917
5918       else
5919          declare
5920             Name  : String := Get_Name_String (F);
5921             First : Natural := Name'Last;
5922             F2    : Name_Id := F;
5923
5924          begin
5925             while First > Name'First
5926               and then Name (First - 1) /= Directory_Separator
5927               and then Name (First - 1) /= '/'
5928             loop
5929                First := First - 1;
5930             end loop;
5931
5932             if First /= Name'First then
5933                Name_Len := 0;
5934                Add_Str_To_Name_Buffer (Name (First .. Name'Last));
5935                F2 := Name_Find;
5936             end if;
5937
5938             return Obsoleted.Get (F2);
5939          end;
5940       end if;
5941    end Is_In_Obsoleted;
5942
5943    ----------------------------
5944    -- Is_In_Object_Directory --
5945    ----------------------------
5946
5947    function Is_In_Object_Directory
5948      (Source_File   : File_Name_Type;
5949       Full_Lib_File : File_Name_Type) return Boolean
5950    is
5951    begin
5952       --  There is something to check only when using project files.
5953       --  Otherwise, this function returns True (last line of the function).
5954
5955       if Main_Project /= No_Project then
5956          declare
5957             Source_File_Name : constant String :=
5958                                  Get_Name_String (Source_File);
5959             Saved_Verbosity  : constant Verbosity := Prj.Com.Current_Verbosity;
5960             Project          : Project_Id := No_Project;
5961             Path_Name        : Name_Id := No_Name;
5962             Data             : Project_Data;
5963
5964          begin
5965             --  Call Get_Reference to know the ultimate extending project of
5966             --  the source. Call it with verbosity default to avoid verbose
5967             --  messages.
5968
5969             Prj.Com.Current_Verbosity := Default;
5970             Prj.Env.
5971               Get_Reference
5972               (Source_File_Name => Source_File_Name,
5973                Project          => Project,
5974                Path             => Path_Name);
5975             Prj.Com.Current_Verbosity := Saved_Verbosity;
5976
5977             --  If this source is in a project, check that the ALI file is
5978             --  in its object directory. If it is not, return False, so that
5979             --  the ALI file will not be skipped.
5980
5981             --  If the source is not in an extending project, we fall back to
5982             --  the general case and return True at the end of the function.
5983
5984             if Project /= No_Project
5985               and then Projects.Table (Project).Extends /= No_Project
5986             then
5987                Data := Projects.Table (Project);
5988
5989                declare
5990                   Object_Directory : constant String :=
5991                                        Normalize_Pathname
5992                                          (Get_Name_String
5993                                            (Data.Object_Directory));
5994
5995                   Olast : Natural := Object_Directory'Last;
5996
5997                   Lib_File_Directory : constant String :=
5998                                          Normalize_Pathname (Dir_Name
5999                                            (Get_Name_String (Full_Lib_File)));
6000
6001                   Llast : Natural := Lib_File_Directory'Last;
6002
6003                begin
6004                   --  For directories, Normalize_Pathname may or may not put
6005                   --  a directory separator at the end, depending on its input.
6006                   --  Remove any last directory separator before comparaison.
6007                   --  Returns True only if the two directories are the same.
6008
6009                   if Object_Directory (Olast) = Directory_Separator then
6010                      Olast := Olast - 1;
6011                   end if;
6012
6013                   if Lib_File_Directory (Llast) = Directory_Separator then
6014                      Llast := Llast - 1;
6015                   end if;
6016
6017                   return Object_Directory (Object_Directory'First .. Olast) =
6018                         Lib_File_Directory (Lib_File_Directory'First .. Llast);
6019                end;
6020             end if;
6021          end;
6022       end if;
6023
6024       --  When the source is not in a project file, always return True
6025
6026       return True;
6027    end Is_In_Object_Directory;
6028
6029    ---------------
6030    -- Is_Marked --
6031    ---------------
6032
6033    function Is_Marked (Source_File : File_Name_Type) return Boolean is
6034    begin
6035       return Get_Name_Table_Byte (Source_File) /= 0;
6036    end Is_Marked;
6037
6038    ----------
6039    -- Link --
6040    ----------
6041
6042    procedure Link (ALI_File : File_Name_Type; Args : Argument_List) is
6043       Link_Args : Argument_List (1 .. Args'Length + 1);
6044       Success   : Boolean;
6045
6046    begin
6047       Get_Name_String (ALI_File);
6048       Link_Args (1) := new String'(Name_Buffer (1 .. Name_Len));
6049
6050       Link_Args (2 .. Args'Length + 1) :=  Args;
6051
6052       GNAT.OS_Lib.Normalize_Arguments (Link_Args);
6053
6054       Display (Gnatlink.all, Link_Args);
6055
6056       if Gnatlink_Path = null then
6057          Make_Failed ("error, unable to locate ", Gnatlink.all);
6058       end if;
6059
6060       GNAT.OS_Lib.Spawn (Gnatlink_Path.all, Link_Args, Success);
6061
6062       if not Success then
6063          raise Link_Failed;
6064       end if;
6065    end Link;
6066
6067    ---------------------------
6068    -- List_Bad_Compilations --
6069    ---------------------------
6070
6071    procedure List_Bad_Compilations is
6072    begin
6073       for J in Bad_Compilation.First .. Bad_Compilation.Last loop
6074          if Bad_Compilation.Table (J).File = No_File then
6075             null;
6076          elsif not Bad_Compilation.Table (J).Found then
6077             Inform (Bad_Compilation.Table (J).File, "not found");
6078          else
6079             Inform (Bad_Compilation.Table (J).File, "compilation error");
6080          end if;
6081       end loop;
6082    end List_Bad_Compilations;
6083
6084    -----------------
6085    -- List_Depend --
6086    -----------------
6087
6088    procedure List_Depend is
6089       Lib_Name  : Name_Id;
6090       Obj_Name  : Name_Id;
6091       Src_Name  : Name_Id;
6092
6093       Len       : Natural;
6094       Line_Pos  : Natural;
6095       Line_Size : constant := 77;
6096
6097    begin
6098       Set_Standard_Output;
6099
6100       for A in ALIs.First .. ALIs.Last loop
6101          Lib_Name := ALIs.Table (A).Afile;
6102
6103          --  We have to provide the full library file name in In_Place_Mode
6104
6105          if Opt.In_Place_Mode then
6106             Lib_Name := Full_Lib_File_Name (Lib_Name);
6107          end if;
6108
6109          Obj_Name := Object_File_Name (Lib_Name);
6110          Write_Name (Obj_Name);
6111          Write_Str (" :");
6112
6113          Get_Name_String (Obj_Name);
6114          Len := Name_Len;
6115          Line_Pos := Len + 2;
6116
6117          for D in ALIs.Table (A).First_Sdep .. ALIs.Table (A).Last_Sdep loop
6118             Src_Name := Sdep.Table (D).Sfile;
6119
6120             if Is_Internal_File_Name (Src_Name)
6121               and then not Check_Readonly_Files
6122             then
6123                null;
6124             else
6125                if not Opt.Quiet_Output then
6126                   Src_Name := Full_Source_Name (Src_Name);
6127                end if;
6128
6129                Get_Name_String (Src_Name);
6130                Len := Name_Len;
6131
6132                if Line_Pos + Len + 1 > Line_Size then
6133                   Write_Str (" \");
6134                   Write_Eol;
6135                   Line_Pos := 0;
6136                end if;
6137
6138                Line_Pos := Line_Pos + Len + 1;
6139
6140                Write_Str (" ");
6141                Write_Name (Src_Name);
6142             end if;
6143          end loop;
6144
6145          Write_Eol;
6146       end loop;
6147
6148       Set_Standard_Error;
6149    end List_Depend;
6150
6151    -----------
6152    -- Mains --
6153    -----------
6154
6155    package body Mains is
6156
6157       package Names is new Table.Table
6158         (Table_Component_Type => File_Name_Type,
6159          Table_Index_Type     => Integer,
6160          Table_Low_Bound      => 1,
6161          Table_Initial        => 10,
6162          Table_Increment      => 100,
6163          Table_Name           => "Make.Mains.Names");
6164       --  The table that stores the main
6165
6166       Current : Natural := 0;
6167       --  The index of the last main retrieved from the table
6168
6169       --------------
6170       -- Add_Main --
6171       --------------
6172
6173       procedure Add_Main (Name : String) is
6174       begin
6175          Name_Len := 0;
6176          Add_Str_To_Name_Buffer (Name);
6177          Names.Increment_Last;
6178          Names.Table (Names.Last) := Name_Find;
6179       end Add_Main;
6180
6181       ------------
6182       -- Delete --
6183       ------------
6184
6185       procedure Delete is
6186       begin
6187          Names.Set_Last (0);
6188          Reset;
6189       end Delete;
6190
6191       ---------------
6192       -- Next_Main --
6193       ---------------
6194
6195       function Next_Main return String is
6196       begin
6197          if Current >= Names.Last then
6198             return "";
6199
6200          else
6201             Current := Current + 1;
6202             return Get_Name_String (Names.Table (Current));
6203          end if;
6204       end Next_Main;
6205
6206       procedure Reset is
6207       begin
6208          Current := 0;
6209       end Reset;
6210
6211    end Mains;
6212
6213    ----------
6214    -- Mark --
6215    ----------
6216
6217    procedure Mark (Source_File : File_Name_Type) is
6218    begin
6219       Set_Name_Table_Byte (Source_File, 1);
6220    end Mark;
6221
6222    --------------------
6223    -- Mark_Directory --
6224    --------------------
6225
6226    procedure Mark_Directory
6227      (Dir  : String;
6228       Mark : Lib_Mark_Type)
6229    is
6230       N : Name_Id;
6231       B : Byte;
6232
6233    begin
6234       --  Dir last character is supposed to be a directory separator.
6235
6236       Name_Len := Dir'Length;
6237       Name_Buffer (1 .. Name_Len) := Dir;
6238
6239       if not Is_Directory_Separator (Name_Buffer (Name_Len)) then
6240          Name_Len := Name_Len + 1;
6241          Name_Buffer (Name_Len) := Directory_Separator;
6242       end if;
6243
6244       --  Add flags to the already existing flags
6245
6246       N := Name_Find;
6247       B := Get_Name_Table_Byte (N);
6248       Set_Name_Table_Byte (N, B or Mark);
6249    end Mark_Directory;
6250
6251    -----------------------------
6252    -- Recursive_Compute_Depth --
6253    -----------------------------
6254
6255    procedure Recursive_Compute_Depth
6256      (Project : Project_Id;
6257       Visited : Project_Array;
6258       Depth   : Natural)
6259    is
6260       List : Project_List;
6261       Proj : Project_Id;
6262       OK : Boolean;
6263       New_Visited : constant Project_Array := Visited & Project;
6264
6265    begin
6266       --  Nothing to do if there is no project
6267
6268       if Project = No_Project then
6269          return;
6270       end if;
6271
6272       --  If current depth of project is lower than Depth, adjust it
6273
6274       if Projects.Table (Project).Depth < Depth then
6275          Projects.Table (Project).Depth := Depth;
6276       end if;
6277
6278       List := Projects.Table (Project).Imported_Projects;
6279
6280       --  Visit each imported project
6281
6282       while List /= Empty_Project_List loop
6283          Proj := Project_Lists.Table (List).Project;
6284          List := Project_Lists.Table (List).Next;
6285
6286          OK := True;
6287
6288          --  To avoid endless loops due to cycles with limited widts,
6289          --  do not revisit a project that is already in the chain of imports
6290          --  that brought us here.
6291
6292          for J in Visited'Range loop
6293             if Visited (J) = Proj then
6294                OK := False;
6295                exit;
6296             end if;
6297          end loop;
6298
6299          if OK then
6300             Recursive_Compute_Depth
6301               (Project => Proj,
6302                Visited => New_Visited,
6303                Depth => Depth + 1);
6304          end if;
6305       end loop;
6306
6307       --  Visit a project being extended, if any
6308
6309       Recursive_Compute_Depth
6310         (Project => Projects.Table (Project).Extends,
6311          Visited => New_Visited,
6312          Depth => Depth + 1);
6313    end Recursive_Compute_Depth;
6314
6315    -----------------------
6316    -- Sigint_Intercpted --
6317    -----------------------
6318
6319    procedure Sigint_Intercepted is
6320    begin
6321       Write_Line ("*** Interrupted ***");
6322       Delete_All_Temp_Files;
6323       OS_Exit (1);
6324    end Sigint_Intercepted;
6325
6326    -------------------
6327    -- Scan_Make_Arg --
6328    -------------------
6329
6330    procedure Scan_Make_Arg (Argv : String; And_Save : Boolean) is
6331    begin
6332       pragma Assert (Argv'First = 1);
6333
6334       if Argv'Length = 0 then
6335          return;
6336       end if;
6337
6338       --  If the previous switch has set the Project_File_Name_Present
6339       --  flag (that is we have seen a -P alone), then the next argument is
6340       --  the name of the project file.
6341
6342       if Project_File_Name_Present and then Project_File_Name = null then
6343          if Argv (1) = '-' then
6344             Make_Failed ("project file name missing after -P");
6345
6346          else
6347             Project_File_Name_Present := False;
6348             Project_File_Name := new String'(Argv);
6349          end if;
6350
6351       --  If the previous switch has set the Output_File_Name_Present
6352       --  flag (that is we have seen a -o), then the next argument is
6353       --  the name of the output executable.
6354
6355       elsif Opt.Output_File_Name_Present
6356         and then not Output_File_Name_Seen
6357       then
6358          Output_File_Name_Seen := True;
6359
6360          if Argv (1) = '-' then
6361             Make_Failed ("output file name missing after -o");
6362
6363          else
6364             Add_Switch ("-o", Linker, And_Save => And_Save);
6365
6366             --  Automatically add the executable suffix if it has not been
6367             --  specified explicitly.
6368
6369             if Executable_Suffix'Length /= 0
6370               and then (Argv'Length <= Executable_Suffix'Length
6371                         or else Argv (Argv'Last - Executable_Suffix'Length + 1
6372                                         .. Argv'Last) /= Executable_Suffix)
6373             then
6374                Add_Switch
6375                  (Argv & Executable_Suffix,
6376                   Linker,
6377                   And_Save => And_Save);
6378             else
6379                Add_Switch (Argv, Linker, And_Save => And_Save);
6380             end if;
6381          end if;
6382
6383       --  If the previous switch has set the Object_Directory_Present flag
6384       --  (that is we have seen a -D), then the next argument is
6385       --  the path name of the object directory..
6386
6387       elsif Opt.Object_Directory_Present
6388         and then not Object_Directory_Seen
6389       then
6390          Object_Directory_Seen := True;
6391
6392          if Argv (1) = '-' then
6393             Make_Failed ("object directory path name missing after -D");
6394
6395          elsif not Is_Directory (Argv) then
6396             Make_Failed ("cannot find object directory """, Argv, """");
6397
6398          else
6399             Add_Lib_Search_Dir (Argv);
6400
6401             --  Specify the object directory to the binder
6402
6403             Add_Switch ("-aO" & Argv, Binder, And_Save => And_Save);
6404
6405             --  Record the object directory. Make sure it ends with a directory
6406             --  separator.
6407
6408             if Argv (Argv'Last) = Directory_Separator then
6409                Object_Directory_Path := new String'(Argv);
6410
6411             else
6412                Object_Directory_Path :=
6413                  new String'(Argv & Directory_Separator);
6414             end if;
6415          end if;
6416
6417       --  Then check if we are dealing with -cargs/-bargs/-largs/-margs
6418
6419       elsif Argv = "-bargs"
6420               or else
6421             Argv = "-cargs"
6422               or else
6423             Argv = "-largs"
6424               or else
6425             Argv = "-margs"
6426       then
6427          case Argv (2) is
6428             when 'c' => Program_Args := Compiler;
6429             when 'b' => Program_Args := Binder;
6430             when 'l' => Program_Args := Linker;
6431             when 'm' => Program_Args := None;
6432
6433             when others =>
6434                raise Program_Error;
6435          end case;
6436
6437       --  A special test is needed for the -o switch within a -largs
6438       --  since that is another way to specify the name of the final
6439       --  executable.
6440
6441       elsif Program_Args = Linker
6442         and then Argv = "-o"
6443       then
6444          Make_Failed ("switch -o not allowed within a -largs. " &
6445                       "Use -o directly.");
6446
6447       --  Check to see if we are reading switches after a -cargs,
6448       --  -bargs or -largs switch. If yes save it.
6449
6450       elsif Program_Args /= None then
6451
6452          --  Check to see if we are reading -I switches in order
6453          --  to take into account in the src & lib search directories.
6454
6455          if Argv'Length > 2 and then Argv (1 .. 2) = "-I" then
6456             if Argv (3 .. Argv'Last) = "-" then
6457                Opt.Look_In_Primary_Dir := False;
6458
6459             elsif Program_Args = Compiler then
6460                if Argv (3 .. Argv'Last) /= "-" then
6461                   Add_Src_Search_Dir (Argv (3 .. Argv'Last));
6462                end if;
6463
6464             elsif Program_Args = Binder then
6465                Add_Lib_Search_Dir (Argv (3 .. Argv'Last));
6466             end if;
6467          end if;
6468
6469          Add_Switch (Argv, Program_Args, And_Save => And_Save);
6470
6471       --  Handle non-default compiler, binder, linker, and handle --RTS switch
6472
6473       elsif Argv'Length > 2 and then Argv (1 .. 2) = "--" then
6474          if Argv'Length > 6
6475            and then Argv (1 .. 6) = "--GCC="
6476          then
6477             declare
6478                Program_Args : constant Argument_List_Access :=
6479                                 Argument_String_To_List
6480                                   (Argv (7 .. Argv'Last));
6481
6482             begin
6483                if And_Save then
6484                   Saved_Gcc := new String'(Program_Args.all (1).all);
6485                else
6486                   Gcc := new String'(Program_Args.all (1).all);
6487                end if;
6488
6489                for J in 2 .. Program_Args.all'Last loop
6490                   Add_Switch
6491                     (Program_Args.all (J).all,
6492                      Compiler,
6493                      And_Save => And_Save);
6494                end loop;
6495             end;
6496
6497          elsif Argv'Length > 11
6498            and then Argv (1 .. 11) = "--GNATBIND="
6499          then
6500             declare
6501                Program_Args : constant Argument_List_Access :=
6502                                 Argument_String_To_List
6503                                   (Argv (12 .. Argv'Last));
6504
6505             begin
6506                if And_Save then
6507                   Saved_Gnatbind := new String'(Program_Args.all (1).all);
6508                else
6509                   Gnatbind := new String'(Program_Args.all (1).all);
6510                end if;
6511
6512                for J in 2 .. Program_Args.all'Last loop
6513                   Add_Switch
6514                     (Program_Args.all (J).all, Binder, And_Save => And_Save);
6515                end loop;
6516             end;
6517
6518          elsif Argv'Length > 11
6519            and then Argv (1 .. 11) = "--GNATLINK="
6520          then
6521             declare
6522                Program_Args : constant Argument_List_Access :=
6523                                 Argument_String_To_List
6524                                   (Argv (12 .. Argv'Last));
6525             begin
6526                if And_Save then
6527                   Saved_Gnatlink := new String'(Program_Args.all (1).all);
6528                else
6529                   Gnatlink := new String'(Program_Args.all (1).all);
6530                end if;
6531
6532                for J in 2 .. Program_Args.all'Last loop
6533                   Add_Switch (Program_Args.all (J).all, Linker);
6534                end loop;
6535             end;
6536
6537          elsif Argv'Length >= 5 and then
6538            Argv (1 .. 5) = "--RTS"
6539          then
6540             Add_Switch (Argv, Compiler, And_Save => And_Save);
6541             Add_Switch (Argv, Binder, And_Save => And_Save);
6542             Add_Switch (Argv, Linker, And_Save => And_Save);
6543
6544             if Argv'Length <= 6 or else Argv (6) /= '=' then
6545                Make_Failed ("missing path for --RTS");
6546
6547             else
6548                --  Check that this is the first time we see this switch or
6549                --  if it is not the first time, the same path is specified.
6550
6551                if RTS_Specified = null then
6552                   RTS_Specified := new String'(Argv (7 .. Argv'Last));
6553
6554                elsif RTS_Specified.all /= Argv (7 .. Argv'Last) then
6555                   Make_Failed ("--RTS cannot be specified multiple times");
6556                end if;
6557
6558                --  Valid --RTS switch
6559
6560                Opt.No_Stdinc := True;
6561                Opt.No_Stdlib := True;
6562                Opt.RTS_Switch := True;
6563
6564                declare
6565                   Src_Path_Name : constant String_Ptr :=
6566                                     Get_RTS_Search_Dir
6567                                       (Argv (7 .. Argv'Last), Include);
6568
6569                   Lib_Path_Name : constant String_Ptr :=
6570                                     Get_RTS_Search_Dir
6571                                       (Argv (7 .. Argv'Last), Objects);
6572
6573                begin
6574                   if Src_Path_Name /= null and then
6575                     Lib_Path_Name /= null
6576                   then
6577                      --  Set the RTS_*_Path_Name variables, so that the correct
6578                      --  directories will be set when
6579                      --  Osint.Add_Default_Search_Dirs will be called later.
6580
6581                      RTS_Src_Path_Name := Src_Path_Name;
6582                      RTS_Lib_Path_Name := Lib_Path_Name;
6583
6584                   elsif  Src_Path_Name = null
6585                     and Lib_Path_Name = null then
6586                      Make_Failed ("RTS path not valid: missing " &
6587                                   "adainclude and adalib directories");
6588
6589                   elsif Src_Path_Name = null then
6590                      Make_Failed ("RTS path not valid: missing adainclude " &
6591                                   "directory");
6592
6593                   elsif  Lib_Path_Name = null then
6594                      Make_Failed ("RTS path not valid: missing adalib " &
6595                                   "directory");
6596                   end if;
6597                end;
6598             end if;
6599
6600          else
6601             Make_Failed ("unknown switch: ", Argv);
6602          end if;
6603
6604       --  If we have seen a regular switch process it
6605
6606       elsif Argv (1) = '-' then
6607
6608          if Argv'Length = 1 then
6609             Make_Failed ("switch character cannot be followed by a blank");
6610
6611          --  -I-
6612
6613          elsif Argv (2 .. Argv'Last) = "I-" then
6614             Opt.Look_In_Primary_Dir := False;
6615
6616          --  Forbid  -?-  or  -??-  where ? is any character
6617
6618          elsif (Argv'Length = 3 and then Argv (3) = '-')
6619            or else (Argv'Length = 4 and then Argv (4) = '-')
6620          then
6621             Make_Failed ("trailing ""-"" at the end of ", Argv, " forbidden.");
6622
6623          --  -Idir
6624
6625          elsif Argv (2) = 'I' then
6626             Add_Src_Search_Dir (Argv (3 .. Argv'Last));
6627             Add_Lib_Search_Dir (Argv (3 .. Argv'Last));
6628             Add_Switch (Argv, Compiler, And_Save => And_Save);
6629             Add_Switch (Argv, Binder, And_Save => And_Save);
6630
6631          --  -aIdir (to gcc this is like a -I switch)
6632
6633          elsif Argv'Length >= 3 and then Argv (2 .. 3) = "aI" then
6634             Add_Src_Search_Dir (Argv (4 .. Argv'Last));
6635             Add_Switch ("-I" & Argv (4 .. Argv'Last),
6636                         Compiler,
6637                         And_Save => And_Save);
6638             Add_Switch (Argv, Binder, And_Save => And_Save);
6639
6640          --  -aOdir
6641
6642          elsif Argv'Length >= 3 and then Argv (2 .. 3) = "aO" then
6643             Add_Lib_Search_Dir (Argv (4 .. Argv'Last));
6644             Add_Switch (Argv, Binder, And_Save => And_Save);
6645
6646          --  -aLdir (to gnatbind this is like a -aO switch)
6647
6648          elsif Argv'Length >= 3 and then Argv (2 .. 3) = "aL" then
6649             Mark_Directory (Argv (4 .. Argv'Last), Ada_Lib_Dir);
6650             Add_Lib_Search_Dir (Argv (4 .. Argv'Last));
6651             Add_Switch ("-aO" & Argv (4 .. Argv'Last),
6652                         Binder,
6653                         And_Save => And_Save);
6654
6655          --  -Adir (to gnatbind this is like a -aO switch, to gcc like a -I)
6656
6657          elsif Argv (2) = 'A' then
6658             Mark_Directory (Argv (3 .. Argv'Last), Ada_Lib_Dir);
6659             Add_Src_Search_Dir (Argv (3 .. Argv'Last));
6660             Add_Lib_Search_Dir (Argv (3 .. Argv'Last));
6661             Add_Switch ("-I"  & Argv (3 .. Argv'Last),
6662                         Compiler,
6663                         And_Save => And_Save);
6664             Add_Switch ("-aO" & Argv (3 .. Argv'Last),
6665                         Binder,
6666                         And_Save => And_Save);
6667
6668          --  -Ldir
6669
6670          elsif Argv (2) = 'L' then
6671             Add_Switch (Argv, Linker, And_Save => And_Save);
6672
6673          --  For -gxxxxx,-pg,-mxxx: give the switch to both the compiler and
6674          --  the linker (except for -gnatxxx which is only for the compiler)
6675
6676          elsif
6677            (Argv (2) = 'g' and then (Argv'Last < 5
6678                                        or else Argv (2 .. 5) /= "gnat"))
6679              or else Argv (2 .. Argv'Last) = "pg"
6680              or else (Argv (2) = 'm' and then Argv'Last > 2)
6681          then
6682             Add_Switch (Argv, Compiler, And_Save => And_Save);
6683             Add_Switch (Argv, Linker, And_Save => And_Save);
6684
6685          --  -C=<mapping file>
6686
6687          elsif Argv'Last > 2 and then Argv (2) = 'C' then
6688             if And_Save then
6689                if Argv (3) /= '=' or else Argv'Last <= 3 then
6690                   Make_Failed ("illegal switch ", Argv);
6691                end if;
6692
6693                Gnatmake_Mapping_File := new String'(Argv (4 .. Argv'Last));
6694             end if;
6695
6696          --  -D
6697
6698          elsif Argv'Last = 2 and then Argv (2) = 'D' then
6699             if Project_File_Name /= null then
6700                Make_Failed ("-D cannot be used in conjunction with a " &
6701                             "project file");
6702
6703             else
6704                Scan_Make_Switches (Argv);
6705             end if;
6706
6707          --  -d
6708
6709          elsif Argv (2) = 'd'
6710            and then Argv'Last = 2
6711          then
6712             Opt.Display_Compilation_Progress := True;
6713
6714          --  -i
6715
6716          elsif Argv'Last = 2 and then Argv (2) = 'i' then
6717             if Project_File_Name /= null then
6718                Make_Failed ("-i cannot be used in conjunction with a " &
6719                             "project file");
6720
6721             else
6722                Scan_Make_Switches (Argv);
6723             end if;
6724
6725          --  -j (need to save the result)
6726
6727          elsif Argv (2) = 'j' then
6728             Scan_Make_Switches (Argv);
6729
6730             if And_Save then
6731                Saved_Maximum_Processes := Maximum_Processes;
6732             end if;
6733
6734          --  -m
6735
6736          elsif Argv (2) = 'm'
6737            and then Argv'Last = 2
6738          then
6739             Opt.Minimal_Recompilation := True;
6740
6741          --  -u
6742
6743          elsif Argv (2) = 'u'
6744            and then Argv'Last = 2
6745          then
6746             Unique_Compile   := True;
6747             Opt.Compile_Only := True;
6748             Do_Bind_Step     := False;
6749             Do_Link_Step     := False;
6750
6751          --  -U
6752
6753          elsif Argv (2) = 'U'
6754            and then Argv'Last = 2
6755          then
6756             Unique_Compile_All_Projects := True;
6757             Unique_Compile   := True;
6758             Opt.Compile_Only := True;
6759             Do_Bind_Step     := False;
6760             Do_Link_Step     := False;
6761
6762          --  -Pprj or -P prj (only once, and only on the command line)
6763
6764          elsif Argv (2) = 'P' then
6765             if Project_File_Name /= null then
6766                Make_Failed ("cannot have several project files specified");
6767
6768             elsif Object_Directory_Path /= null then
6769                Make_Failed ("-D cannot be used in conjunction with a " &
6770                             "project file");
6771
6772             elsif In_Place_Mode then
6773                Make_Failed ("-i cannot be used in conjunction with a " &
6774                             "project file");
6775
6776             elsif not And_Save then
6777
6778                --  It could be a tool other than gnatmake (i.e, gnatdist)
6779                --  or a -P switch inside a project file.
6780
6781                Fail
6782                  ("either the tool is not ""project-aware"" or " &
6783                   "a project file is specified inside a project file");
6784
6785             elsif Argv'Last = 2 then
6786
6787                --  -P is used alone: the project file name is the next option
6788
6789                Project_File_Name_Present := True;
6790
6791             else
6792                Project_File_Name := new String'(Argv (3 .. Argv'Last));
6793             end if;
6794
6795          --  -vPx  (verbosity of the parsing of the project files)
6796
6797          elsif Argv'Last = 4
6798            and then Argv (2 .. 3) = "vP"
6799            and then Argv (4) in '0' .. '2'
6800          then
6801             if And_Save then
6802                case Argv (4) is
6803                   when '0' =>
6804                      Current_Verbosity := Prj.Default;
6805                   when '1' =>
6806                      Current_Verbosity := Prj.Medium;
6807                   when '2' =>
6808                      Current_Verbosity := Prj.High;
6809                   when others =>
6810                      null;
6811                end case;
6812             end if;
6813
6814          --  -Xext=val  (External assignment)
6815
6816          elsif Argv (2) = 'X'
6817            and then Is_External_Assignment (Argv)
6818          then
6819             --  Is_External_Assignment has side effects
6820             --  when it returns True;
6821
6822             null;
6823
6824          --  If -gnath is present, then generate the usage information
6825          --  right now and do not pass this option on to the compiler calls.
6826
6827          elsif Argv = "-gnath" then
6828             Usage;
6829
6830          --  If -gnatc is specified, make sure the bind step and the link
6831          --  step are not executed.
6832
6833          elsif Argv'Length >= 6 and then Argv (2 .. 6) = "gnatc" then
6834
6835             --  If -gnatc is specified, make sure the bind step and the link
6836             --  step are not executed.
6837
6838             Add_Switch (Argv, Compiler, And_Save => And_Save);
6839             Opt.Operating_Mode := Opt.Check_Semantics;
6840             Opt.Check_Object_Consistency := False;
6841             Opt.Compile_Only             := True;
6842             Do_Bind_Step                 := False;
6843             Do_Link_Step                 := False;
6844
6845          elsif Argv (2 .. Argv'Last) = "nostdlib" then
6846
6847             --  Don't pass -nostdlib to gnatlink, it will disable
6848             --  linking with all standard library files.
6849
6850             Opt.No_Stdlib := True;
6851             Add_Switch (Argv, Binder, And_Save => And_Save);
6852
6853          elsif Argv (2 .. Argv'Last) = "nostdinc" then
6854
6855             --  Pass -nostdinv to the Compiler and to gnatbind
6856
6857             Opt.No_Stdinc := True;
6858             Add_Switch (Argv, Compiler, And_Save => And_Save);
6859             Add_Switch (Argv, Binder, And_Save => And_Save);
6860
6861             --  By default all switches with more than one character
6862             --  or one character switches which are not in 'a' .. 'z'
6863             --  (except 'C', 'F', and 'M') are passed to the compiler,
6864             --  unless we are dealing with a debug switch (starts with 'd')
6865
6866          elsif Argv (2) /= 'd'
6867            and then Argv (2 .. Argv'Last) /= "C"
6868            and then Argv (2 .. Argv'Last) /= "F"
6869            and then Argv (2 .. Argv'Last) /= "M"
6870            and then (Argv'Length > 2 or else Argv (2) not in 'a' .. 'z')
6871          then
6872             Add_Switch (Argv, Compiler, And_Save => And_Save);
6873
6874          --  All other options are handled by Scan_Make_Switches
6875
6876          else
6877             Scan_Make_Switches (Argv);
6878          end if;
6879
6880       --  If not a switch it must be a file name
6881
6882       else
6883          Add_File (Argv);
6884          Mains.Add_Main (Argv);
6885       end if;
6886    end Scan_Make_Arg;
6887
6888    -----------------
6889    -- Switches_Of --
6890    -----------------
6891
6892    function Switches_Of
6893      (Source_File      : Name_Id;
6894       Source_File_Name : String;
6895       Naming           : Naming_Data;
6896       In_Package       : Package_Id;
6897       Allow_ALI        : Boolean) return Variable_Value
6898    is
6899       Switches : Variable_Value;
6900
6901       Defaults : constant Array_Element_Id :=
6902                    Prj.Util.Value_Of
6903                      (Name      => Name_Default_Switches,
6904                       In_Arrays =>
6905                       Packages.Table (In_Package).Decl.Arrays);
6906
6907       Switches_Array : constant Array_Element_Id :=
6908                          Prj.Util.Value_Of
6909                            (Name      => Name_Switches,
6910                             In_Arrays =>
6911                               Packages.Table (In_Package).Decl.Arrays);
6912
6913    begin
6914       Switches :=
6915         Prj.Util.Value_Of
6916         (Index => Source_File,
6917          In_Array => Switches_Array);
6918
6919       if Switches = Nil_Variable_Value then
6920          declare
6921             Name        : String (1 .. Source_File_Name'Length + 3);
6922             Last        : Positive := Source_File_Name'Length;
6923             Spec_Suffix : constant String :=
6924                             Get_Name_String (Naming.Current_Spec_Suffix);
6925             Body_Suffix : constant String :=
6926                             Get_Name_String (Naming.Current_Body_Suffix);
6927             Truncated   : Boolean := False;
6928
6929          begin
6930             Name (1 .. Last) := Source_File_Name;
6931
6932             if Last > Body_Suffix'Length
6933                and then Name (Last - Body_Suffix'Length + 1 .. Last) =
6934                                                                   Body_Suffix
6935             then
6936                Truncated := True;
6937                Last := Last - Body_Suffix'Length;
6938             end if;
6939
6940             if not Truncated
6941               and then Last > Spec_Suffix'Length
6942               and then Name (Last - Spec_Suffix'Length + 1 .. Last) =
6943                                                                  Spec_Suffix
6944             then
6945                Truncated := True;
6946                Last := Last - Spec_Suffix'Length;
6947             end if;
6948
6949             if Truncated then
6950                Name_Len := Last;
6951                Name_Buffer (1 .. Name_Len) := Name (1 .. Last);
6952                Switches :=
6953                  Prj.Util.Value_Of
6954                  (Index => Name_Find,
6955                   In_Array => Switches_Array);
6956
6957                if Switches = Nil_Variable_Value
6958                  and then Allow_ALI
6959                then
6960                   Last := Source_File_Name'Length;
6961
6962                   while Name (Last) /= '.' loop
6963                      Last := Last - 1;
6964                   end loop;
6965
6966                   Name (Last + 1 .. Last + 3) := "ali";
6967                   Name_Len := Last + 3;
6968                   Name_Buffer (1 .. Name_Len) := Name (1 .. Name_Len);
6969                   Switches :=
6970                     Prj.Util.Value_Of
6971                        (Index => Name_Find,
6972                         In_Array => Switches_Array);
6973                end if;
6974             end if;
6975          end;
6976       end if;
6977
6978       if Switches = Nil_Variable_Value then
6979          Switches := Prj.Util.Value_Of
6980                                 (Index => Name_Ada, In_Array => Defaults);
6981       end if;
6982
6983       return Switches;
6984    end Switches_Of;
6985
6986    ---------------------------
6987    -- Test_If_Relative_Path --
6988    ---------------------------
6989
6990    procedure Test_If_Relative_Path
6991      (Switch             : in out String_Access;
6992       Parent             : String_Access;
6993       Including_L_Switch : Boolean := True)
6994    is
6995    begin
6996       if Switch /= null then
6997
6998          declare
6999             Sw : String (1 .. Switch'Length);
7000             Start : Positive;
7001
7002          begin
7003             Sw := Switch.all;
7004
7005             if Sw (1) = '-' then
7006                if Sw'Length >= 3
7007                  and then (Sw (2) = 'A'
7008                            or else Sw (2) = 'I'
7009                            or else (Including_L_Switch and then Sw (2) = 'L'))
7010                then
7011                   Start := 3;
7012
7013                   if Sw = "-I-" then
7014                      return;
7015                   end if;
7016
7017                elsif Sw'Length >= 4
7018                  and then (Sw (2 .. 3) = "aL"
7019                            or else Sw (2 .. 3) = "aO"
7020                            or else Sw (2 .. 3) = "aI")
7021                then
7022                   Start := 4;
7023
7024                else
7025                   return;
7026                end if;
7027
7028                --  Because relative path arguments to --RTS= may be relative
7029                --  to the search directory prefix, those relative path
7030                --  arguments are not converted.
7031
7032                if not Is_Absolute_Path (Sw (Start .. Sw'Last)) then
7033                   if Parent = null or else Parent'Length = 0 then
7034                      Make_Failed
7035                        ("relative search path switches (""",
7036                         Sw,
7037                         """) are not allowed");
7038
7039                   else
7040                      Switch :=
7041                        new String'
7042                          (Sw (1 .. Start - 1) &
7043                           Parent.all &
7044                           Directory_Separator &
7045                           Sw (Start .. Sw'Last));
7046                   end if;
7047                end if;
7048
7049             else
7050                if not Is_Absolute_Path (Sw) then
7051                   if Parent = null or else Parent'Length = 0 then
7052                      Make_Failed
7053                        ("relative paths (""", Sw, """) are not allowed");
7054
7055                   else
7056                      Switch :=
7057                        new String'(Parent.all & Directory_Separator & Sw);
7058                   end if;
7059                end if;
7060             end if;
7061          end;
7062       end if;
7063    end Test_If_Relative_Path;
7064
7065    -----------
7066    -- Usage --
7067    -----------
7068
7069    procedure Usage is
7070    begin
7071       if Usage_Needed then
7072          Usage_Needed := False;
7073          Makeusg;
7074       end if;
7075    end Usage;
7076
7077    -----------------
7078    -- Verbose_Msg --
7079    -----------------
7080
7081    procedure Verbose_Msg
7082      (N1     : Name_Id;
7083       S1     : String;
7084       N2     : Name_Id := No_Name;
7085       S2     : String  := "";
7086       Prefix : String := "  -> ")
7087    is
7088    begin
7089       if not Opt.Verbose_Mode then
7090          return;
7091       end if;
7092
7093       Write_Str (Prefix);
7094       Write_Str ("""");
7095       Write_Name (N1);
7096       Write_Str (""" ");
7097       Write_Str (S1);
7098
7099       if N2 /= No_Name then
7100          Write_Str (" """);
7101          Write_Name (N2);
7102          Write_Str (""" ");
7103       end if;
7104
7105       Write_Str (S2);
7106       Write_Eol;
7107    end Verbose_Msg;
7108
7109 begin
7110    Prj.Com.Fail := Make_Failed'Access;
7111    MLib.Fail    := Make_Failed'Access;
7112    --  Make sure that in case of failure, the temp files will be deleted
7113 end Make;