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