gcc/ada/make.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --                                 M A K E                                  --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --                            $Revision: 1.5 $
  10 --                                                                          --
  11 --          Copyright (C) 1992-2001 Free Software Foundation, Inc.          --
  12 --                                                                          --
  13 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  14 -- terms of the  GNU General Public License as published  by the Free Soft- --
  15 -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
  16 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  17 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  18 -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  19 -- for  more details.  You should have  received  a copy of the GNU General --
  20 -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
  21 -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
  22 -- MA 02111-1307, USA.                                                      --
  23 --                                                                          --
  24 -- GNAT was originally developed  by the GNAT team at  New York University. --
  25 -- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
  26 --                                                                          --
  27 ------------------------------------------------------------------------------
  28
  29 with Ada.Exceptions;   use Ada.Exceptions;
  30 with Ada.Command_Line; use Ada.Command_Line;
  31 with GNAT.OS_Lib;      use GNAT.OS_Lib;
  32
  33 with ALI;              use ALI;
  34 with ALI.Util;         use ALI.Util;
  35 with Csets;
  36 with Debug;
  37 with Fname;            use Fname;
  38 with Fname.SF;         use Fname.SF;
  39 with Fname.UF;         use Fname.UF;
  40 with Gnatvsn;          use Gnatvsn;
  41 with Hostparm;         use Hostparm;
  42 with Makeusg;
  43 with MLib.Prj;
  44 with MLib.Tgt;
  45 with MLib.Utl;
  46 with Namet;            use Namet;
  47 with Opt;              use Opt;
  48 with Osint;            use Osint;
  49 with Gnatvsn;
  50 with Output;           use Output;
  51 with Prj;              use Prj;
  52 with Prj.Com;
  53 with Prj.Env;
  54 with Prj.Ext;
  55 with Prj.Pars;
  56 with Prj.Util;
  57 with SFN_Scan;
  58 with Sinput.L;
  59 with Snames;           use Snames;
  60 with Stringt;          use Stringt;
  61 with Table;
  62 with Types;            use Types;
  63 with Switch;           use Switch;
  64
  65 with System.WCh_Con;   use System.WCh_Con;
  66
  67 package body Make is
  68
  69    use ASCII;
  70    --  Make control characters visible
  71
  72    Standard_Library_Package_Body_Name : constant String := "s-stalib.adb";
  73    --  Every program depends on this package, that must then be checked,
  74    --  especially when -f and -a are used.
  75
  76    -------------------------
  77    -- Note on terminology --
  78    -------------------------
  79
  80    --  In this program, we use the phrase "termination" of a file name to
  81    --  refer to the suffix that appears after the unit name portion. Very
  82    --  often this is simply the extension, but in some cases, the sequence
  83    --  may be more complex, for example in main.1.ada, the termination in
  84    --  this name is ".1.ada" and in main_.ada the termination is "_.ada".
  85
  86    -------------------------------------
  87    -- Queue (Q) Manipulation Routines --
  88    -------------------------------------
  89
  90    --  The Q is used in Compile_Sources below. Its implementation uses the
  91    --  GNAT generic package Table (basically an extensible array). Q_Front
  92    --  points to the first valid element in the Q, whereas Q.First is the first
  93    --  element ever enqueued, while Q.Last - 1 is the last element in the Q.
  94    --
  95    --        +---+--------------+---+---+---+-----------+---+--------
  96    --    Q   |   |  ........    |   |   |   | .......   |   |
  97    --        +---+--------------+---+---+---+-----------+---+--------
  98    --          ^                  ^                       ^
  99    --       Q.First             Q_Front               Q.Last - 1
 100    --
 101    --  The elements comprised between Q.First and Q_Front - 1 are the
 102    --  elements that have been enqueued and then dequeued, while the
 103    --  elements between Q_Front and Q.Last - 1 are the elements currently
 104    --  in the Q. When the Q is initialized Q_Front = Q.First = Q.Last.
 105    --  After Compile_Sources has terminated its execution, Q_Front = Q.Last
 106    --  and the elements contained between Q.Front and Q.Last-1 are those that
 107    --  were explored and thus marked by Compile_Sources. Whenever the Q is
 108    --  reinitialized, the elements between Q.First and Q.Last - 1 are unmarked.
 109
 110    procedure Init_Q;
 111    --  Must be called to (re)initialize the Q.
 112
 113    procedure Insert_Q
 114      (Source_File : File_Name_Type;
 115       Source_Unit : Unit_Name_Type := No_Name);
 116    --  Inserts Source_File at the end of Q. Provide Source_Unit when
 117    --  possible for external use (gnatdist).
 118
 119    function Empty_Q return Boolean;
 120    --  Returns True if Q is empty.
 121
 122    procedure Extract_From_Q
 123      (Source_File : out File_Name_Type;
 124       Source_Unit : out Unit_Name_Type);
 125    --  Extracts the first element from the Q.
 126
 127    procedure Insert_Project_Sources
 128      (The_Project : Project_Id;
 129       Into_Q      : Boolean);
 130    --  If Into_Q is True, insert all sources of the project file that are not
 131    --  already marked into the Q. If Into_Q is False, call Osint.Add_File for
 132    --  all sources of the project file.
 133
 134    First_Q_Initialization : Boolean := True;
 135    --  Will be set to false after Init_Q has been called once.
 136
 137    Q_Front : Natural;
 138    --  Points to the first valid element in the Q.
 139
 140    Unique_Compile : Boolean := False;
 141
 142    type Q_Record is record
 143       File : File_Name_Type;
 144       Unit : Unit_Name_Type;
 145    end record;
 146    --  File is the name of the file to compile. Unit is for gnatdist
 147    --  use in order to easily get the unit name of a file to compile
 148    --  when its name is krunched or declared in gnat.adc.
 149
 150    package Q is new Table.Table (
 151      Table_Component_Type => Q_Record,
 152      Table_Index_Type     => Natural,
 153      Table_Low_Bound      => 0,
 154      Table_Initial        => 4000,
 155      Table_Increment      => 100,
 156      Table_Name           => "Make.Q");
 157    --  This is the actual Q.
 158
 159    --  The following instantiations and variables are necessary to save what
 160    --  is found on the command line, in case there is a project file specified.
 161
 162    package Saved_Gcc_Switches is new Table.Table (
 163      Table_Component_Type => String_Access,
 164      Table_Index_Type     => Integer,
 165      Table_Low_Bound      => 1,
 166      Table_Initial        => 20,
 167      Table_Increment      => 100,
 168      Table_Name           => "Make.Saved_Gcc_Switches");
 169
 170    package Saved_Binder_Switches is new Table.Table (
 171      Table_Component_Type => String_Access,
 172      Table_Index_Type     => Integer,
 173      Table_Low_Bound      => 1,
 174      Table_Initial        => 20,
 175      Table_Increment      => 100,
 176      Table_Name           => "Make.Saved_Binder_Switches");
 177
 178    package Saved_Linker_Switches is new Table.Table
 179      (Table_Component_Type => String_Access,
 180       Table_Index_Type     => Integer,
 181       Table_Low_Bound      => 1,
 182       Table_Initial        => 20,
 183       Table_Increment      => 100,
 184       Table_Name           => "Make.Saved_Linker_Switches");
 185
 186    package Saved_Make_Switches is new Table.Table
 187      (Table_Component_Type => String_Access,
 188       Table_Index_Type     => Integer,
 189       Table_Low_Bound      => 1,
 190       Table_Initial        => 20,
 191       Table_Increment      => 100,
 192       Table_Name           => "Make.Saved_Make_Switches");
 193
 194    Saved_Maximum_Processes : Natural := 0;
 195    Saved_WC_Encoding_Method : WC_Encoding_Method := WC_Encoding_Method'First;
 196    Saved_WC_Encoding_Method_Set : Boolean := False;
 197
 198    type Arg_List_Ref is access Argument_List;
 199    The_Saved_Gcc_Switches : Arg_List_Ref;
 200
 201    Project_File_Name : String_Access  := null;
 202    Current_Verbosity : Prj.Verbosity  := Prj.Default;
 203    Main_Project      : Prj.Project_Id := No_Project;
 204
 205    procedure Add_Source_Dir (N : String);
 206    --  Call Add_Src_Search_Dir.
 207    --  Output one line when in verbose mode.
 208
 209    procedure Add_Source_Directories is
 210      new Prj.Env.For_All_Source_Dirs (Action => Add_Source_Dir);
 211
 212    procedure Add_Object_Dir (N : String);
 213    --  Call Add_Lib_Search_Dir.
 214    --  Output one line when in verbose mode.
 215
 216    procedure Add_Object_Directories is
 217      new Prj.Env.For_All_Object_Dirs (Action => Add_Object_Dir);
 218
 219    type Bad_Compilation_Info is record
 220       File  : File_Name_Type;
 221       Unit  : Unit_Name_Type;
 222       Found : Boolean;
 223    end record;
 224    --  File is the name of the file for which a compilation failed.
 225    --  Unit is for gnatdist use in order to easily get the unit name
 226    --  of a file when its name is krunched or declared in gnat.adc.
 227    --  Found is False if the compilation failed because the file could
 228    --  not be found.
 229
 230    package Bad_Compilation is new Table.Table (
 231      Table_Component_Type => Bad_Compilation_Info,
 232      Table_Index_Type     => Natural,
 233      Table_Low_Bound      => 1,
 234      Table_Initial        => 20,
 235      Table_Increment      => 100,
 236      Table_Name           => "Make.Bad_Compilation");
 237    --  Full name of all the source files for which compilation fails.
 238
 239    type Special_Argument is record
 240       File : String_Access;
 241       Args : Argument_List_Access;
 242    end record;
 243    --  File is the name of the file for which a special set of compilation
 244    --  arguments (Args) is required.
 245
 246    package Special_Args is new Table.Table (
 247      Table_Component_Type => Special_Argument,
 248      Table_Index_Type     => Natural,
 249      Table_Low_Bound      => 1,
 250      Table_Initial        => 20,
 251      Table_Increment      => 100,
 252      Table_Name           => "Make.Special_Args");
 253    --  Compilation arguments of all the source files for which an entry has
 254    --  been found in the project file.
 255
 256    Original_Ada_Include_Path : constant String_Access :=
 257                                  Getenv ("ADA_INCLUDE_PATH");
 258    Original_Ada_Objects_Path : constant String_Access :=
 259                                  Getenv ("ADA_OBJECTS_PATH");
 260    Current_Ada_Include_Path  : String_Access := null;
 261    Current_Ada_Objects_Path  : String_Access := null;
 262
 263    Max_Line_Length : constant := 127;
 264    --  Maximum number of characters per line, when displaying a path
 265
 266    Do_Compile_Step : Boolean := True;
 267    Do_Bind_Step    : Boolean := True;
 268    Do_Link_Step    : Boolean := True;
 269    --  Flags to indicate what step should be executed.
 270    --  Can be set to False with the switches -c, -b and -l.
 271    --  These flags are reset to True for each invokation of procedure Gnatmake.
 272
 273    ----------------------
 274    -- Marking Routines --
 275    ----------------------
 276
 277    procedure Mark (Source_File : File_Name_Type);
 278    --  Mark Source_File. Marking is used to signal that Source_File has
 279    --  already been inserted in the Q.
 280
 281    function Is_Marked (Source_File : File_Name_Type) return Boolean;
 282    --  Returns True if Source_File was previously marked.
 283
 284    procedure Unmark (Source_File : File_Name_Type);
 285    --  Unmarks Source_File.
 286
 287    -------------------
 288    -- Misc Routines --
 289    -------------------
 290
 291    procedure List_Depend;
 292    --  Prints to standard output the list of object dependencies. This list
 293    --  can be used directly in a Makefile. A call to Compile_Sources must
 294    --  precede the call to List_Depend. Also because this routine uses the
 295    --  ALI files that were originally loaded and scanned by Compile_Sources,
 296    --  no additional ALI files should be scanned between the two calls (i.e.
 297    --  between the call to Compile_Sources and List_Depend.)
 298
 299    procedure Inform (N : Name_Id := No_Name; Msg : String);
 300    --  Prints out the program name followed by a colon, N and S.
 301
 302    procedure List_Bad_Compilations;
 303    --  Prints out the list of all files for which the compilation failed.
 304
 305    procedure Verbose_Msg
 306      (N1     : Name_Id;
 307       S1     : String;
 308       N2     : Name_Id := No_Name;
 309       S2     : String  := "";
 310       Prefix : String  := "  -> ");
 311    --  If the verbose flag (Verbose_Mode) is set then print Prefix to standard
 312    --  output followed by N1 and S1. If N2 /= No_Name then N2 is then printed
 313    --  after S1. S2 is printed last. Both N1 and N2 are printed in quotation
 314    --  marks.
 315
 316    -----------------------
 317    -- Gnatmake Routines --
 318    -----------------------
 319
 320    subtype Lib_Mark_Type is Byte;
 321
 322    Ada_Lib_Dir  : constant Lib_Mark_Type := 1;
 323    GNAT_Lib_Dir : constant Lib_Mark_Type := 2;
 324
 325    --  Note that the notion of GNAT lib dir is no longer used. The code
 326    --  related to it has not been removed to give an idea on how to use
 327    --  the directory prefix marking mechanism.
 328
 329    --  An Ada library directory is a directory containing ali and object
 330    --  files but no source files for the bodies (the specs can be in the
 331    --  same or some other directory). These directories are specified
 332    --  in the Gnatmake command line with the switch "-Adir" (to specify the
 333    --  spec location -Idir cab be used).  Gnatmake skips the missing sources
 334    --  whose ali are in Ada library directories. For an explanation of why
 335    --  Gnatmake behaves that way, see the spec of Make.Compile_Sources.
 336    --  The directory lookup penalty is incurred every single time this
 337    --  routine is called.
 338
 339    function Is_External_Assignment (Argv : String) return Boolean;
 340    --  Verify that an external assignment switch is syntactically correct.
 341    --  Correct forms are
 342    --      -Xname=value
 343    --      -X"name=other value"
 344    --  Assumptions: 'First = 1, Argv (1 .. 2) = "-X"
 345    --  When this function returns True, the external assignment has
 346    --  been entered by a call to Prj.Ext.Add, so that in a project
 347    --  file, External ("name") will return "value".
 348
 349    function In_Ada_Lib_Dir  (File : File_Name_Type) return Boolean;
 350    --  Get directory prefix of this file and get lib mark stored in name
 351    --  table for this directory. Then check if an Ada lib mark has been set.
 352
 353    procedure Mark_Dir_Path
 354      (Path : String_Access;
 355       Mark : Lib_Mark_Type);
 356    --  Invoke Mark_Directory on each directory of the path.
 357
 358    procedure Mark_Directory
 359      (Dir  : String;
 360       Mark : Lib_Mark_Type);
 361    --  Store Dir in name table and set lib mark as name info to identify
 362    --  Ada libraries.
 363
 364    function Object_File_Name (Source : String) return String;
 365    --  Returns the object file name suitable for switch -o.
 366
 367    procedure Set_Ada_Paths
 368      (For_Project         : Prj.Project_Id;
 369       Including_Libraries : Boolean);
 370    --  Set, if necessary, env. variables ADA_INCLUDE_PATH and
 371    --  ADA_OBJECTS_PATH.
 372    --
 373    --  Note: this will modify these environment variables only
 374    --  for the current gnatmake process and all of its children
 375    --  (invocations of the compiler, the binder and the linker).
 376    --  The caller process ADA_INCLUDE_PATH and ADA_OBJECTS_PATH are
 377    --  not affected.
 378
 379    procedure Set_Library_For
 380      (Project             : Project_Id;
 381       There_Are_Libraries : in out Boolean);
 382    --  If Project is a library project, add the correct
 383    --  -L and -l switches to the linker invocation.
 384
 385    procedure Set_Libraries is
 386       new For_Every_Project_Imported (Boolean, Set_Library_For);
 387    --  Add the -L and -l switches to the linker for all
 388    --  of the library projects.
 389
 390    ----------------------------------------------------
 391    -- Compiler, Binder & Linker Data and Subprograms --
 392    ----------------------------------------------------
 393
 394    Gcc             : String_Access := Program_Name ("gcc");
 395    Gnatbind        : String_Access := Program_Name ("gnatbind");
 396    Gnatlink        : String_Access := Program_Name ("gnatlink");
 397    --  Default compiler, binder, linker programs
 398
 399    Saved_Gcc       : String_Access := null;
 400    Saved_Gnatbind  : String_Access := null;
 401    Saved_Gnatlink  : String_Access := null;
 402    --  Given by the command line. Will be used, if non null.
 403
 404    Gcc_Path        : String_Access :=
 405                        GNAT.OS_Lib.Locate_Exec_On_Path (Gcc.all);
 406    Gnatbind_Path   : String_Access :=
 407                        GNAT.OS_Lib.Locate_Exec_On_Path (Gnatbind.all);
 408    Gnatlink_Path   : String_Access :=
 409                        GNAT.OS_Lib.Locate_Exec_On_Path (Gnatlink.all);
 410    --  Path for compiler, binder, linker programs, defaulted now for gnatdist.
 411    --  Changed later if overridden on command line.
 412
 413    Comp_Flag         : constant String_Access := new String'("-c");
 414    Output_Flag       : constant String_Access := new String'("-o");
 415    Ada_Flag_1        : constant String_Access := new String'("-x");
 416    Ada_Flag_2        : constant String_Access := new String'("ada");
 417    No_gnat_adc       : constant String_Access := new String'("-gnatA");
 418    GNAT_Flag         : constant String_Access := new String'("-gnatpg");
 419    Do_Not_Check_Flag : constant String_Access := new String'("-x");
 420
 421    Object_Suffix     : constant String := Get_Object_Suffix.all;
 422    Executable_Suffix : constant String := Get_Executable_Suffix.all;
 423
 424    Display_Executed_Programs : Boolean := True;
 425    --  Set to True if name of commands should be output on stderr.
 426
 427    Output_File_Name_Seen : Boolean := False;
 428    --  Set to True after having scanned the file_name for
 429    --  switch "-o file_name"
 430
 431    File_Name_Seen : Boolean := False;
 432    --  Set to true after having seen at least one file name.
 433    --  Used in Scan_Make_Arg only, but must be a global variable.
 434
 435    type Make_Program_Type is (None, Compiler, Binder, Linker);
 436
 437    Program_Args : Make_Program_Type := None;
 438    --  Used to indicate if we are scanning gcc, gnatbind, or gnatbl
 439    --  options within the gnatmake command line.
 440    --  Used in Scan_Make_Arg only, but must be a global variable.
 441
 442    procedure Add_Switches
 443      (The_Package : Package_Id;
 444       File_Name   : String;
 445       Program     : Make_Program_Type);
 446    procedure Add_Switch
 447      (S             : String_Access;
 448       Program       : Make_Program_Type;
 449       Append_Switch : Boolean := True;
 450       And_Save      : Boolean := True);
 451    procedure Add_Switch
 452      (S             : String;
 453       Program       : Make_Program_Type;
 454       Append_Switch : Boolean := True;
 455       And_Save      : Boolean := True);
 456    --  Make invokes one of three programs (the compiler, the binder or the
 457    --  linker). For the sake of convenience, some program specific switches
 458    --  can be passed directly on the gnatmake commande line. This procedure
 459    --  records these switches so that gnamake can pass them to the right
 460    --  program.  S is the switch to be added at the end of the command line
 461    --  for Program if Append_Switch is True. If Append_Switch is False S is
 462    --  added at the beginning of the command line.
 463
 464    procedure Check
 465      (Lib_File  : File_Name_Type;
 466       ALI       : out ALI_Id;
 467       O_File    : out File_Name_Type;
 468       O_Stamp   : out Time_Stamp_Type);
 469    --  Determines whether the library file Lib_File is up-to-date or not. The
 470    --  full name (with path information) of the object file corresponding to
 471    --  Lib_File is returned in O_File. Its time stamp is saved in O_Stamp.
 472    --  ALI is the ALI_Id corresponding to Lib_File. If Lib_File in not
 473    --  up-to-date, then the corresponding source file needs to be recompiled.
 474    --  In this case ALI = No_ALI_Id.
 475
 476    procedure Check_Linker_Options
 477      (E_Stamp : Time_Stamp_Type;
 478       O_File  : out File_Name_Type;
 479       O_Stamp : out Time_Stamp_Type);
 480    --  Checks all linker options for linker files that are newer
 481    --  than E_Stamp. If such objects are found, the youngest object
 482    --  is returned in O_File and its stamp in O_Stamp.
 483    --
 484    --  If no obsolete linker files were found, the first missing
 485    --  linker file is returned in O_File and O_Stamp is empty.
 486    --  Otherwise O_File is No_File.
 487
 488    procedure Display (Program : String; Args : Argument_List);
 489    --  Displays Program followed by the arguments in Args if variable
 490    --  Display_Executed_Programs is set. The lower bound of Args must be 1.
 491
 492    --------------------
 493    -- Add_Object_Dir --
 494    --------------------
 495
 496    procedure Add_Object_Dir (N : String) is
 497    begin
 498       Add_Lib_Search_Dir (N);
 499
 500       if Opt.Verbose_Mode then
 501          Write_Str ("Adding object directory """);
 502          Write_Str (N);
 503          Write_Str (""".");
 504          Write_Eol;
 505       end if;
 506    end Add_Object_Dir;
 507
 508    --------------------
 509    -- Add_Source_Dir --
 510    --------------------
 511
 512    procedure Add_Source_Dir (N : String) is
 513    begin
 514       Add_Src_Search_Dir (N);
 515
 516       if Opt.Verbose_Mode then
 517          Write_Str ("Adding source directory """);
 518          Write_Str (N);
 519          Write_Str (""".");
 520          Write_Eol;
 521       end if;
 522    end Add_Source_Dir;
 523
 524    ----------------
 525    -- Add_Switch --
 526    ----------------
 527
 528    procedure Add_Switch
 529      (S             : String_Access;
 530       Program       : Make_Program_Type;
 531       Append_Switch : Boolean := True;
 532       And_Save      : Boolean := True)
 533    is
 534       generic
 535          with package T is new Table.Table (<>);
 536       function Generic_Position return Integer;
 537       --  Generic procedure that adds S at the end or beginning of T depending
 538       --  of the value of the boolean Append_Switch.
 539
 540       ----------------------
 541       -- Generic_Position --
 542       ----------------------
 543
 544       function Generic_Position return Integer is
 545       begin
 546          T.Increment_Last;
 547
 548          if Append_Switch then
 549             return Integer (T.Last);
 550          else
 551             for J in reverse T.Table_Index_Type'Succ (T.First) .. T.Last loop
 552                T.Table (J) := T.Table (T.Table_Index_Type'Pred (J));
 553             end loop;
 554
 555             return Integer (T.First);
 556          end if;
 557       end Generic_Position;
 558
 559       function Gcc_Switches_Pos    is new Generic_Position (Gcc_Switches);
 560       function Binder_Switches_Pos is new Generic_Position (Binder_Switches);
 561       function Linker_Switches_Pos is new Generic_Position (Linker_Switches);
 562
 563       function Saved_Gcc_Switches_Pos is new
 564         Generic_Position (Saved_Gcc_Switches);
 565
 566       function Saved_Binder_Switches_Pos is new
 567         Generic_Position (Saved_Binder_Switches);
 568
 569       function Saved_Linker_Switches_Pos is new
 570         Generic_Position (Saved_Linker_Switches);
 571
 572    --  Start of processing for Add_Switch
 573
 574    begin
 575       if And_Save then
 576          case Program is
 577             when Compiler =>
 578                Saved_Gcc_Switches.Table (Saved_Gcc_Switches_Pos) := S;
 579
 580             when Binder   =>
 581                Saved_Binder_Switches.Table (Saved_Binder_Switches_Pos) := S;
 582
 583             when Linker   =>
 584                Saved_Linker_Switches.Table (Saved_Linker_Switches_Pos) := S;
 585
 586             when None =>
 587                raise Program_Error;
 588          end case;
 589
 590       else
 591          case Program is
 592             when Compiler =>
 593                Gcc_Switches.Table (Gcc_Switches_Pos) := S;
 594
 595             when Binder   =>
 596                Binder_Switches.Table (Binder_Switches_Pos) := S;
 597
 598             when Linker   =>
 599                Linker_Switches.Table (Linker_Switches_Pos) := S;
 600
 601             when None =>
 602                raise Program_Error;
 603          end case;
 604       end if;
 605    end Add_Switch;
 606
 607    procedure Add_Switch
 608      (S             : String;
 609       Program       : Make_Program_Type;
 610       Append_Switch : Boolean := True;
 611       And_Save      : Boolean := True)
 612    is
 613    begin
 614       Add_Switch (S             => new String'(S),
 615                   Program       => Program,
 616                   Append_Switch => Append_Switch,
 617                   And_Save      => And_Save);
 618    end Add_Switch;
 619
 620    ------------------
 621    -- Add_Switches --
 622    ------------------
 623
 624    procedure Add_Switches
 625      (The_Package : Package_Id;
 626       File_Name   : String;
 627       Program     : Make_Program_Type)
 628    is
 629       Switches      : Variable_Value;
 630       Switch_List   : String_List_Id;
 631       Element       : String_Element;
 632
 633       Switches_Array : constant Array_Element_Id :=
 634         Prj.Util.Value_Of
 635         (Name => Name_Switches,
 636          In_Arrays => Packages.Table (The_Package).Decl.Arrays);
 637       Default_Switches_Array : constant Array_Element_Id :=
 638         Prj.Util.Value_Of
 639         (Name => Name_Default_Switches,
 640          In_Arrays => Packages.Table (The_Package).Decl.Arrays);
 641
 642    begin
 643       if File_Name'Length > 0 then
 644          Name_Len := File_Name'Length;
 645          Name_Buffer (1 .. Name_Len) := File_Name;
 646          Switches :=
 647            Prj.Util.Value_Of (Index => Name_Find, In_Array => Switches_Array);
 648
 649          if Switches = Nil_Variable_Value then
 650             Switches := Prj.Util.Value_Of
 651               (Index => Name_Ada,
 652                In_Array => Default_Switches_Array);
 653          end if;
 654
 655          case Switches.Kind is
 656             when Undefined =>
 657                null;
 658
 659             when List =>
 660                Program_Args := Program;
 661
 662                Switch_List := Switches.Values;
 663
 664                while Switch_List /= Nil_String loop
 665                   Element := String_Elements.Table (Switch_List);
 666                   String_To_Name_Buffer (Element.Value);
 667
 668                   if Name_Len > 0 then
 669                      if Opt.Verbose_Mode then
 670                         Write_Str ("   Adding ");
 671                         Write_Line (Name_Buffer (1 .. Name_Len));
 672                      end if;
 673
 674                      Scan_Make_Arg
 675                        (Name_Buffer (1 .. Name_Len),
 676                         And_Save => False);
 677                   end if;
 678
 679                   Switch_List := Element.Next;
 680                end loop;
 681
 682             when Single =>
 683                Program_Args := Program;
 684                String_To_Name_Buffer (Switches.Value);
 685
 686                if Name_Len > 0 then
 687                   if Opt.Verbose_Mode then
 688                      Write_Str ("   Adding ");
 689                      Write_Line (Name_Buffer (1 .. Name_Len));
 690                   end if;
 691
 692                   Scan_Make_Arg
 693                     (Name_Buffer (1 .. Name_Len), And_Save => False);
 694                end if;
 695          end case;
 696       end if;
 697    end Add_Switches;
 698
 699    ----------
 700    -- Bind --
 701    ----------
 702
 703    procedure Bind (ALI_File : File_Name_Type; Args : Argument_List) is
 704       Bind_Args : Argument_List (1 .. Args'Last + 2);
 705       Bind_Last : Integer;
 706       Success   : Boolean;
 707
 708    begin
 709       pragma Assert (Args'First = 1);
 710
 711       --  Optimize the simple case where the gnatbind command line looks like
 712       --     gnatbind -aO. -I- file.ali   --into->   gnatbind file.adb
 713
 714       if Args'Length = 2
 715         and then Args (Args'First).all = "-aO" & Normalized_CWD
 716         and then Args (Args'Last).all = "-I-"
 717         and then ALI_File = Strip_Directory (ALI_File)
 718       then
 719          Bind_Last := Args'First - 1;
 720
 721       else
 722          Bind_Last := Args'Last;
 723          Bind_Args (Args'Range) := Args;
 724       end if;
 725
 726       --  It is completely pointless to re-check source file time stamps.
 727       --  This has been done already by gnatmake
 728
 729       Bind_Last := Bind_Last + 1;
 730       Bind_Args (Bind_Last) := Do_Not_Check_Flag;
 731
 732       Get_Name_String (ALI_File);
 733
 734       Bind_Last := Bind_Last + 1;
 735       Bind_Args (Bind_Last) := new String'(Name_Buffer (1 .. Name_Len));
 736
 737       Display (Gnatbind.all, Bind_Args (Args'First .. Bind_Last));
 738
 739       if Gnatbind_Path = null then
 740          Osint.Fail ("error, unable to locate " & Gnatbind.all);
 741       end if;
 742
 743       GNAT.OS_Lib.Spawn
 744         (Gnatbind_Path.all, Bind_Args (Args'First .. Bind_Last), Success);
 745
 746       if not Success then
 747          raise Bind_Failed;
 748       end if;
 749    end Bind;
 750
 751    -----------
 752    -- Check --
 753    -----------
 754
 755    procedure Check
 756      (Lib_File  : File_Name_Type;
 757       ALI       : out ALI_Id;
 758       O_File    : out File_Name_Type;
 759       O_Stamp   : out Time_Stamp_Type)
 760    is
 761       function First_New_Spec (A : ALI_Id) return File_Name_Type;
 762       --  Looks in the with table entries of A and returns the spec file name
 763       --  of the first withed unit (subprogram) for which no spec existed when
 764       --  A was generated but for which there exists one now, implying that A
 765       --  is now obsolete. If no such unit is found No_File is returned.
 766       --  Otherwise the spec file name of the unit is returned.
 767       --
 768       --  **WARNING** in the event of Uname format modifications, one *MUST*
 769       --  make sure this function is also updated.
 770       --
 771       --  Note: This function should really be in ali.adb and use Uname
 772       --  services, but this causes the whole compiler to be dragged along
 773       --  for gnatbind and gnatmake.
 774
 775       --------------------
 776       -- First_New_Spec --
 777       --------------------
 778
 779       function First_New_Spec (A : ALI_Id) return File_Name_Type is
 780          Spec_File_Name : File_Name_Type := No_File;
 781
 782          function New_Spec (Uname : Unit_Name_Type) return Boolean;
 783          --  Uname is the name of the spec or body of some ada unit.
 784          --  This function returns True if the Uname is the name of a body
 785          --  which has a spec not mentioned inali file A. If True is returned
 786          --  Spec_File_Name above is set to the name of this spec file.
 787
 788          --------------
 789          -- New_Spec --
 790          --------------
 791
 792          function New_Spec (Uname : Unit_Name_Type) return Boolean is
 793             Spec_Name : Unit_Name_Type;
 794             File_Name : File_Name_Type;
 795
 796          begin
 797             --  Test whether Uname is the name of a body unit (ie ends with %b)
 798
 799             Get_Name_String (Uname);
 800             pragma
 801               Assert (Name_Len > 2 and then Name_Buffer (Name_Len - 1) = '%');
 802
 803             if Name_Buffer (Name_Len) /= 'b' then
 804                return False;
 805             end if;
 806
 807             --  Convert unit name into spec name
 808
 809             --  ??? this code seems dubious in presence of pragma
 810             --  Source_File_Name since there is no more direct relationship
 811             --  between unit name and file name.
 812
 813             --  ??? Further, what about alternative subunit naming
 814
 815             Name_Buffer (Name_Len) := 's';
 816             Spec_Name := Name_Find;
 817             File_Name := Get_File_Name (Spec_Name, Subunit => False);
 818
 819             --  Look if File_Name is mentioned in A's sdep list.
 820             --  If not look if the file exists. If it does return True.
 821
 822             for D in
 823               ALIs.Table (A).First_Sdep .. ALIs.Table (A).Last_Sdep
 824             loop
 825                if Sdep.Table (D).Sfile = File_Name then
 826                   return False;
 827                end if;
 828             end loop;
 829
 830             if Full_Source_Name (File_Name) /= No_File then
 831                Spec_File_Name := File_Name;
 832                return True;
 833             end if;
 834
 835             return False;
 836          end New_Spec;
 837
 838       --  Start of processing for First_New_Spec
 839
 840       begin
 841          U_Chk : for U in
 842            ALIs.Table (A).First_Unit .. ALIs.Table (A).Last_Unit
 843          loop
 844             exit U_Chk when Units.Table (U).Utype = Is_Body_Only
 845                and then New_Spec (Units.Table (U).Uname);
 846
 847             for W in Units.Table (U).First_With
 848                        ..
 849                      Units.Table (U).Last_With
 850             loop
 851                exit U_Chk when
 852                  Withs.Table (W).Afile /= No_File
 853                  and then New_Spec (Withs.Table (W).Uname);
 854             end loop;
 855          end loop U_Chk;
 856
 857          return Spec_File_Name;
 858       end First_New_Spec;
 859
 860       ---------------------------------
 861       -- Data declarations for Check --
 862       ---------------------------------
 863
 864       Full_Lib_File    : File_Name_Type;
 865       --  Full name of current library file
 866
 867       Full_Obj_File    : File_Name_Type;
 868       --  Full name of the object file corresponding to Lib_File.
 869
 870       Lib_Stamp        : Time_Stamp_Type;
 871       --  Time stamp of the current ada library file.
 872
 873       Obj_Stamp        : Time_Stamp_Type;
 874       --  Time stamp of the current object file.
 875
 876       Modified_Source  : File_Name_Type;
 877       --  The first source in Lib_File whose current time stamp differs
 878       --  from that stored in Lib_File.
 879
 880       New_Spec         : File_Name_Type;
 881       --  If Lib_File contains in its W (with) section a body (for a
 882       --  subprogram) for which there exists a spec and the spec did not
 883       --  appear in the Sdep section of Lib_File, New_Spec contains the file
 884       --  name of this new spec.
 885
 886       Source_Name : Name_Id;
 887       Text : Text_Buffer_Ptr;
 888
 889       Prev_Switch : Character;
 890       --  First character of previous switch processed
 891
 892       Arg : Arg_Id := Arg_Id'First;
 893       --  Current index in Args.Table for a given unit (init to stop warning)
 894
 895       Switch_Found : Boolean;
 896       --  True if a given switch has been found
 897
 898       Num_Args : Integer;
 899       --  Number of compiler arguments processed
 900
 901       Special_Arg : Argument_List_Access;
 902       --  Special arguments if any of a given compilation file
 903
 904    --  Start of processing for Check
 905
 906    begin
 907       pragma Assert (Lib_File /= No_File);
 908
 909       Text          := Read_Library_Info (Lib_File);
 910       Full_Lib_File := Full_Library_Info_Name;
 911       Full_Obj_File := Full_Object_File_Name;
 912       Lib_Stamp     := Current_Library_File_Stamp;
 913       Obj_Stamp     := Current_Object_File_Stamp;
 914
 915       if Full_Lib_File = No_File then
 916          Verbose_Msg (Lib_File, "being checked ...", Prefix => "  ");
 917       else
 918          Verbose_Msg (Full_Lib_File, "being checked ...", Prefix => "  ");
 919       end if;
 920
 921       ALI     := No_ALI_Id;
 922       O_File  := Full_Obj_File;
 923       O_Stamp := Obj_Stamp;
 924
 925       if Text = null then
 926          if Full_Lib_File = No_File then
 927             Verbose_Msg (Lib_File, "missing.");
 928
 929          elsif Obj_Stamp (Obj_Stamp'First) = ' ' then
 930             Verbose_Msg (Full_Obj_File, "missing.");
 931
 932          else
 933             Verbose_Msg
 934               (Full_Lib_File, "(" & String (Lib_Stamp) & ") newer than",
 935                Full_Obj_File, "(" & String (Obj_Stamp) & ")");
 936          end if;
 937
 938       else
 939          ALI := Scan_ALI (Lib_File, Text, Ignore_ED => False, Err => True);
 940          Free (Text);
 941
 942          if ALI = No_ALI_Id then
 943             Verbose_Msg (Full_Lib_File, "incorrectly formatted ALI file");
 944             return;
 945
 946          elsif ALIs.Table (ALI).Ver (1 .. ALIs.Table (ALI).Ver_Len) /=
 947                                                           Library_Version
 948          then
 949             Verbose_Msg (Full_Lib_File, "compiled with old GNAT version");
 950             ALI := No_ALI_Id;
 951             return;
 952          end if;
 953
 954          --  Don't take Ali file into account if it was generated without
 955          --  object.
 956
 957          if Opt.Operating_Mode /= Opt.Check_Semantics
 958            and then ALIs.Table (ALI).No_Object
 959          then
 960             Verbose_Msg (Full_Lib_File, "has no corresponding object");
 961             ALI := No_ALI_Id;
 962             return;
 963          end if;
 964
 965          --  Check for matching compiler switches if needed
 966
 967          if Opt.Check_Switches then
 968             Prev_Switch := ASCII.Nul;
 969             Num_Args    := 0;
 970
 971             Get_Name_String (ALIs.Table (ALI).Sfile);
 972
 973             for J in 1 .. Special_Args.Last loop
 974                if Special_Args.Table (J).File.all =
 975                                         Name_Buffer (1 .. Name_Len)
 976                then
 977                   Special_Arg := Special_Args.Table (J).Args;
 978                   exit;
 979                end if;
 980             end loop;
 981
 982             if Main_Project /= No_Project then
 983                null;
 984             end if;
 985
 986             if Special_Arg = null then
 987                for J in Gcc_Switches.First .. Gcc_Switches.Last loop
 988
 989                   --  Skip non switches, -I and -o switches
 990
 991                   if (Gcc_Switches.Table (J) (1) = '-'
 992                         or else
 993                       Gcc_Switches.Table (J) (1) = Switch_Character)
 994                     and then Gcc_Switches.Table (J) (2) /= 'o'
 995                     and then Gcc_Switches.Table (J) (2) /= 'I'
 996                   then
 997                      Num_Args := Num_Args + 1;
 998
 999                      --  Comparing switches is delicate because gcc reorders
1000                      --  a number of switches, according to lang-specs.h, but
1001                      --  gnatmake doesn't have the sufficient knowledge to
1002                      --  perform the same reordering. Instead, we ignore orders
1003                      --  between different "first letter" switches, but keep
1004                      --  orders between same switches, e.g -O -O2 is different
1005                      --  than -O2 -O, but -g -O is equivalent to -O -g.
1006
1007                      if Gcc_Switches.Table (J) (2) /= Prev_Switch then
1008                         Prev_Switch := Gcc_Switches.Table (J) (2);
1009                         Arg :=
1010                           Units.Table (ALIs.Table (ALI).First_Unit).First_Arg;
1011                      end if;
1012
1013                      Switch_Found := False;
1014
1015                      for K in Arg ..
1016                        Units.Table (ALIs.Table (ALI).First_Unit).Last_Arg
1017                      loop
1018                         if Gcc_Switches.Table (J).all = Args.Table (K).all then
1019                            Arg := K + 1;
1020                            Switch_Found := True;
1021                            exit;
1022                         end if;
1023                      end loop;
1024
1025                      if not Switch_Found then
1026                         if Opt.Verbose_Mode then
1027                            Verbose_Msg (ALIs.Table (ALI).Sfile,
1028                              "switch mismatch");
1029                         end if;
1030
1031                         ALI := No_ALI_Id;
1032                         return;
1033                      end if;
1034                   end if;
1035                end loop;
1036
1037             else
1038                for J in Special_Arg'Range loop
1039
1040                   --  Skip non switches, -I and -o switches
1041
1042                   if (Special_Arg (J) (1) = '-'
1043                     or else Special_Arg (J) (1) = Switch_Character)
1044                     and then Special_Arg (J) (2) /= 'o'
1045                     and then Special_Arg (J) (2) /= 'I'
1046                   then
1047                      Num_Args := Num_Args + 1;
1048
1049                      if Special_Arg (J) (2) /= Prev_Switch then
1050                         Prev_Switch := Special_Arg (J) (2);
1051                         Arg :=
1052                           Units.Table (ALIs.Table (ALI).First_Unit).First_Arg;
1053                      end if;
1054
1055                      Switch_Found := False;
1056
1057                      for K in Arg ..
1058                        Units.Table (ALIs.Table (ALI).First_Unit).Last_Arg
1059                      loop
1060                         if Special_Arg (J).all = Args.Table (K).all then
1061                            Arg := K + 1;
1062                            Switch_Found := True;
1063                            exit;
1064                         end if;
1065                      end loop;
1066
1067                      if not Switch_Found then
1068                         if Opt.Verbose_Mode then
1069                            Verbose_Msg (ALIs.Table (ALI).Sfile,
1070                              "switch mismatch");
1071                         end if;
1072
1073                         ALI := No_ALI_Id;
1074                         return;
1075                      end if;
1076                   end if;
1077                end loop;
1078             end if;
1079
1080             if Num_Args /=
1081               Integer (Units.Table (ALIs.Table (ALI).First_Unit).Last_Arg -
1082                        Units.Table (ALIs.Table (ALI).First_Unit).First_Arg + 1)
1083             then
1084                if Opt.Verbose_Mode then
1085                   Verbose_Msg (ALIs.Table (ALI).Sfile,
1086                     "different number of switches");
1087                end if;
1088
1089                ALI := No_ALI_Id;
1090                return;
1091             end if;
1092          end if;
1093
1094          --  Get the source files and their time stamps. Note that some
1095          --  sources may be missing if ALI is out-of-date.
1096
1097          Set_Source_Table (ALI);
1098
1099          Modified_Source := Time_Stamp_Mismatch (ALI);
1100
1101          if Modified_Source /= No_File then
1102             ALI := No_ALI_Id;
1103
1104             if Opt.Verbose_Mode then
1105                Source_Name := Full_Source_Name (Modified_Source);
1106
1107                if Source_Name /= No_File then
1108                   Verbose_Msg (Source_Name, "time stamp mismatch");
1109                else
1110                   Verbose_Msg (Modified_Source, "missing");
1111                end if;
1112             end if;
1113
1114          else
1115             New_Spec := First_New_Spec (ALI);
1116
1117             if New_Spec /= No_File then
1118                ALI := No_ALI_Id;
1119
1120                if Opt.Verbose_Mode then
1121                   Source_Name := Full_Source_Name (New_Spec);
1122
1123                   if Source_Name /= No_File then
1124                      Verbose_Msg (Source_Name, "new spec");
1125                   else
1126                      Verbose_Msg (New_Spec, "old spec missing");
1127                   end if;
1128                end if;
1129             end if;
1130          end if;
1131       end if;
1132    end Check;
1133
1134    --------------------------
1135    -- Check_Linker_Options --
1136    --------------------------
1137
1138    procedure Check_Linker_Options
1139      (E_Stamp   : Time_Stamp_Type;
1140       O_File    : out File_Name_Type;
1141       O_Stamp   : out Time_Stamp_Type)
1142    is
1143       procedure Check_File (File : File_Name_Type);
1144       --  Update O_File and O_Stamp if the given file is younger than E_Stamp
1145       --  and O_Stamp, or if O_File is No_File and File does not exist.
1146
1147       function Get_Library_File (Name : String) return File_Name_Type;
1148       --  Return the full file name including path of a library based
1149       --  on the name specified with the -l linker option, using the
1150       --  Ada object path. Return No_File if no such file can be found.
1151
1152       type Char_Array is array (Natural) of Character;
1153       type Char_Array_Access is access constant Char_Array;
1154
1155       Template : Char_Array_Access;
1156       pragma Import (C, Template, "__gnat_library_template");
1157
1158       ----------------
1159       -- Check_File --
1160       ----------------
1161
1162       procedure Check_File (File : File_Name_Type) is
1163          Stamp : Time_Stamp_Type;
1164          Name  : File_Name_Type := File;
1165
1166       begin
1167          Get_Name_String (Name);
1168
1169          --  Remove any trailing NUL characters
1170
1171          while Name_Len >= Name_Buffer'First
1172            and then Name_Buffer (Name_Len) = NUL
1173          loop
1174             Name_Len := Name_Len - 1;
1175          end loop;
1176
1177          if Name_Len <= 0 then
1178             return;
1179
1180          elsif Name_Buffer (1) = Get_Switch_Character
1181            or else Name_Buffer (1) = '-'
1182          then
1183             --  Do not check if File is a switch other than "-l"
1184
1185             if Name_Buffer (2) /= 'l' then
1186                return;
1187             end if;
1188
1189             --  The argument is a library switch, get actual name. It
1190             --  is necessary to make a copy of the relevant part of
1191             --  Name_Buffer as Get_Library_Name uses Name_Buffer as well.
1192
1193             declare
1194                Base_Name : constant String := Name_Buffer (3 .. Name_Len);
1195
1196             begin
1197                Name := Get_Library_File (Base_Name);
1198             end;
1199
1200             if Name = No_File then
1201                return;
1202             end if;
1203          end if;
1204
1205          Stamp := File_Stamp (Name);
1206
1207          --  Find the youngest object file that is younger than the
1208          --  executable. If no such file exist, record the first object
1209          --  file that is not found.
1210
1211          if (O_Stamp < Stamp and then E_Stamp < Stamp)
1212            or else (O_File = No_File and then Stamp (Stamp'First) = ' ')
1213          then
1214             O_Stamp := Stamp;
1215             O_File := Name;
1216
1217             --  Strip the trailing NUL if present
1218
1219             Get_Name_String (O_File);
1220
1221             if Name_Buffer (Name_Len) = NUL then
1222                Name_Len := Name_Len - 1;
1223                O_File := Name_Find;
1224             end if;
1225          end if;
1226       end Check_File;
1227
1228       ----------------------
1229       -- Get_Library_Name --
1230       ----------------------
1231
1232       --  See comments in a-adaint.c about template syntax
1233
1234       function Get_Library_File (Name : String) return File_Name_Type is
1235          File : File_Name_Type := No_File;
1236
1237       begin
1238          Name_Len := 0;
1239
1240          for Ptr in Template'Range loop
1241             case Template (Ptr) is
1242                when '*'    =>
1243                   Add_Str_To_Name_Buffer (Name);
1244
1245                when ';'    =>
1246                   File := Full_Lib_File_Name (Name_Find);
1247                   exit when File /= No_File;
1248                   Name_Len := 0;
1249
1250                when NUL    =>
1251                   exit;
1252
1253                when others =>
1254                   Add_Char_To_Name_Buffer (Template (Ptr));
1255             end case;
1256          end loop;
1257
1258          --  The for loop exited because the end of the template
1259          --  was reached. File contains the last possible file name
1260          --  for the library.
1261
1262          if File = No_File and then Name_Len > 0 then
1263             File := Full_Lib_File_Name (Name_Find);
1264          end if;
1265
1266          return File;
1267       end Get_Library_File;
1268
1269    --  Start of processing for Check_Linker_Options
1270
1271    begin
1272       O_File  := No_File;
1273       O_Stamp := (others => ' ');
1274
1275       --  Process linker options from the ALI files.
1276
1277       for Opt in 1 .. Linker_Options.Last loop
1278          Check_File (Linker_Options.Table (Opt).Name);
1279       end loop;
1280
1281       --  Process options given on the command line.
1282
1283       for Opt in Linker_Switches.First .. Linker_Switches.Last loop
1284
1285          --  Check if the previous Opt has one of the two switches
1286          --  that take an extra parameter. (See GCC manual.)
1287
1288          if Opt = Linker_Switches.First
1289            or else (Linker_Switches.Table (Opt - 1).all /= "-u"
1290                       and then
1291                     Linker_Switches.Table (Opt - 1).all /= "-Xlinker")
1292          then
1293             Name_Len := 0;
1294             Add_Str_To_Name_Buffer (Linker_Switches.Table (Opt).all);
1295             Check_File (Name_Find);
1296          end if;
1297       end loop;
1298
1299    end Check_Linker_Options;
1300
1301    ---------------------
1302    -- Compile_Sources --
1303    ---------------------
1304
1305    procedure Compile_Sources
1306      (Main_Source           : File_Name_Type;
1307       Args                  : Argument_List;
1308       First_Compiled_File   : out Name_Id;
1309       Most_Recent_Obj_File  : out Name_Id;
1310       Most_Recent_Obj_Stamp : out Time_Stamp_Type;
1311       Main_Unit             : out Boolean;
1312       Compilation_Failures  : out Natural;
1313       Check_Readonly_Files  : Boolean  := False;
1314       Do_Not_Execute        : Boolean  := False;
1315       Force_Compilations    : Boolean  := False;
1316       Keep_Going            : Boolean  := False;
1317       In_Place_Mode         : Boolean  := False;
1318       Initialize_ALI_Data   : Boolean  := True;
1319       Max_Process           : Positive := 1)
1320    is
1321       function Compile
1322         (S    : Name_Id;
1323          L    : Name_Id;
1324          Args : Argument_List)
1325          return Process_Id;
1326       --  Compiles S using Args. If S is a GNAT predefined source
1327       --  "-gnatpg" is added to Args. Non blocking call. L corresponds to the
1328       --  expected library file name. Process_Id of the process spawned to
1329       --  execute the compile.
1330
1331       type Compilation_Data is record
1332          Pid              : Process_Id;
1333          Full_Source_File : File_Name_Type;
1334          Lib_File         : File_Name_Type;
1335          Source_Unit      : Unit_Name_Type;
1336       end record;
1337
1338       Running_Compile : array (1 .. Max_Process) of Compilation_Data;
1339       --  Used to save information about outstanding compilations.
1340
1341       Outstanding_Compiles : Natural := 0;
1342       --  Current number of outstanding compiles
1343
1344       Source_Unit : Unit_Name_Type;
1345       --  Current source unit
1346
1347       Source_File : File_Name_Type;
1348       --  Current source file
1349
1350       Full_Source_File : File_Name_Type;
1351       --  Full name of the current source file
1352
1353       Lib_File : File_Name_Type;
1354       --  Current library file
1355
1356       Full_Lib_File : File_Name_Type;
1357       --  Full name of the current library file
1358
1359       Obj_File : File_Name_Type;
1360       --  Full name of the object file corresponding to Lib_File.
1361
1362       Obj_Stamp : Time_Stamp_Type;
1363       --  Time stamp of the current object file.
1364
1365       Sfile : File_Name_Type;
1366       --  Contains the source file of the units withed by Source_File
1367
1368       ALI : ALI_Id;
1369       --  ALI Id of the current ALI file
1370
1371       Compilation_OK  : Boolean;
1372       Need_To_Compile : Boolean;
1373
1374       Pid  : Process_Id;
1375       Text : Text_Buffer_Ptr;
1376
1377       Data : Prj.Project_Data;
1378
1379       Arg_Index : Natural;
1380       --  Index in Special_Args.Table of a given compilation file
1381
1382       Need_To_Check_Standard_Library : Boolean := Check_Readonly_Files;
1383
1384       procedure Add_Process
1385         (Pid   : Process_Id;
1386          Sfile : File_Name_Type;
1387          Afile : File_Name_Type;
1388          Uname : Unit_Name_Type);
1389       --  Adds process Pid to the current list of outstanding compilation
1390       --  processes and record the full name of the source file Sfile that
1391       --  we are compiling, the name of its library file Afile and the
1392       --  name of its unit Uname.
1393
1394       procedure Await_Compile
1395         (Sfile : out File_Name_Type;
1396          Afile : out File_Name_Type;
1397          Uname : out Unit_Name_Type;
1398          OK    : out Boolean);
1399       --  Awaits that an outstanding compilation process terminates. When
1400       --  it does set Sfile to the name of the source file that was compiled
1401       --  Afile to the name of its library file and Uname to the name of its
1402       --  unit. Note that this time stamp can be used to check whether the
1403       --  compilation did generate an object file. OK is set to True if the
1404       --  compilation succeeded. Note that Sfile, Afile and Uname could be
1405       --  resp. No_File, No_File and No_Name  if there were no compilations
1406       --  to wait for.
1407
1408       procedure Collect_Arguments_And_Compile;
1409       --  Collect arguments from project file (if any) and compile
1410
1411       package Good_ALI is new Table.Table (
1412         Table_Component_Type => ALI_Id,
1413         Table_Index_Type     => Natural,
1414         Table_Low_Bound      => 1,
1415         Table_Initial        => 50,
1416         Table_Increment      => 100,
1417         Table_Name           => "Make.Good_ALI");
1418       --  Contains the set of valid ALI files that have not yet been scanned.
1419
1420       procedure Record_Good_ALI (A : ALI_Id);
1421       --  Records in the previous set the Id of an ALI file.
1422
1423       function Good_ALI_Present return Boolean;
1424       --  Returns True if any ALI file was recorded in the previous set.
1425
1426       function Get_Next_Good_ALI return ALI_Id;
1427       --  Returns the next good ALI_Id record;
1428
1429       procedure Record_Failure
1430         (File  : File_Name_Type;
1431          Unit  : Unit_Name_Type;
1432          Found : Boolean := True);
1433       --  Records in the previous table that the compilation for File failed.
1434       --  If Found is False then the compilation of File failed because we
1435       --  could not find it. Records also Unit when possible.
1436
1437       function Bad_Compilation_Count return Natural;
1438       --  Returns the number of compilation failures.
1439
1440       procedure Debug_Msg (S : String; N : Name_Id);
1441       --  If Debug.Debug_Flag_W is set outputs string S followed by name N.
1442
1443       function Configuration_Pragmas_Switch
1444         (For_Project : Project_Id)
1445          return        Argument_List;
1446       --  Return an argument list of one element, if there is a configuration
1447       --  pragmas file to be specified for For_Project,
1448       --  otherwise return an empty argument list.
1449
1450       -----------------
1451       -- Add_Process --
1452       -----------------
1453
1454       procedure Add_Process
1455         (Pid   : Process_Id;
1456          Sfile : File_Name_Type;
1457          Afile : File_Name_Type;
1458          Uname : Unit_Name_Type)
1459       is
1460          OC1 : constant Positive := Outstanding_Compiles + 1;
1461
1462       begin
1463          pragma Assert (OC1 <= Max_Process);
1464          pragma Assert (Pid /= Invalid_Pid);
1465
1466          Running_Compile (OC1).Pid              := Pid;
1467          Running_Compile (OC1).Full_Source_File := Sfile;
1468          Running_Compile (OC1).Lib_File         := Afile;
1469          Running_Compile (OC1).Source_Unit      := Uname;
1470
1471          Outstanding_Compiles := OC1;
1472       end Add_Process;
1473
1474       --------------------
1475       -- Await_Compile --
1476       -------------------
1477
1478       procedure Await_Compile
1479         (Sfile  : out File_Name_Type;
1480          Afile  : out File_Name_Type;
1481          Uname  : out File_Name_Type;
1482          OK     : out Boolean)
1483       is
1484          Pid : Process_Id;
1485
1486       begin
1487          pragma Assert (Outstanding_Compiles > 0);
1488
1489          Sfile := No_File;
1490          Afile := No_File;
1491          Uname := No_Name;
1492          OK    := False;
1493
1494          Wait_Process (Pid, OK);
1495
1496          if Pid = Invalid_Pid then
1497             return;
1498          end if;
1499
1500          for J in Running_Compile'First .. Outstanding_Compiles loop
1501             if Pid = Running_Compile (J).Pid then
1502                Sfile := Running_Compile (J).Full_Source_File;
1503                Afile := Running_Compile (J).Lib_File;
1504                Uname := Running_Compile (J).Source_Unit;
1505
1506                --  To actually remove this Pid and related info from
1507                --  Running_Compile replace its entry with the last valid
1508                --  entry in Running_Compile.
1509
1510                if J = Outstanding_Compiles then
1511                   null;
1512
1513                else
1514                   Running_Compile (J) :=
1515                     Running_Compile (Outstanding_Compiles);
1516                end if;
1517
1518                Outstanding_Compiles := Outstanding_Compiles - 1;
1519                return;
1520             end if;
1521          end loop;
1522
1523          raise Program_Error;
1524       end Await_Compile;
1525
1526       ---------------------------
1527       -- Bad_Compilation_Count --
1528       ---------------------------
1529
1530       function Bad_Compilation_Count return Natural is
1531       begin
1532          return Bad_Compilation.Last - Bad_Compilation.First + 1;
1533       end Bad_Compilation_Count;
1534
1535       -----------------------------------
1536       -- Collect_Arguments_And_Compile --
1537       -----------------------------------
1538
1539       procedure Collect_Arguments_And_Compile is
1540       begin
1541          --  If no project file is used, then just call Compile with
1542          --  the specified Args.
1543
1544          if Main_Project = No_Project then
1545             Pid := Compile (Full_Source_File, Lib_File, Args);
1546
1547          --  A project file was used
1548
1549          else
1550             --  First check if the current source is an immediate
1551             --  source of a project file.
1552
1553             if Opt.Verbose_Mode then
1554                Write_Eol;
1555                Write_Line ("Establishing Project context.");
1556             end if;
1557
1558             declare
1559                Source_File_Name : constant String :=
1560                                     Name_Buffer (1 .. Name_Len);
1561                Current_Project  : Prj.Project_Id;
1562                Path_Name        : File_Name_Type := Source_File;
1563                Compiler_Package : Prj.Package_Id;
1564                Switches         : Prj.Variable_Value;
1565                Object_File      : String_Access;
1566
1567             begin
1568                if Opt.Verbose_Mode then
1569                   Write_Str ("Checking if the Project File exists for """);
1570                   Write_Str (Source_File_Name);
1571                   Write_Line (""".");
1572                end if;
1573
1574                Prj.Env.
1575                  Get_Reference
1576                  (Source_File_Name => Source_File_Name,
1577                   Project          => Current_Project,
1578                   Path             => Path_Name);
1579
1580                if Current_Project = No_Project then
1581
1582                   --  The current source is not an immediate source of any
1583                   --  project file. Call Compile with the specified Args plus
1584                   --  the saved gcc switches.
1585
1586                   if Opt.Verbose_Mode then
1587                      Write_Str ("No Project File.");
1588                      Write_Eol;
1589                   end if;
1590
1591                   Pid := Compile
1592                     (Full_Source_File,
1593                      Lib_File,
1594                      Args & The_Saved_Gcc_Switches.all);
1595
1596                --  We now know the project of the current source
1597
1598                else
1599                   --  Set ADA_INCLUDE_PATH and ADA_OBJECTS_PATH if the project
1600                   --  has changed.
1601
1602                   --  Note: this will modify these environment variables only
1603                   --  for the current gnatmake process and all of its children
1604                   --  (invocations of the compiler, the binder and the linker).
1605
1606                   --  The caller's ADA_INCLUDE_PATH and ADA_OBJECTS_PATH are
1607                   --  not affected.
1608
1609                   Set_Ada_Paths (Current_Project, True);
1610
1611                   Data := Projects.Table (Current_Project);
1612
1613                   --  Check if it is a library project that needs to be
1614                   --  processed, only if it is not the main project.
1615
1616                   if MLib.Tgt.Libraries_Are_Supported
1617                     and then Current_Project /= Main_Project
1618                     and then Data.Library
1619                     and then not Data.Flag1
1620                   then
1621                      --  Add to the Q all sources of the project that have
1622                      --  not been marked
1623
1624                      Insert_Project_Sources
1625                        (The_Project => Current_Project, Into_Q => True);
1626
1627                      --  Now mark the project as processed
1628
1629                      Data.Flag1 := True;
1630                      Projects.Table (Current_Project).Flag1 := True;
1631                   end if;
1632
1633                   Get_Name_String (Data.Object_Directory);
1634
1635                   if Name_Buffer (Name_Len) = '/'
1636                     or else Name_Buffer (Name_Len) = Directory_Separator
1637                   then
1638                      Object_File :=
1639                        new String'
1640                         (Name_Buffer (1 .. Name_Len) &
1641                          Object_File_Name (Source_File_Name));
1642
1643                   else
1644                      Object_File :=
1645                        new String'
1646                         (Name_Buffer (1 .. Name_Len) &
1647                          Directory_Separator &
1648                          Object_File_Name (Source_File_Name));
1649                   end if;
1650
1651                   if Opt.Verbose_Mode then
1652                      Write_Str ("Project file is """);
1653                      Write_Str (Get_Name_String (Data.Name));
1654                      Write_Str (""".");
1655                      Write_Eol;
1656                   end if;
1657
1658                   --  We know look for package Compiler
1659                   --  and get the switches from this package.
1660
1661                   if Opt.Verbose_Mode then
1662                      Write_Str ("Checking package Compiler.");
1663                      Write_Eol;
1664                   end if;
1665
1666                   Compiler_Package :=
1667                     Prj.Util.Value_Of
1668                     (Name        => Name_Compiler,
1669                      In_Packages => Data.Decl.Packages);
1670
1671                   if Compiler_Package /= No_Package then
1672
1673                      if Opt.Verbose_Mode then
1674                         Write_Str ("Getting the switches.");
1675                         Write_Eol;
1676                      end if;
1677
1678                      --  If package Gnatmake.Compiler exists, we get
1679                      --  the specific switches for the current source,
1680                      --  or the global switches, if any.
1681
1682                      declare
1683                         Defaults : constant Array_Element_Id :=
1684                                      Prj.Util.Value_Of
1685                                       (Name => Name_Default_Switches,
1686                                        In_Arrays =>
1687                                          Packages.Table
1688                                            (Compiler_Package) .Decl.Arrays);
1689
1690                         Switches_Array : constant Array_Element_Id :=
1691                                            Prj.Util.Value_Of
1692                                              (Name => Name_Switches,
1693                                               In_Arrays =>
1694                                                 Packages.Table
1695                                                   (Compiler_Package).
1696                                                               Decl.Arrays);
1697
1698                      begin
1699                         Switches :=
1700                           Prj.Util.Value_Of
1701                              (Index => Source_File,
1702                               In_Array => Switches_Array);
1703
1704                         if Switches = Nil_Variable_Value then
1705                            Switches :=
1706                              Prj.Util.Value_Of
1707                                (Index => Name_Ada, In_Array => Defaults);
1708                         end if;
1709                      end;
1710                   end if;
1711
1712                   case Switches.Kind is
1713
1714                      --  We have a list of switches. We add to Args
1715                      --  these switches, plus the saved gcc switches.
1716
1717                      when List =>
1718
1719                         declare
1720                            Current : String_List_Id := Switches.Values;
1721                            Element : String_Element;
1722                            Number  : Natural := 0;
1723
1724                         begin
1725                            while Current /= Nil_String loop
1726                               Element := String_Elements.Table (Current);
1727                               Number  := Number + 1;
1728                               Current := Element.Next;
1729                            end loop;
1730
1731                            declare
1732                               New_Args : Argument_List (1 .. Number);
1733
1734                            begin
1735                               Current := Switches.Values;
1736
1737                               for Index in New_Args'Range loop
1738                                  Element := String_Elements.Table (Current);
1739                                  String_To_Name_Buffer (Element.Value);
1740                                  New_Args (Index) :=
1741                                    new String' (Name_Buffer (1 .. Name_Len));
1742                                  Current := Element.Next;
1743                               end loop;
1744
1745                               Pid := Compile
1746                                 (Path_Name,
1747                                  Lib_File,
1748                                  Args & Output_Flag & Object_File &
1749                                  Configuration_Pragmas_Switch
1750                                                     (Current_Project) &
1751                                  New_Args & The_Saved_Gcc_Switches.all);
1752                            end;
1753                         end;
1754
1755                      --  We have a single switch. We add to Args
1756                      --  this switch, plus the saved gcc switches.
1757
1758                      when Single =>
1759
1760                         String_To_Name_Buffer (Switches.Value);
1761                         declare
1762                            New_Args : constant Argument_List :=
1763                                         (1 => new String'
1764                                                 (Name_Buffer (1 .. Name_Len)));
1765
1766                         begin
1767                            Pid := Compile
1768                              (Path_Name,
1769                               Lib_File,
1770                               Args &
1771                               Output_Flag &
1772                               Object_File &
1773                               New_Args &
1774                               Configuration_Pragmas_Switch (Current_Project) &
1775                                 The_Saved_Gcc_Switches.all);
1776                         end;
1777
1778                      --  We have no switches from Gnatmake.Compiler.
1779                      --  We add to Args the saved gcc switches.
1780
1781                      when Undefined =>
1782                         if Opt.Verbose_Mode then
1783                            Write_Str ("There are no switches.");
1784                            Write_Eol;
1785                         end if;
1786
1787                         Pid := Compile
1788                           (Path_Name,
1789                            Lib_File,
1790                            Args & Output_Flag & Object_File &
1791                              Configuration_Pragmas_Switch (Current_Project) &
1792                              The_Saved_Gcc_Switches.all);
1793                   end case;
1794                end if;
1795             end;
1796          end if;
1797       end Collect_Arguments_And_Compile;
1798
1799       -------------
1800       -- Compile --
1801       -------------
1802
1803       function Compile (S : Name_Id; L : Name_Id; Args : Argument_List)
1804         return Process_Id
1805       is
1806          Comp_Args : Argument_List (Args'First .. Args'Last + 7);
1807          Comp_Next : Integer := Args'First;
1808          Comp_Last : Integer;
1809
1810          function Ada_File_Name (Name : Name_Id) return Boolean;
1811          --  Returns True if Name is the name of an ada source file
1812          --  (i.e. suffix is .ads or .adb)
1813
1814          -------------------
1815          -- Ada_File_Name --
1816          -------------------
1817
1818          function Ada_File_Name (Name : Name_Id) return Boolean is
1819          begin
1820             Get_Name_String (Name);
1821             return
1822               Name_Len > 4
1823                 and then Name_Buffer (Name_Len - 3 .. Name_Len - 1) = ".ad"
1824                 and then (Name_Buffer (Name_Len) = 'b'
1825                             or else
1826                           Name_Buffer (Name_Len) = 's');
1827          end Ada_File_Name;
1828
1829       --  Start of processing for Compile
1830
1831       begin
1832          Comp_Args (Comp_Next) := Comp_Flag;
1833          Comp_Next := Comp_Next + 1;
1834
1835          --  Optimize the simple case where the gcc command line looks like
1836          --     gcc -c -I. ... -I- file.adb  --into->  gcc -c ... file.adb
1837
1838          if Args (Args'First).all = "-I" & Normalized_CWD
1839            and then Args (Args'Last).all = "-I-"
1840            and then S = Strip_Directory (S)
1841          then
1842             Comp_Last := Comp_Next + Args'Length - 3;
1843             Comp_Args (Comp_Next .. Comp_Last) :=
1844               Args (Args'First + 1 .. Args'Last - 1);
1845
1846          else
1847             Comp_Last := Comp_Next + Args'Length - 1;
1848             Comp_Args (Comp_Next .. Comp_Last) := Args;
1849          end if;
1850
1851          --  Set -gnatpg for predefined files (for this purpose the renamings
1852          --  such as Text_IO do not count as predefined). Note that we strip
1853          --  the directory name from the source file name becase the call to
1854          --  Fname.Is_Predefined_File_Name cannot deal with directory prefixes.
1855
1856          declare
1857             Fname : constant File_Name_Type := Strip_Directory (S);
1858
1859          begin
1860             if Is_Predefined_File_Name (Fname, False) then
1861                if Check_Readonly_Files then
1862                   Comp_Last := Comp_Last + 1;
1863                   Comp_Args (Comp_Last) := GNAT_Flag;
1864
1865                else
1866                   Fail
1867                     ("not allowed to compile """ &
1868                      Get_Name_String (Fname) &
1869                      """; use -a switch.");
1870                end if;
1871             end if;
1872          end;
1873
1874          --  Now check if the file name has one of the suffixes familiar to
1875          --  the gcc driver. If this is not the case then add the ada flag
1876          --  "-x ada".
1877
1878          if not Ada_File_Name (S) then
1879             Comp_Last := Comp_Last + 1;
1880             Comp_Args (Comp_Last) := Ada_Flag_1;
1881             Comp_Last := Comp_Last + 1;
1882             Comp_Args (Comp_Last) := Ada_Flag_2;
1883          end if;
1884
1885          if L /= Strip_Directory (L) then
1886
1887             --  Build -o argument.
1888
1889             Get_Name_String (L);
1890
1891             for J in reverse 1 .. Name_Len loop
1892                if Name_Buffer (J) = '.' then
1893                   Name_Len := J + Object_Suffix'Length - 1;
1894                   Name_Buffer (J .. Name_Len) := Object_Suffix;
1895                   exit;
1896                end if;
1897             end loop;
1898
1899             Comp_Last := Comp_Last + 1;
1900             Comp_Args (Comp_Last) := Output_Flag;
1901             Comp_Last := Comp_Last + 1;
1902             Comp_Args (Comp_Last) := new String'(Name_Buffer (1 .. Name_Len));
1903          end if;
1904
1905          Get_Name_String (S);
1906
1907          Comp_Last := Comp_Last + 1;
1908          Comp_Args (Comp_Last) := new String'(Name_Buffer (1 .. Name_Len));
1909
1910          Display (Gcc.all, Comp_Args (Args'First .. Comp_Last));
1911
1912          if Gcc_Path = null then
1913             Osint.Fail ("error, unable to locate " & Gcc.all);
1914          end if;
1915
1916          return
1917            GNAT.OS_Lib.Non_Blocking_Spawn
1918              (Gcc_Path.all, Comp_Args (Args'First .. Comp_Last));
1919       end Compile;
1920
1921       ----------------------------------
1922       -- Configuration_Pragmas_Switch --
1923       ----------------------------------
1924
1925       function Configuration_Pragmas_Switch
1926         (For_Project : Project_Id)
1927          return        Argument_List
1928       is
1929       begin
1930          Prj.Env.Create_Config_Pragmas_File (For_Project, Main_Project);
1931
1932          if Projects.Table (For_Project).Config_File_Name /= No_Name then
1933             return
1934               (1 => new String'("-gnatec" &
1935                     Get_Name_String
1936                       (Projects.Table (For_Project).Config_File_Name)));
1937
1938          else
1939             return (1 .. 0 => null);
1940          end if;
1941       end Configuration_Pragmas_Switch;
1942
1943       ---------------
1944       -- Debug_Msg --
1945       ---------------
1946
1947       procedure Debug_Msg (S : String; N : Name_Id) is
1948       begin
1949          if Debug.Debug_Flag_W then
1950             Write_Str ("   ... ");
1951             Write_Str (S);
1952             Write_Str (" ");
1953             Write_Name (N);
1954             Write_Eol;
1955          end if;
1956       end Debug_Msg;
1957
1958       -----------------------
1959       -- Get_Next_Good_ALI --
1960       -----------------------
1961
1962       function Get_Next_Good_ALI return ALI_Id is
1963          ALI : ALI_Id;
1964
1965       begin
1966          pragma Assert (Good_ALI_Present);
1967          ALI := Good_ALI.Table (Good_ALI.Last);
1968          Good_ALI.Decrement_Last;
1969          return ALI;
1970       end Get_Next_Good_ALI;
1971
1972       ----------------------
1973       -- Good_ALI_Present --
1974       ----------------------
1975
1976       function Good_ALI_Present return Boolean is
1977       begin
1978          return Good_ALI.First <= Good_ALI.Last;
1979       end Good_ALI_Present;
1980
1981       --------------------
1982       -- Record_Failure --
1983       --------------------
1984
1985       procedure Record_Failure
1986         (File  : File_Name_Type;
1987          Unit  : Unit_Name_Type;
1988          Found : Boolean := True)
1989       is
1990       begin
1991          Bad_Compilation.Increment_Last;
1992          Bad_Compilation.Table (Bad_Compilation.Last) := (File, Unit, Found);
1993       end Record_Failure;
1994
1995       ---------------------
1996       -- Record_Good_ALI --
1997       ---------------------
1998
1999       procedure Record_Good_ALI (A : ALI_Id) is
2000       begin
2001          Good_ALI.Increment_Last;
2002          Good_ALI.Table (Good_ALI.Last) := A;
2003       end Record_Good_ALI;
2004
2005    --  Start of processing for Compile_Sources
2006
2007    begin
2008       pragma Assert (Args'First = 1);
2009
2010       --  Package and Queue initializations.
2011
2012       Good_ALI.Init;
2013       Bad_Compilation.Init;
2014       Output.Set_Standard_Error;
2015       Init_Q;
2016
2017       if Initialize_ALI_Data then
2018          Initialize_ALI;
2019          Initialize_ALI_Source;
2020       end if;
2021
2022       --  The following two flags affect the behavior of ALI.Set_Source_Table.
2023       --  We set Opt.Check_Source_Files to True to ensure that source file
2024       --  time stamps are checked, and we set Opt.All_Sources to False to
2025       --  avoid checking the presence of the source files listed in the
2026       --  source dependency section of an ali file (which would be a mistake
2027       --  since the ali file may be obsolete).
2028
2029       Opt.Check_Source_Files := True;
2030       Opt.All_Sources        := False;
2031
2032       --  If the main source is marked, there is nothing to compile.
2033       --  This can happen when we have several main subprograms.
2034       --  For the first main, we always insert in the Q.
2035
2036       if not Is_Marked (Main_Source) then
2037          Insert_Q (Main_Source);
2038          Mark (Main_Source);
2039       end if;
2040
2041       First_Compiled_File  := No_File;
2042       Most_Recent_Obj_File := No_File;
2043       Main_Unit            := False;
2044
2045       --  Keep looping until there is no more work to do (the Q is empty)
2046       --  and all the outstanding compilations have terminated
2047
2048       Make_Loop : while not Empty_Q or else Outstanding_Compiles > 0 loop
2049
2050          --  If the user does not want to keep going in case of errors then
2051          --  wait for the remaining outstanding compiles and then exit.
2052
2053          if Bad_Compilation_Count > 0 and then not Keep_Going then
2054             while Outstanding_Compiles > 0 loop
2055                Await_Compile
2056                  (Full_Source_File, Lib_File, Source_Unit, Compilation_OK);
2057
2058                if not Compilation_OK then
2059                   Record_Failure (Full_Source_File, Source_Unit);
2060                end if;
2061             end loop;
2062
2063             exit Make_Loop;
2064          end if;
2065
2066          --  PHASE 1: Check if there is more work that we can do (ie the Q
2067          --  is non empty). If there is, do it only if we have not yet used
2068          --  up all the available processes.
2069
2070          if not Empty_Q and then Outstanding_Compiles < Max_Process then
2071             Extract_From_Q (Source_File, Source_Unit);
2072             Full_Source_File := Osint.Full_Source_Name (Source_File);
2073             Lib_File         := Osint.Lib_File_Name (Source_File);
2074             Full_Lib_File    := Osint.Full_Lib_File_Name (Lib_File);
2075
2076             --  If the library file is an Ada library skip it
2077
2078             if Full_Lib_File /= No_File
2079               and then In_Ada_Lib_Dir (Full_Lib_File)
2080             then
2081                Verbose_Msg (Lib_File, "is in an Ada library", Prefix => "  ");
2082
2083             --  If the library file is a read-only library skip it
2084
2085             elsif Full_Lib_File /= No_File
2086               and then not Check_Readonly_Files
2087               and then Is_Readonly_Library (Full_Lib_File)
2088             then
2089                Verbose_Msg
2090                  (Lib_File, "is a read-only library", Prefix => "  ");
2091
2092             --  The source file that we are checking cannot be located
2093
2094             elsif Full_Source_File = No_File then
2095                Record_Failure (Source_File, Source_Unit, False);
2096
2097             --  Source and library files can be located but are internal
2098             --  files
2099
2100             elsif not Check_Readonly_Files
2101               and then Full_Lib_File /= No_File
2102               and then Is_Internal_File_Name (Source_File)
2103             then
2104
2105                if Force_Compilations then
2106                   Fail
2107                     ("not allowed to compile """ &
2108                      Get_Name_String (Source_File) &
2109                      """; use -a switch.");
2110                end if;
2111
2112                Verbose_Msg
2113                  (Lib_File, "is an internal library", Prefix => "  ");
2114
2115             --  The source file that we are checking can be located
2116
2117             else
2118                --  Don't waste any time if we have to recompile anyway
2119
2120                Obj_Stamp       := Empty_Time_Stamp;
2121                Need_To_Compile := Force_Compilations;
2122
2123                if not Force_Compilations then
2124                   Check (Lib_File, ALI, Obj_File, Obj_Stamp);
2125                   Need_To_Compile := (ALI = No_ALI_Id);
2126                end if;
2127
2128                if not Need_To_Compile then
2129
2130                   --  The ALI file is up-to-date. Record its Id.
2131
2132                   Record_Good_ALI (ALI);
2133
2134                   --  Record the time stamp of the most recent object file
2135                   --  as long as no (re)compilations are needed.
2136
2137                   if First_Compiled_File = No_File
2138                     and then (Most_Recent_Obj_File = No_File
2139                               or else Obj_Stamp > Most_Recent_Obj_Stamp)
2140                   then
2141                      Most_Recent_Obj_File  := Obj_File;
2142                      Most_Recent_Obj_Stamp := Obj_Stamp;
2143                   end if;
2144
2145                else
2146                   --  Is this the first file we have to compile?
2147
2148                   if First_Compiled_File = No_File then
2149                      First_Compiled_File  := Full_Source_File;
2150                      Most_Recent_Obj_File := No_File;
2151
2152                      if Do_Not_Execute then
2153                         exit Make_Loop;
2154                      end if;
2155                   end if;
2156
2157                   if In_Place_Mode then
2158
2159                      --  If the library file was not found, then save the
2160                      --  library file near the source file.
2161
2162                      if Full_Lib_File = No_File then
2163                         Get_Name_String (Full_Source_File);
2164
2165                         for J in reverse 1 .. Name_Len loop
2166                            if Name_Buffer (J) = '.' then
2167                               Name_Buffer (J + 1 .. J + 3) := "ali";
2168                               Name_Len := J + 3;
2169                               exit;
2170                            end if;
2171                         end loop;
2172
2173                         Lib_File := Name_Find;
2174
2175                      --  If the library file was found, then save the
2176                      --  library file in the same place.
2177
2178                      else
2179                         Lib_File := Full_Lib_File;
2180                      end if;
2181
2182                   end if;
2183
2184                   --  Check for special compilation flags
2185
2186                   Arg_Index := 0;
2187                   Get_Name_String (Source_File);
2188
2189                   --  Start the compilation and record it. We can do this
2190                   --  because there is at least one free process.
2191
2192                   Collect_Arguments_And_Compile;
2193
2194                   --  Make sure we could successfully start the compilation
2195
2196                   if Pid = Invalid_Pid then
2197                      Record_Failure (Full_Source_File, Source_Unit);
2198                   else
2199                      Add_Process
2200                        (Pid, Full_Source_File, Lib_File, Source_Unit);
2201                   end if;
2202                end if;
2203             end if;
2204          end if;
2205
2206          --  PHASE 2: Now check if we should wait for a compilation to
2207          --  finish. This is the case if all the available processes are
2208          --  busy compiling sources or there is nothing else to do
2209          --  (that is the Q is empty and there are no good ALIs to process).
2210
2211          if Outstanding_Compiles = Max_Process
2212            or else (Empty_Q
2213                      and then not Good_ALI_Present
2214                      and then Outstanding_Compiles > 0)
2215          then
2216             Await_Compile
2217               (Full_Source_File, Lib_File, Source_Unit, Compilation_OK);
2218
2219             if not Compilation_OK then
2220                Record_Failure (Full_Source_File, Source_Unit);
2221
2222             else
2223                --  Re-read the updated library file
2224
2225                Text := Read_Library_Info (Lib_File);
2226
2227                --  If no ALI file was generated by this compilation nothing
2228                --  more to do, otherwise scan the ali file and record it.
2229                --  If the scan fails, a previous ali file is inconsistent with
2230                --  the unit just compiled.
2231
2232                if Text /= null then
2233                   ALI :=
2234                     Scan_ALI (Lib_File, Text, Ignore_ED => False, Err => True);
2235
2236                   if ALI = No_ALI_Id then
2237                      Inform
2238                        (Lib_File, "incompatible ALI file, please recompile");
2239                      Record_Failure (Full_Source_File, Source_Unit);
2240                   else
2241                      Free (Text);
2242                      Record_Good_ALI (ALI);
2243                   end if;
2244
2245                --  If we could not read the ALI file that was just generated
2246                --  then there could be a problem reading either the ALI or the
2247                --  corresponding object file (if Opt.Check_Object_Consistency
2248                --  is set Read_Library_Info checks that the time stamp of the
2249                --  object file is more recent than that of the ALI). For an
2250                --  example of problems caught by this test see [6625-009].
2251
2252                else
2253                   Inform
2254                     (Lib_File,
2255                      "WARNING: ALI or object file not found after compile");
2256                   Record_Failure (Full_Source_File, Source_Unit);
2257                end if;
2258             end if;
2259          end if;
2260
2261          exit Make_Loop when Unique_Compile;
2262
2263          --  PHASE 3: Check if we recorded good ALI files. If yes process
2264          --  them now in the order in which they have been recorded. There
2265          --  are two occasions in which we record good ali files. The first is
2266          --  in phase 1 when, after scanning an existing ALI file we realise
2267          --  it is up-to-date, the second instance is after a successful
2268          --  compilation.
2269
2270          while Good_ALI_Present loop
2271             ALI := Get_Next_Good_ALI;
2272
2273             --  If we are processing the library file corresponding to the
2274             --  main source file check if this source can be a main unit.
2275
2276             if ALIs.Table (ALI).Sfile = Main_Source then
2277                Main_Unit := ALIs.Table (ALI).Main_Program /= None;
2278             end if;
2279
2280             --  The following adds the standard library (s-stalib) to the
2281             --  list of files to be handled by gnatmake: this file and any
2282             --  files it depends on are always included in every bind,
2283             --  except in No_Run_Time mode, even if they are not
2284             --  in the explicit dependency list.
2285
2286             --  However, to avoid annoying output about s-stalib.ali being
2287             --  read only, when "-v" is used, we add the standard library
2288             --  only when "-a" is used.
2289
2290             if Need_To_Check_Standard_Library then
2291                Need_To_Check_Standard_Library := False;
2292
2293                if not ALIs.Table (ALI).No_Run_Time then
2294                   declare
2295                      Sfile : Name_Id;
2296
2297                   begin
2298                      Name_Len := Standard_Library_Package_Body_Name'Length;
2299                      Name_Buffer (1 .. Name_Len) :=
2300                        Standard_Library_Package_Body_Name;
2301                      Sfile := Name_Enter;
2302
2303                      if not Is_Marked (Sfile) then
2304                         Insert_Q (Sfile);
2305                         Mark (Sfile);
2306                      end if;
2307                   end;
2308                end if;
2309             end if;
2310
2311             --  Now insert in the Q the unmarked source files (i.e. those
2312             --  which have neever been inserted in the Q and hence never
2313             --  considered).
2314
2315             for J in
2316               ALIs.Table (ALI).First_Unit .. ALIs.Table (ALI).Last_Unit
2317             loop
2318                for K in
2319                  Units.Table (J).First_With .. Units.Table (J).Last_With
2320                loop
2321                   Sfile := Withs.Table (K).Sfile;
2322
2323                   if Sfile = No_File then
2324                      Debug_Msg ("Skipping generic:", Withs.Table (K).Uname);
2325
2326                   elsif Is_Marked (Sfile) then
2327                      Debug_Msg ("Skipping marked file:", Sfile);
2328
2329                   elsif not Check_Readonly_Files
2330                     and then Is_Internal_File_Name (Sfile)
2331                   then
2332                      Debug_Msg ("Skipping internal file:", Sfile);
2333
2334                   else
2335                      Insert_Q (Sfile, Withs.Table (K).Uname);
2336                      Mark (Sfile);
2337                   end if;
2338                end loop;
2339             end loop;
2340          end loop;
2341
2342          if Opt.Display_Compilation_Progress then
2343             Write_Str ("completed ");
2344             Write_Int (Int (Q_Front));
2345             Write_Str (" out of ");
2346             Write_Int (Int (Q.Last));
2347             Write_Str (" (");
2348             Write_Int (Int ((Q_Front * 100) / (Q.Last - Q.First)));
2349             Write_Str ("%)...");
2350             Write_Eol;
2351          end if;
2352       end loop Make_Loop;
2353
2354       Compilation_Failures := Bad_Compilation_Count;
2355
2356       --  Compilation is finished
2357
2358       --  Delete any temporary configuration pragma file
2359
2360       if Main_Project /= No_Project then
2361          declare
2362             Success : Boolean;
2363
2364          begin
2365             for Project in 1 .. Projects.Last loop
2366                if Projects.Table (Project).Config_File_Temp then
2367                   if Opt.Verbose_Mode then
2368                      Write_Str ("Deleting temp configuration file """);
2369                      Write_Str (Get_Name_String
2370                                 (Projects.Table (Project).Config_File_Name));
2371                      Write_Line ("""");
2372                   end if;
2373
2374                   Delete_File
2375                     (Name    => Get_Name_String
2376                                   (Projects.Table (Project).Config_File_Name),
2377                      Success => Success);
2378
2379                   --  Make sure that we don't have a config file for this
2380                   --  project, in case when there are several mains.
2381                   --  In this case, we will recreate another config file:
2382                   --  we cannot reuse the one that we just deleted!
2383
2384                   Projects.Table (Project).Config_Checked   := False;
2385                   Projects.Table (Project).Config_File_Name := No_Name;
2386                   Projects.Table (Project).Config_File_Temp := False;
2387                end if;
2388             end loop;
2389          end;
2390       end if;
2391
2392    end Compile_Sources;
2393
2394    -------------
2395    -- Display --
2396    -------------
2397
2398    procedure Display (Program : String; Args : Argument_List) is
2399    begin
2400       pragma Assert (Args'First = 1);
2401
2402       if Display_Executed_Programs then
2403          Write_Str (Program);
2404
2405          for J in Args'Range loop
2406             Write_Str (" ");
2407             Write_Str (Args (J).all);
2408          end loop;
2409
2410          Write_Eol;
2411       end if;
2412    end Display;
2413
2414    ----------------------
2415    -- Display_Commands --
2416    ----------------------
2417
2418    procedure Display_Commands (Display : Boolean := True) is
2419    begin
2420       Display_Executed_Programs := Display;
2421    end Display_Commands;
2422
2423    -------------
2424    -- Empty_Q --
2425    -------------
2426
2427    function Empty_Q return Boolean is
2428    begin
2429       if Debug.Debug_Flag_P then
2430          Write_Str ("   Q := [");
2431
2432          for J in Q_Front .. Q.Last - 1 loop
2433             Write_Str (" ");
2434             Write_Name (Q.Table (J).File);
2435             Write_Eol;
2436             Write_Str ("         ");
2437          end loop;
2438
2439          Write_Str ("]");
2440          Write_Eol;
2441       end if;
2442
2443       return Q_Front >= Q.Last;
2444    end Empty_Q;
2445
2446    ---------------------
2447    -- Extract_Failure --
2448    ---------------------
2449
2450    procedure Extract_Failure
2451      (File  : out File_Name_Type;
2452       Unit  : out Unit_Name_Type;
2453       Found : out Boolean)
2454    is
2455    begin
2456       File  := Bad_Compilation.Table (Bad_Compilation.Last).File;
2457       Unit  := Bad_Compilation.Table (Bad_Compilation.Last).Unit;
2458       Found := Bad_Compilation.Table (Bad_Compilation.Last).Found;
2459       Bad_Compilation.Decrement_Last;
2460    end Extract_Failure;
2461
2462    --------------------
2463    -- Extract_From_Q --
2464    --------------------
2465
2466    procedure Extract_From_Q
2467      (Source_File : out File_Name_Type;
2468       Source_Unit : out Unit_Name_Type)
2469    is
2470       File : constant File_Name_Type := Q.Table (Q_Front).File;
2471       Unit : constant Unit_Name_Type := Q.Table (Q_Front).Unit;
2472
2473    begin
2474       if Debug.Debug_Flag_Q then
2475          Write_Str ("   Q := Q - [ ");
2476          Write_Name (File);
2477          Write_Str (" ]");
2478          Write_Eol;
2479       end if;
2480
2481       Q_Front := Q_Front + 1;
2482       Source_File := File;
2483       Source_Unit := Unit;
2484    end Extract_From_Q;
2485
2486    --------------
2487    -- Gnatmake --
2488    --------------
2489
2490    procedure Gnatmake is
2491       Main_Source_File : File_Name_Type;
2492       --  The source file containing the main compilation unit
2493
2494       Compilation_Failures : Natural;
2495
2496       Is_Main_Unit : Boolean;
2497       --  Set to True by Compile_Sources if the Main_Source_File can be a
2498       --  main unit.
2499
2500       Main_ALI_File : File_Name_Type;
2501       --  The ali file corresponding to Main_Source_File
2502
2503       Executable : File_Name_Type := No_File;
2504       --  The file name of an executable
2505
2506       Non_Std_Executable  : Boolean        := False;
2507       --  Non_Std_Executable is set to True when there is a possibility
2508       --  that the linker will not choose the correct executable file name.
2509
2510       Executable_Obsolete : Boolean := False;
2511       --  Executable_Obsolete is set to True for the first obsolete main
2512       --  and is never reset to False. Any subsequent main will always
2513       --  be rebuild (if we rebuild mains), even in the case when it is not
2514       --  really necessary, because it is too hard to decide.
2515
2516    begin
2517       Do_Compile_Step := True;
2518       Do_Bind_Step    := True;
2519       Do_Link_Step    := True;
2520
2521       Make.Initialize;
2522
2523       if Hostparm.Java_VM then
2524          Gcc := new String'("jgnat");
2525          Gnatbind := new String'("jgnatbind");
2526          Gnatlink := new String '("jgnatlink");
2527
2528          --  Do not check for an object file (".o") when compiling to
2529          --  Java bytecode since ".class" files are generated instead.
2530
2531          Opt.Check_Object_Consistency := False;
2532       end if;
2533
2534       if Opt.Verbose_Mode then
2535          Write_Eol;
2536          Write_Str ("GNATMAKE ");
2537          Write_Str (Gnatvsn.Gnat_Version_String);
2538          Write_Str (" Copyright 1995-2001 Free Software Foundation, Inc.");
2539          Write_Eol;
2540       end if;
2541
2542       --  If no mains have been specified on the command line,
2543       --  and we are using a project file, we either find the main(s)
2544       --  in the attribute Main of the main project, or we put all
2545       --  the sources of the project file as mains.
2546
2547       if Main_Project /= No_Project and then Osint.Number_Of_Files = 0 then
2548          Name_Len := 4;
2549          Name_Buffer (1 .. 4) := "main";
2550
2551          declare
2552             Main_Id : constant Name_Id := Name_Find;
2553
2554             Mains   : constant Prj.Variable_Value :=
2555                         Prj.Util.Value_Of
2556                          (Variable_Name => Main_Id,
2557                           In_Variables  =>
2558                             Projects.Table (Main_Project).Decl.Attributes);
2559
2560             Value : String_List_Id := Mains.Values;
2561
2562          begin
2563             --  The attribute Main is an empty list or not specified,
2564             --  or else gnatmake was invoked with the switch "-u".
2565
2566             if Value = Prj.Nil_String or else Unique_Compile then
2567
2568                --  First make sure that the binder and the linker
2569                --  will not be invoked.
2570
2571                Do_Bind_Step := False;
2572                Do_Link_Step := False;
2573
2574                --  Put all the sources in the queue
2575
2576                Insert_Project_Sources
2577                  (The_Project => Main_Project, Into_Q => False);
2578
2579             else
2580                --  The attribute Main is not an empty list.
2581                --  Put all the main subprograms in the list as if there were
2582                --  specified on the command line.
2583
2584                while Value /= Prj.Nil_String loop
2585                   String_To_Name_Buffer (String_Elements.Table (Value).Value);
2586                   Osint.Add_File (Name_Buffer (1 .. Name_Len));
2587                   Value := String_Elements.Table (Value).Next;
2588                end loop;
2589
2590             end if;
2591          end;
2592
2593       end if;
2594
2595       --  Output usage information if no files. Note that this can happen
2596       --  in the case of a project file that contains only subunits.
2597
2598       if Osint.Number_Of_Files = 0 then
2599          Makeusg;
2600          Exit_Program (E_Fatal);
2601
2602       end if;
2603
2604       --  If -l was specified behave as if -n was specified
2605
2606       if Opt.List_Dependencies then
2607          Opt.Do_Not_Execute := True;
2608       end if;
2609
2610       --  Note that Osint.Next_Main_Source will always return the (possibly
2611       --  abbreviated file) without any directory information.
2612
2613       Main_Source_File := Next_Main_Source;
2614
2615       if Project_File_Name = null then
2616          Add_Switch ("-I-", Compiler, And_Save => True);
2617          Add_Switch ("-I-", Binder, And_Save => True);
2618       end if;
2619
2620       if Opt.Look_In_Primary_Dir then
2621
2622          Add_Switch
2623            ("-I" &
2624             Normalize_Directory_Name
2625               (Get_Primary_Src_Search_Directory.all).all,
2626             Compiler, Append_Switch => False,
2627             And_Save => False);
2628
2629          Add_Switch ("-aO" & Normalized_CWD,
2630                      Binder,
2631                      Append_Switch => False,
2632                      And_Save => False);
2633       end if;
2634
2635       --  If the user wants a program without a main subprogram, add the
2636       --  appropriate switch to the binder.
2637
2638       if Opt.No_Main_Subprogram then
2639          Add_Switch ("-z", Binder, And_Save => True);
2640       end if;
2641
2642       if Main_Project /= No_Project then
2643
2644          --  Find the file name of the main unit
2645
2646          declare
2647             Main_Source_File_Name : constant String :=
2648                                       Get_Name_String (Main_Source_File);
2649             Main_Unit_File_Name   : constant String :=
2650                                       Prj.Env.File_Name_Of_Library_Unit_Body
2651                                         (Name    => Main_Source_File_Name,
2652                                          Project => Main_Project);
2653
2654             The_Packages : constant Package_Id :=
2655               Projects.Table (Main_Project).Decl.Packages;
2656
2657             Gnatmake : constant Prj.Package_Id :=
2658                          Prj.Util.Value_Of
2659                            (Name        => Name_Builder,
2660                             In_Packages => The_Packages);
2661
2662             Binder_Package : constant Prj.Package_Id :=
2663                          Prj.Util.Value_Of
2664                            (Name        => Name_Binder,
2665                             In_Packages => The_Packages);
2666
2667             Linker_Package : constant Prj.Package_Id :=
2668                          Prj.Util.Value_Of
2669                            (Name       => Name_Linker,
2670                            In_Packages => The_Packages);
2671
2672          begin
2673             --  We fail if we cannot find the main source file
2674             --  as an immediate source of the main project file.
2675
2676             if Main_Unit_File_Name = "" then
2677                Fail ('"' & Main_Source_File_Name  &
2678                      """ is not a unit of project " &
2679                      Project_File_Name.all & ".");
2680             else
2681                --  Remove any directory information from the main
2682                --  source file name.
2683
2684                declare
2685                   Pos : Natural := Main_Unit_File_Name'Last;
2686
2687                begin
2688                   loop
2689                      exit when Pos < Main_Unit_File_Name'First or else
2690                        Main_Unit_File_Name (Pos) = Directory_Separator;
2691                      Pos := Pos - 1;
2692                   end loop;
2693
2694                   Name_Len := Main_Unit_File_Name'Last - Pos;
2695
2696                   Name_Buffer (1 .. Name_Len) :=
2697                     Main_Unit_File_Name
2698                     (Pos + 1 .. Main_Unit_File_Name'Last);
2699
2700                   Main_Source_File := Name_Find;
2701
2702                   --  We only output the main source file if there is only one
2703
2704                   if Opt.Verbose_Mode and then Osint.Number_Of_Files = 1 then
2705                      Write_Str ("Main source file: """);
2706                      Write_Str (Main_Unit_File_Name
2707                                 (Pos + 1 .. Main_Unit_File_Name'Last));
2708                      Write_Line (""".");
2709                   end if;
2710                end;
2711             end if;
2712
2713             --  If there is a package gnatmake in the main project file, add
2714             --  the switches from it. We also add the switches from packages
2715             --  gnatbind and gnatlink, if any.
2716
2717             if Gnatmake /= No_Package then
2718
2719                --  If there is only one main, we attempt to get the gnatmake
2720                --  switches for this main (if any). If there are no specific
2721                --  switch for this particular main, get the general gnatmake
2722                --  switches (if any).
2723
2724                if Osint.Number_Of_Files = 1 then
2725                   if Opt.Verbose_Mode then
2726                      Write_Str ("Adding gnatmake switches for """);
2727                      Write_Str (Main_Unit_File_Name);
2728                      Write_Line (""".");
2729                   end if;
2730
2731                   Add_Switches
2732                     (File_Name   => Main_Unit_File_Name,
2733                      The_Package => Gnatmake,
2734                      Program     => None);
2735
2736                else
2737                   --  If there are several mains, we always get the general
2738                   --  gnatmake switches (if any).
2739
2740                   --  Note: As there is never a source with name " ",
2741                   --  we are guaranteed to always get the gneneral switches.
2742
2743                   Add_Switches
2744                     (File_Name   => " ",
2745                      The_Package => Gnatmake,
2746                      Program     => None);
2747                end if;
2748
2749             end if;
2750
2751             if Binder_Package /= No_Package then
2752
2753                --  If there is only one main, we attempt to get the gnatbind
2754                --  switches for this main (if any). If there are no specific
2755                --  switch for this particular main, get the general gnatbind
2756                --  switches (if any).
2757
2758                if Osint.Number_Of_Files = 1 then
2759                   if Opt.Verbose_Mode then
2760                      Write_Str ("Adding binder switches for """);
2761                      Write_Str (Main_Unit_File_Name);
2762                      Write_Line (""".");
2763                   end if;
2764
2765                   Add_Switches
2766                     (File_Name   => Main_Unit_File_Name,
2767                      The_Package => Binder_Package,
2768                      Program     => Binder);
2769
2770                else
2771                   --  If there are several mains, we always get the general
2772                   --  gnatbind switches (if any).
2773
2774                   --  Note: As there is never a source with name " ",
2775                   --  we are guaranteed to always get the gneneral switches.
2776
2777                   Add_Switches
2778                     (File_Name   => " ",
2779                      The_Package => Binder_Package,
2780                      Program     => Binder);
2781                end if;
2782
2783             end if;
2784
2785             if Linker_Package /= No_Package then
2786
2787                --  If there is only one main, we attempt to get the
2788                --  gnatlink switches for this main (if any). If there are
2789                --  no specific switch for this particular main, we get the
2790                --  general gnatlink switches (if any).
2791
2792                if Osint.Number_Of_Files = 1 then
2793                   if Opt.Verbose_Mode then
2794                      Write_Str ("Adding linker switches for""");
2795                      Write_Str (Main_Unit_File_Name);
2796                      Write_Line (""".");
2797                   end if;
2798
2799                   Add_Switches
2800                     (File_Name   => Main_Unit_File_Name,
2801                      The_Package => Linker_Package,
2802                      Program     => Linker);
2803
2804                else
2805                   --  If there are several mains, we always get the general
2806                   --  gnatlink switches (if any).
2807
2808                   --  Note: As there is never a source with name " ",
2809                   --  we are guaranteed to always get the general switches.
2810
2811                   Add_Switches
2812                     (File_Name   => " ",
2813                      The_Package => Linker_Package,
2814                      Program     => Linker);
2815                end if;
2816             end if;
2817          end;
2818       end if;
2819
2820       Display_Commands (not Opt.Quiet_Output);
2821
2822       --  We now put in the Binder_Switches and Linker_Switches tables,
2823       --  the binder and linker switches of the command line that have been
2824       --  put in the Saved_ tables. If a project file was used, then the
2825       --  command line switches will follow the project file switches.
2826
2827       for J in 1 .. Saved_Binder_Switches.Last loop
2828          Add_Switch
2829            (Saved_Binder_Switches.Table (J),
2830             Binder,
2831             And_Save => False);
2832       end loop;
2833
2834       for J in 1 .. Saved_Linker_Switches.Last loop
2835          Add_Switch
2836            (Saved_Linker_Switches.Table (J),
2837             Linker,
2838             And_Save => False);
2839       end loop;
2840
2841       --  If no project file is used, we just put the gcc switches
2842       --  from the command line in the Gcc_Switches table.
2843
2844       if Main_Project = No_Project then
2845          for J in 1 .. Saved_Gcc_Switches.Last loop
2846             Add_Switch
2847               (Saved_Gcc_Switches.Table (J),
2848                Compiler,
2849               And_Save => False);
2850          end loop;
2851
2852       else
2853          --  And we put the command line gcc switches in the variable
2854          --  The_Saved_Gcc_Switches. They are going to be used later
2855          --  in procedure Compile_Sources.
2856
2857          The_Saved_Gcc_Switches :=
2858            new Argument_List (1 .. Saved_Gcc_Switches.Last + 1);
2859
2860          for J in 1 .. Saved_Gcc_Switches.Last loop
2861             The_Saved_Gcc_Switches (J) := Saved_Gcc_Switches.Table (J);
2862          end loop;
2863
2864          --  We never use gnat.adc when a project file is used
2865
2866          The_Saved_Gcc_Switches (The_Saved_Gcc_Switches'Last) :=
2867            No_gnat_adc;
2868       end if;
2869
2870       --  If there was a --GCC, --GNATBIND or --GNATLINK switch on
2871       --  the command line, then we have to use it, even if there was
2872       --  another switch in the project file.
2873
2874       if Saved_Gcc /= null then
2875          Gcc := Saved_Gcc;
2876       end if;
2877
2878       if Saved_Gnatbind /= null then
2879          Gnatbind := Saved_Gnatbind;
2880       end if;
2881
2882       if Saved_Gnatlink /= null then
2883          Gnatlink := Saved_Gnatlink;
2884       end if;
2885
2886       Gcc_Path       := GNAT.OS_Lib.Locate_Exec_On_Path (Gcc.all);
2887       Gnatbind_Path  := GNAT.OS_Lib.Locate_Exec_On_Path (Gnatbind.all);
2888       Gnatlink_Path  := GNAT.OS_Lib.Locate_Exec_On_Path (Gnatlink.all);
2889
2890       --  If we have specified -j switch both from the project file
2891       --  and on the command line, the one from the command line takes
2892       --  precedence.
2893
2894       if Saved_Maximum_Processes = 0 then
2895          Saved_Maximum_Processes := Opt.Maximum_Processes;
2896       end if;
2897
2898       --  If either -c, -b or -l has been specified, we will not necessarily
2899       --  execute all steps.
2900
2901       if Compile_Only or else Bind_Only or else Link_Only then
2902          Do_Compile_Step := Do_Compile_Step and Compile_Only;
2903          Do_Bind_Step    := Do_Bind_Step    and Bind_Only;
2904          Do_Link_Step    := Do_Link_Step    and Link_Only;
2905
2906          --  If -c has been specified, but not -b, ignore any potential -l
2907
2908          if Do_Compile_Step and then not Do_Bind_Step then
2909             Do_Link_Step := False;
2910          end if;
2911       end if;
2912
2913       --  Here is where the make process is started
2914
2915       --  We do the same process for each main
2916
2917       Multiple_Main_Loop : for N_File in 1 .. Osint.Number_Of_Files loop
2918
2919          if Do_Compile_Step then
2920             Recursive_Compilation_Step : declare
2921                Args : Argument_List (1 .. Gcc_Switches.Last);
2922
2923                First_Compiled_File : Name_Id;
2924
2925                Youngest_Obj_File   : Name_Id;
2926                Youngest_Obj_Stamp  : Time_Stamp_Type;
2927
2928                Executable_Stamp    : Time_Stamp_Type;
2929                --  Executable is the final executable program.
2930
2931             begin
2932                Executable         := No_File;
2933                Non_Std_Executable := False;
2934
2935                for J in 1 .. Gcc_Switches.Last loop
2936                   Args (J) := Gcc_Switches.Table (J);
2937                end loop;
2938
2939                --  Look inside the linker switches to see if the name
2940                --  of the final executable program was specified.
2941
2942                for J in Linker_Switches.First .. Linker_Switches.Last loop
2943                   if Linker_Switches.Table (J).all = Output_Flag.all then
2944                      pragma Assert (J < Linker_Switches.Last);
2945
2946                      --  We cannot specify a single executable for several
2947                      --  main subprograms!
2948
2949                      if Osint.Number_Of_Files > 1 then
2950                         Fail
2951                            ("cannot specify a single executable " &
2952                             "for several mains");
2953                      end if;
2954
2955                      Name_Len := Linker_Switches.Table (J + 1)'Length;
2956                      Name_Buffer (1 .. Name_Len) :=
2957                        Linker_Switches.Table (J + 1).all;
2958
2959                      --  If target has an executable suffix and it has not been
2960                      --  specified then it is added here.
2961
2962                      if Executable_Suffix'Length /= 0
2963                        and then Linker_Switches.Table (J + 1)
2964                                  (Name_Len - Executable_Suffix'Length + 1
2965                                   .. Name_Len) /= Executable_Suffix
2966                      then
2967                         Name_Buffer (Name_Len + 1 ..
2968                                      Name_Len + Executable_Suffix'Length) :=
2969                           Executable_Suffix;
2970                         Name_Len := Name_Len + Executable_Suffix'Length;
2971                      end if;
2972
2973                      Executable := Name_Enter;
2974
2975                      Verbose_Msg (Executable, "final executable");
2976                   end if;
2977                end loop;
2978
2979                --  If the name of the final executable program was not
2980                --  specified then construct it from the main input file.
2981
2982                if Executable = No_File then
2983                   if Main_Project = No_Project then
2984                      Executable :=
2985                        Executable_Name (Strip_Suffix (Main_Source_File));
2986
2987                   else
2988                      --  If we are using a project file, we attempt to
2989                      --  remove the body (or spec) termination of the main
2990                      --  subprogram. We find it the the naming scheme of the
2991                      --  project file. This will avoid to generate an
2992                      --  executable "main.2" for a main subprogram
2993                      --  "main.2.ada", when the body termination is ".2.ada".
2994
2995                      declare
2996                         Body_Append : constant String :=
2997                                         Get_Name_String
2998                                           (Projects.Table
2999                                            (Main_Project).
3000                                             Naming.Current_Impl_Suffix);
3001                         Spec_Append : constant String :=
3002                                         Get_Name_String
3003                                           (Projects.Table
3004                                             (Main_Project).
3005                                               Naming.Current_Spec_Suffix);
3006
3007                      begin
3008                         Get_Name_String (Main_Source_File);
3009
3010                         if Name_Len > Body_Append'Length
3011                           and then Name_Buffer
3012                              (Name_Len - Body_Append'Length + 1 .. Name_Len) =
3013                                            Body_Append
3014                         then
3015                            --  We have found the body termination. We remove it
3016                            --  add the executable termination (if any) and set
3017                            --  Non_Std_Executable.
3018
3019                            Name_Len := Name_Len - Body_Append'Length;
3020                            Executable := Executable_Name (Name_Find);
3021                            Non_Std_Executable := True;
3022
3023                         elsif Name_Len > Spec_Append'Length
3024                           and then
3025                             Name_Buffer
3026                               (Name_Len - Spec_Append'Length + 1 .. Name_Len) =
3027                                                                    Spec_Append
3028                         then
3029                            --  We have found the spec termination. We remove
3030                            --  it, add the executable termination (if any),
3031                            --  and set Non_Std_Executable.
3032
3033                            Name_Len := Name_Len - Spec_Append'Length;
3034                            Executable := Executable_Name (Name_Find);
3035                            Non_Std_Executable := True;
3036
3037                         else
3038                            Executable :=
3039                              Executable_Name (Strip_Suffix (Main_Source_File));
3040                         end if;
3041                      end;
3042                   end if;
3043                end if;
3044
3045                --  Now we invoke Compile_Sources for the current main
3046
3047                Compile_Sources
3048                  (Main_Source           => Main_Source_File,
3049                   Args                  => Args,
3050                   First_Compiled_File   => First_Compiled_File,
3051                   Most_Recent_Obj_File  => Youngest_Obj_File,
3052                   Most_Recent_Obj_Stamp => Youngest_Obj_Stamp,
3053                   Main_Unit             => Is_Main_Unit,
3054                   Compilation_Failures  => Compilation_Failures,
3055                   Check_Readonly_Files  => Opt.Check_Readonly_Files,
3056                   Do_Not_Execute        => Opt.Do_Not_Execute,
3057                   Force_Compilations    => Opt.Force_Compilations,
3058                   In_Place_Mode         => Opt.In_Place_Mode,
3059                   Keep_Going            => Opt.Keep_Going,
3060                   Initialize_ALI_Data   => True,
3061                   Max_Process           => Saved_Maximum_Processes);
3062
3063                if Opt.Verbose_Mode then
3064                   Write_Str ("End of compilation");
3065                   Write_Eol;
3066                end if;
3067
3068                if Compilation_Failures /= 0 then
3069                   List_Bad_Compilations;
3070                   raise Compilation_Failed;
3071                end if;
3072
3073                --  Regenerate libraries, if any and if object files
3074                --  have been regenerated
3075
3076                if Main_Project /= No_Project
3077                  and then MLib.Tgt.Libraries_Are_Supported
3078                then
3079
3080                   for Proj in Projects.First .. Projects.Last loop
3081
3082                      if Proj /= Main_Project
3083                        and then Projects.Table (Proj).Flag1
3084                      then
3085                         MLib.Prj.Build_Library (For_Project => Proj);
3086                      end if;
3087
3088                   end loop;
3089
3090                end if;
3091
3092                if Opt.List_Dependencies then
3093                   if First_Compiled_File /= No_File then
3094                      Inform
3095                        (First_Compiled_File,
3096                         "must be recompiled. Can't generate dependence list.");
3097                   else
3098                      List_Depend;
3099                   end if;
3100
3101                elsif First_Compiled_File = No_File
3102                  and then not Do_Bind_Step
3103                  and then not Opt.Quiet_Output
3104                  and then Osint.Number_Of_Files = 1
3105                then
3106                   if Unique_Compile then
3107                      Inform (Msg => "object up to date.");
3108                   else
3109                      Inform (Msg => "objects up to date.");
3110                   end if;
3111
3112                elsif Opt.Do_Not_Execute
3113                  and then First_Compiled_File /= No_File
3114                then
3115                   Write_Name (First_Compiled_File);
3116                   Write_Eol;
3117                end if;
3118
3119                --  Stop after compile step if any of:
3120
3121                --    1) -n (Do_Not_Execute) specified
3122
3123                --    2) -l (List_Dependencies) specified (also sets
3124                --       Do_Not_Execute above, so this is probably superfluous).
3125
3126                --    3) -c (Compile_Only) specified, but not -b (Bind_Only)
3127
3128                --    4) Made unit cannot be a main unit
3129
3130                if (Opt.Do_Not_Execute
3131                    or Opt.List_Dependencies
3132                    or not Do_Bind_Step
3133                    or not Is_Main_Unit)
3134                  and then not No_Main_Subprogram
3135                then
3136                   if Osint.Number_Of_Files = 1 then
3137                      return;
3138
3139                   else
3140                      goto Next_Main;
3141                   end if;
3142                end if;
3143
3144                --  If the objects were up-to-date check if the executable file
3145                --  is also up-to-date. For now always bind and link on the JVM
3146                --  since there is currently no simple way to check the
3147                --  up-to-date status of objects
3148
3149                if not Hostparm.Java_VM
3150                  and then First_Compiled_File = No_File
3151                then
3152                   Executable_Stamp    := File_Stamp (Executable);
3153
3154                   --  Once Executable_Obsolete is set to True, it is never
3155                   --  reset to False, because it is too hard to accurately
3156                   --  decide if a subsequent main need to be rebuilt or not.
3157
3158                   Executable_Obsolete :=
3159                     Executable_Obsolete
3160                       or else Youngest_Obj_Stamp > Executable_Stamp;
3161
3162                   if not Executable_Obsolete then
3163
3164                      --  If no Ada object files obsolete the executable, check
3165                      --  for younger or missing linker files.
3166
3167                      Check_Linker_Options
3168                        (Executable_Stamp,
3169                         Youngest_Obj_File,
3170                         Youngest_Obj_Stamp);
3171
3172                      Executable_Obsolete := Youngest_Obj_File /= No_File;
3173                   end if;
3174
3175                   --  Return if the executable is up to date
3176                   --  and otherwise motivate the relink/rebind.
3177
3178                   if not Executable_Obsolete then
3179                      if not Opt.Quiet_Output then
3180                         Inform (Executable, "up to date.");
3181                      end if;
3182
3183                      if Osint.Number_Of_Files = 1 then
3184                         return;
3185
3186                      else
3187                         goto Next_Main;
3188                      end if;
3189                   end if;
3190
3191                   if Executable_Stamp (1) = ' ' then
3192                      Verbose_Msg (Executable, "missing.", Prefix => "  ");
3193
3194                   elsif Youngest_Obj_Stamp (1) = ' ' then
3195                      Verbose_Msg
3196                        (Youngest_Obj_File,
3197                         "missing.",
3198                         Prefix => "  ");
3199
3200                   elsif Youngest_Obj_Stamp > Executable_Stamp then
3201                      Verbose_Msg
3202                        (Youngest_Obj_File,
3203                         "(" & String (Youngest_Obj_Stamp) & ") newer than",
3204                         Executable,
3205                         "(" & String (Executable_Stamp) & ")");
3206
3207                   else
3208                      Verbose_Msg
3209                        (Executable, "needs to be rebuild.",
3210                         Prefix => "  ");
3211
3212                   end if;
3213                end if;
3214             end Recursive_Compilation_Step;
3215
3216          end if;
3217
3218          --  If we are here, it means that we need to rebuilt the current
3219          --  main. So we set Executable_Obsolete to True to make sure that
3220          --  the subsequent mains will be rebuilt.
3221
3222          Executable_Obsolete := True;
3223
3224          Main_ALI_In_Place_Mode_Step :
3225          declare
3226             ALI_File : File_Name_Type;
3227             Src_File : File_Name_Type;
3228
3229          begin
3230             Src_File      := Strip_Directory (Main_Source_File);
3231             ALI_File      := Lib_File_Name (Src_File);
3232             Main_ALI_File := Full_Lib_File_Name (ALI_File);
3233
3234             --  When In_Place_Mode, the library file can be located in the
3235             --  Main_Source_File directory which may not be present in the
3236             --  library path. In this case, use the corresponding library file
3237             --  name.
3238
3239             if Main_ALI_File = No_File and then Opt.In_Place_Mode then
3240                Get_Name_String (Get_Directory (Full_Source_Name (Src_File)));
3241                Get_Name_String_And_Append (ALI_File);
3242                Main_ALI_File := Name_Find;
3243                Main_ALI_File := Full_Lib_File_Name (Main_ALI_File);
3244             end if;
3245
3246             pragma Assert (Main_ALI_File /= No_File);
3247          end Main_ALI_In_Place_Mode_Step;
3248
3249          if Do_Bind_Step then
3250             Bind_Step : declare
3251                Args : Argument_List
3252                         (Binder_Switches.First .. Binder_Switches.Last);
3253
3254             begin
3255                --  Get all the binder switches
3256
3257                for J in Binder_Switches.First .. Binder_Switches.Last loop
3258                   Args (J) := Binder_Switches.Table (J);
3259                end loop;
3260
3261                if Main_Project /= No_Project then
3262
3263                   --  Put all the source directories in ADA_INCLUDE_PATH,
3264                   --  and all the object directories in ADA_OBJECTS_PATH
3265
3266                   Set_Ada_Paths (Main_Project, False);
3267                end if;
3268
3269                Bind (Main_ALI_File, Args);
3270             end Bind_Step;
3271
3272          end if;
3273
3274          if Do_Link_Step then
3275
3276             Link_Step : declare
3277                There_Are_Libraries  : Boolean := False;
3278                Linker_Switches_Last : constant Integer := Linker_Switches.Last;
3279
3280             begin
3281
3282                if Main_Project /= No_Project then
3283
3284                   if MLib.Tgt.Libraries_Are_Supported then
3285                      Set_Libraries (Main_Project, There_Are_Libraries);
3286                   end if;
3287
3288                   if There_Are_Libraries then
3289
3290                      --  Add -L<lib_dir> -lgnarl -lgnat -Wl,-rpath,<lib_dir>
3291
3292                      Linker_Switches.Increment_Last;
3293                      Linker_Switches.Table (Linker_Switches.Last) :=
3294                        new String'("-L" & MLib.Utl.Lib_Directory);
3295                      Linker_Switches.Increment_Last;
3296                      Linker_Switches.Table (Linker_Switches.Last) :=
3297                        new String'("-lgnarl");
3298                      Linker_Switches.Increment_Last;
3299                      Linker_Switches.Table (Linker_Switches.Last) :=
3300                        new String'("-lgnat");
3301
3302                      declare
3303                         Option : constant String_Access :=
3304                                    MLib.Tgt.Linker_Library_Path_Option
3305                                      (MLib.Utl.Lib_Directory);
3306
3307                      begin
3308                         if Option /= null then
3309                            Linker_Switches.Increment_Last;
3310                            Linker_Switches.Table (Linker_Switches.Last) :=
3311                              Option;
3312                         end if;
3313
3314                      end;
3315
3316                   end if;
3317
3318                   --  Put the object directories in ADA_OBJECTS_PATH
3319
3320                   Set_Ada_Paths (Main_Project, False);
3321                end if;
3322
3323                declare
3324                   Args : Argument_List
3325                          (Linker_Switches.First .. Linker_Switches.Last + 2);
3326
3327                begin
3328                   --  Get all the linker switches
3329
3330                   for J in Linker_Switches.First .. Linker_Switches.Last loop
3331                      Args (J) := Linker_Switches.Table (J);
3332                   end loop;
3333
3334                   --  And invoke the linker
3335
3336                   if Non_Std_Executable then
3337                      Args (Linker_Switches.Last + 1) := new String'("-o");
3338                      Args (Linker_Switches.Last + 2) :=
3339                        new String'(Get_Name_String (Executable));
3340                      Link (Main_ALI_File, Args);
3341
3342                   else
3343                      Link
3344                        (Main_ALI_File,
3345                         Args (Linker_Switches.First .. Linker_Switches.Last));
3346                   end if;
3347
3348                end;
3349
3350                Linker_Switches.Set_Last (Linker_Switches_Last);
3351             end Link_Step;
3352
3353          end if;
3354
3355          --  We go to here when we skip the bind and link steps.
3356
3357          <<Next_Main>>
3358
3359          --  We go to the next main, if we did not process the last one
3360
3361          if N_File < Osint.Number_Of_Files then
3362             Main_Source_File := Next_Main_Source;
3363
3364             if Main_Project /= No_Project then
3365
3366                --  Find the file name of the main unit
3367
3368                declare
3369                   Main_Source_File_Name : constant String :=
3370                                             Get_Name_String (Main_Source_File);
3371
3372                   Main_Unit_File_Name : constant String :=
3373                                           Prj.Env.
3374                                             File_Name_Of_Library_Unit_Body
3375                                               (Name => Main_Source_File_Name,
3376                                                Project => Main_Project);
3377
3378                begin
3379                   --  We fail if we cannot find the main source file
3380                   --  as an immediate source of the main project file.
3381
3382                   if Main_Unit_File_Name = "" then
3383                      Fail ('"' & Main_Source_File_Name  &
3384                            """ is not a unit of project " &
3385                            Project_File_Name.all & ".");
3386
3387                   else
3388                      --  Remove any directory information from the main
3389                      --  source file name.
3390
3391                      declare
3392                         Pos : Natural := Main_Unit_File_Name'Last;
3393
3394                      begin
3395                         loop
3396                            exit when Pos < Main_Unit_File_Name'First
3397                              or else
3398                              Main_Unit_File_Name (Pos) = Directory_Separator;
3399                            Pos := Pos - 1;
3400                         end loop;
3401
3402                         Name_Len := Main_Unit_File_Name'Last - Pos;
3403
3404                         Name_Buffer (1 .. Name_Len) :=
3405                           Main_Unit_File_Name
3406                           (Pos + 1 .. Main_Unit_File_Name'Last);
3407
3408                         Main_Source_File := Name_Find;
3409                      end;
3410                   end if;
3411                end;
3412             end if;
3413          end if;
3414       end loop Multiple_Main_Loop;
3415
3416       Exit_Program (E_Success);
3417
3418    exception
3419       when Bind_Failed =>
3420          Osint.Fail ("*** bind failed.");
3421
3422       when Compilation_Failed =>
3423          Exit_Program (E_Fatal);
3424
3425       when Link_Failed =>
3426          Osint.Fail ("*** link failed.");
3427
3428       when X : others =>
3429          Write_Line (Exception_Information (X));
3430          Osint.Fail ("INTERNAL ERROR. Please report.");
3431
3432    end Gnatmake;
3433
3434    --------------------
3435    -- In_Ada_Lib_Dir --
3436    --------------------
3437
3438    function In_Ada_Lib_Dir (File : File_Name_Type) return Boolean is
3439       D : constant Name_Id := Get_Directory (File);
3440       B : constant Byte    := Get_Name_Table_Byte (D);
3441
3442    begin
3443       return (B and Ada_Lib_Dir) /= 0;
3444    end In_Ada_Lib_Dir;
3445
3446    ------------
3447    -- Inform --
3448    ------------
3449
3450    procedure Inform (N : Name_Id := No_Name; Msg : String) is
3451    begin
3452       Osint.Write_Program_Name;
3453
3454       Write_Str (": ");
3455
3456       if N /= No_Name then
3457          Write_Str ("""");
3458          Write_Name (N);
3459          Write_Str (""" ");
3460       end if;
3461
3462       Write_Str (Msg);
3463       Write_Eol;
3464    end Inform;
3465
3466    ------------
3467    -- Init_Q --
3468    ------------
3469
3470    procedure Init_Q is
3471    begin
3472       First_Q_Initialization := False;
3473       Q_Front := Q.First;
3474       Q.Set_Last (Q.First);
3475    end Init_Q;
3476
3477    ----------------
3478    -- Initialize --
3479    ----------------
3480
3481    procedure Initialize is
3482       Next_Arg : Positive;
3483
3484    begin
3485       --  Override default initialization of Check_Object_Consistency
3486       --  since this is normally False for GNATBIND, but is True for
3487       --  GNATMAKE since we do not need to check source consistency
3488       --  again once GNATMAKE has looked at the sources to check.
3489
3490       Opt.Check_Object_Consistency := True;
3491
3492       --  Package initializations. The order of calls is important here.
3493
3494       Output.Set_Standard_Error;
3495       Osint.Initialize (Osint.Make);
3496
3497       Gcc_Switches.Init;
3498       Binder_Switches.Init;
3499       Linker_Switches.Init;
3500
3501       Csets.Initialize;
3502       Namet.Initialize;
3503
3504       Snames.Initialize;
3505
3506       Prj.Initialize;
3507
3508       Next_Arg := 1;
3509       Scan_Args : while Next_Arg <= Argument_Count loop
3510          Scan_Make_Arg (Argument (Next_Arg), And_Save => True);
3511          Next_Arg := Next_Arg + 1;
3512       end loop Scan_Args;
3513
3514       if Usage_Requested then
3515          Makeusg;
3516       end if;
3517
3518       --  Test for trailing -o switch
3519
3520       if Opt.Output_File_Name_Present
3521         and then not Output_File_Name_Seen
3522       then
3523          Fail ("output file name missing after -o");
3524       end if;
3525
3526       if Project_File_Name /= null then
3527
3528          --  A project file was specified by a -P switch
3529
3530          if Opt.Verbose_Mode then
3531             Write_Eol;
3532             Write_Str ("Parsing Project File """);
3533             Write_Str (Project_File_Name.all);
3534             Write_Str (""".");
3535             Write_Eol;
3536          end if;
3537
3538          --  Avoid looking in the current directory for ALI files
3539
3540          --  Opt.Look_In_Primary_Dir := False;
3541
3542          --  Set the project parsing verbosity to whatever was specified
3543          --  by a possible -vP switch.
3544
3545          Prj.Pars.Set_Verbosity (To => Current_Verbosity);
3546
3547          --  Parse the project file.
3548          --  If there is an error, Main_Project will still be No_Project.
3549
3550          Prj.Pars.Parse
3551            (Project           => Main_Project,
3552             Project_File_Name => Project_File_Name.all);
3553
3554          if Main_Project = No_Project then
3555             Fail ("""" & Project_File_Name.all &
3556                   """ processing failed");
3557          end if;
3558
3559          if Opt.Verbose_Mode then
3560             Write_Eol;
3561             Write_Str ("Parsing of Project File """);
3562             Write_Str (Project_File_Name.all);
3563             Write_Str (""" is finished.");
3564             Write_Eol;
3565          end if;
3566
3567          --  We add the source directories and the object directories
3568          --  to the search paths.
3569
3570          Add_Source_Directories (Main_Project);
3571          Add_Object_Directories (Main_Project);
3572
3573       end if;
3574
3575       Osint.Add_Default_Search_Dirs;
3576
3577       --  Mark the GNAT libraries if needed.
3578
3579       --  Source file lookups should be cached for efficiency.
3580       --  Source files are not supposed to change.
3581
3582       Osint.Source_File_Data (Cache => True);
3583
3584       --  Read gnat.adc file to initialize Fname.UF
3585
3586       Fname.UF.Initialize;
3587
3588       begin
3589          Fname.SF.Read_Source_File_Name_Pragmas;
3590
3591       exception
3592          when Err : SFN_Scan.Syntax_Error_In_GNAT_ADC =>
3593             Osint.Fail (Exception_Message (Err));
3594       end;
3595
3596    end Initialize;
3597
3598    -----------------------------------
3599    -- Insert_Project_Sources_Into_Q --
3600    -----------------------------------
3601
3602    procedure Insert_Project_Sources
3603      (The_Project : Project_Id;
3604       Into_Q      : Boolean)
3605    is
3606       Unit  : Com.Unit_Data;
3607       Sfile : Name_Id;
3608
3609    begin
3610       --  For all the sources in the project files,
3611
3612       for Id in Com.Units.First .. Com.Units.Last loop
3613          Unit  := Com.Units.Table (Id);
3614          Sfile := No_Name;
3615
3616          --  If there is a source for the body,
3617
3618          if Unit.File_Names (Com.Body_Part).Name /= No_Name then
3619
3620             --  And it is a source of the specified project
3621
3622             if Unit.File_Names (Com.Body_Part).Project = The_Project then
3623
3624                --  If we don't have a spec, we cannot consider the source
3625                --  if it is a subunit
3626
3627                if Unit.File_Names (Com.Specification).Name = No_Name then
3628                   declare
3629                      Src_Ind : Source_File_Index;
3630
3631                   begin
3632                      Src_Ind := Sinput.L.Load_Source_File
3633                                   (Unit.File_Names (Com.Body_Part).Name);
3634
3635                      --  If it is a subunit, discard it
3636
3637                      if Sinput.L.Source_File_Is_Subunit (Src_Ind) then
3638                         Sfile := No_Name;
3639
3640                      else
3641                         Sfile := Unit.File_Names (Com.Body_Part).Name;
3642                      end if;
3643                   end;
3644
3645                else
3646                   Sfile := Unit.File_Names (Com.Body_Part).Name;
3647                end if;
3648             end if;
3649
3650          elsif Unit.File_Names (Com.Specification).Name /= No_Name
3651            and then Unit.File_Names (Com.Specification).Project = The_Project
3652          then
3653             --  If there is no source for the body, but there is a source
3654             --  for the spec, then we take this one.
3655
3656             Sfile := Unit.File_Names (Com.Specification).Name;
3657          end if;
3658
3659          --  If Into_Q is True, we insert into the Q
3660
3661          if Into_Q then
3662
3663             --  For the first source inserted into the Q, we need
3664             --  to initialize the Q, but not for the subsequent sources.
3665
3666             if First_Q_Initialization then
3667                Init_Q;
3668             end if;
3669
3670             --  And of course, we only insert in the Q if the source
3671             --  is not marked.
3672
3673             if Sfile /= No_Name and then not Is_Marked (Sfile) then
3674                Insert_Q (Sfile);
3675                Mark (Sfile);
3676             end if;
3677
3678          elsif Sfile /= No_Name then
3679
3680             --  If Into_Q is False, we add the source as it it were
3681             --  specified on the command line.
3682
3683             Osint.Add_File (Get_Name_String (Sfile));
3684          end if;
3685       end loop;
3686    end Insert_Project_Sources;
3687
3688    --------------
3689    -- Insert_Q --
3690    --------------
3691
3692    procedure Insert_Q
3693      (Source_File : File_Name_Type;
3694       Source_Unit : Unit_Name_Type := No_Name)
3695    is
3696    begin
3697       if Debug.Debug_Flag_Q then
3698          Write_Str ("   Q := Q + [ ");
3699          Write_Name (Source_File);
3700          Write_Str (" ] ");
3701          Write_Eol;
3702       end if;
3703
3704       Q.Table (Q.Last).File := Source_File;
3705       Q.Table (Q.Last).Unit := Source_Unit;
3706       Q.Increment_Last;
3707    end Insert_Q;
3708
3709    ----------------------------
3710    -- Is_External_Assignment --
3711    ----------------------------
3712
3713    function Is_External_Assignment (Argv : String) return Boolean is
3714       Start     : Positive := 3;
3715       Finish    : Natural := Argv'Last;
3716       Equal_Pos : Natural;
3717
3718    begin
3719       if Argv'Last < 5 then
3720          return False;
3721
3722       elsif Argv (3) = '"' then
3723          if Argv (Argv'Last) /= '"' or else Argv'Last < 7 then
3724             return False;
3725          else
3726             Start := 4;
3727             Finish := Argv'Last - 1;
3728          end if;
3729       end if;
3730
3731       Equal_Pos := Start;
3732
3733       while Equal_Pos <= Finish and then Argv (Equal_Pos) /= '=' loop
3734          Equal_Pos := Equal_Pos + 1;
3735       end loop;
3736
3737       if Equal_Pos = Start
3738         or else Equal_Pos >= Finish
3739       then
3740          return False;
3741
3742       else
3743          Prj.Ext.Add
3744            (External_Name => Argv (Start .. Equal_Pos - 1),
3745             Value         => Argv (Equal_Pos + 1 .. Finish));
3746          return True;
3747       end if;
3748    end Is_External_Assignment;
3749
3750    ---------------
3751    -- Is_Marked --
3752    ---------------
3753
3754    function Is_Marked (Source_File : File_Name_Type) return Boolean is
3755    begin
3756       return Get_Name_Table_Byte (Source_File) /= 0;
3757    end Is_Marked;
3758
3759    ----------
3760    -- Link --
3761    ----------
3762
3763    procedure Link (ALI_File : File_Name_Type; Args : Argument_List) is
3764       Link_Args : Argument_List (Args'First .. Args'Last + 1);
3765       Success   : Boolean;
3766
3767    begin
3768       Link_Args (Args'Range) :=  Args;
3769
3770       Get_Name_String (ALI_File);
3771       Link_Args (Args'Last + 1) := new String'(Name_Buffer (1 .. Name_Len));
3772
3773       Display (Gnatlink.all, Link_Args);
3774
3775       if Gnatlink_Path = null then
3776          Osint.Fail ("error, unable to locate " & Gnatlink.all);
3777       end if;
3778
3779       GNAT.OS_Lib.Spawn (Gnatlink_Path.all, Link_Args, Success);
3780
3781       if not Success then
3782          raise Link_Failed;
3783       end if;
3784    end Link;
3785
3786    ---------------------------
3787    -- List_Bad_Compilations --
3788    ---------------------------
3789
3790    procedure List_Bad_Compilations is
3791    begin
3792       for J in Bad_Compilation.First .. Bad_Compilation.Last loop
3793          if Bad_Compilation.Table (J).File = No_File then
3794             null;
3795          elsif not Bad_Compilation.Table (J).Found then
3796             Inform (Bad_Compilation.Table (J).File, "not found");
3797          else
3798             Inform (Bad_Compilation.Table (J).File, "compilation error");
3799          end if;
3800       end loop;
3801    end List_Bad_Compilations;
3802
3803    -----------------
3804    -- List_Depend --
3805    -----------------
3806
3807    procedure List_Depend is
3808       Lib_Name  : Name_Id;
3809       Obj_Name  : Name_Id;
3810       Src_Name  : Name_Id;
3811
3812       Len       : Natural;
3813       Line_Pos  : Natural;
3814       Line_Size : constant := 77;
3815
3816    begin
3817       Set_Standard_Output;
3818
3819       for A in ALIs.First .. ALIs.Last loop
3820          Lib_Name := ALIs.Table (A).Afile;
3821
3822          --  We have to provide the full library file name in In_Place_Mode
3823
3824          if Opt.In_Place_Mode then
3825             Lib_Name := Full_Lib_File_Name (Lib_Name);
3826          end if;
3827
3828          Obj_Name := Object_File_Name (Lib_Name);
3829          Write_Name (Obj_Name);
3830          Write_Str (" :");
3831
3832          Get_Name_String (Obj_Name);
3833          Len := Name_Len;
3834          Line_Pos := Len + 2;
3835
3836          for D in ALIs.Table (A).First_Sdep .. ALIs.Table (A).Last_Sdep loop
3837             Src_Name := Sdep.Table (D).Sfile;
3838
3839             if Is_Internal_File_Name (Src_Name)
3840               and then not Check_Readonly_Files
3841             then
3842                null;
3843             else
3844                if not Opt.Quiet_Output then
3845                   Src_Name := Full_Source_Name (Src_Name);
3846                end if;
3847
3848                Get_Name_String (Src_Name);
3849                Len := Name_Len;
3850
3851                if Line_Pos + Len + 1 > Line_Size then
3852                   Write_Str (" \");
3853                   Write_Eol;
3854                   Line_Pos := 0;
3855                end if;
3856
3857                Line_Pos := Line_Pos + Len + 1;
3858
3859                Write_Str (" ");
3860                Write_Name (Src_Name);
3861             end if;
3862          end loop;
3863
3864          Write_Eol;
3865       end loop;
3866
3867       Set_Standard_Error;
3868    end List_Depend;
3869
3870    ----------
3871    -- Mark --
3872    ----------
3873
3874    procedure Mark (Source_File : File_Name_Type) is
3875    begin
3876       Set_Name_Table_Byte (Source_File, 1);
3877    end Mark;
3878
3879    -------------------
3880    -- Mark_Dir_Path --
3881    -------------------
3882
3883    procedure Mark_Dir_Path
3884      (Path : String_Access;
3885       Mark : Lib_Mark_Type)
3886    is
3887       Dir : String_Access;
3888
3889    begin
3890       if Path /= null then
3891          Osint.Get_Next_Dir_In_Path_Init (Path);
3892
3893          loop
3894             Dir := Osint.Get_Next_Dir_In_Path (Path);
3895             exit when Dir = null;
3896             Mark_Directory (Dir.all, Mark);
3897          end loop;
3898       end if;
3899    end Mark_Dir_Path;
3900
3901    --------------------
3902    -- Mark_Directory --
3903    --------------------
3904
3905    procedure Mark_Directory
3906      (Dir  : String;
3907       Mark : Lib_Mark_Type)
3908    is
3909       N : Name_Id;
3910       B : Byte;
3911
3912    begin
3913       --  Dir last character is supposed to be a directory separator.
3914
3915       Name_Len := Dir'Length;
3916       Name_Buffer (1 .. Name_Len) := Dir;
3917
3918       if not Is_Directory_Separator (Name_Buffer (Name_Len)) then
3919          Name_Len := Name_Len + 1;
3920          Name_Buffer (Name_Len) := Directory_Separator;
3921       end if;
3922
3923       --  Add flags to the already existing flags
3924
3925       N := Name_Find;
3926       B := Get_Name_Table_Byte (N);
3927       Set_Name_Table_Byte (N, B or Mark);
3928    end Mark_Directory;
3929
3930    ----------------------
3931    -- Object_File_Name --
3932    ----------------------
3933
3934    function Object_File_Name (Source : String) return String is
3935       Pos : Natural := Source'Last;
3936
3937    begin
3938       while Pos >= Source'First and then
3939         Source (Pos) /= '.' loop
3940          Pos := Pos - 1;
3941       end loop;
3942
3943       if Pos >= Source'First then
3944          Pos := Pos - 1;
3945       end if;
3946
3947       return Source (Source'First .. Pos) & Object_Suffix;
3948    end Object_File_Name;
3949
3950    -------------------
3951    -- Scan_Make_Arg --
3952    -------------------
3953
3954    procedure Scan_Make_Arg (Argv : String; And_Save : Boolean) is
3955    begin
3956       pragma Assert (Argv'First = 1);
3957
3958       if Argv'Length = 0 then
3959          return;
3960       end if;
3961
3962       --  If the previous switch has set the Output_File_Name_Present
3963       --  flag (that is we have seen a -o), then the next argument is
3964       --  the name of the output executable.
3965
3966       if Opt.Output_File_Name_Present and then not Output_File_Name_Seen then
3967          Output_File_Name_Seen := True;
3968
3969          if Argv (1) = Switch_Character or else Argv (1) = '-' then
3970             Fail ("output file name missing after -o");
3971          else
3972             Add_Switch ("-o", Linker, And_Save => And_Save);
3973
3974             --  Automatically add the executable suffix if it has not been
3975             --  specified explicitly.
3976
3977             if Executable_Suffix'Length /= 0
3978               and then Argv (Argv'Last - Executable_Suffix'Length + 1
3979                              .. Argv'Last) /= Executable_Suffix
3980             then
3981                Add_Switch
3982                  (Argv & Executable_Suffix,
3983                   Linker,
3984                   And_Save => And_Save);
3985             else
3986                Add_Switch (Argv, Linker, And_Save => And_Save);
3987             end if;
3988          end if;
3989
3990       --  Then check if we are dealing with a -cargs, -bargs or -largs
3991
3992       elsif (Argv (1) = Switch_Character or else Argv (1) = '-')
3993         and then (Argv (2 .. Argv'Last) = "cargs"
3994                    or else Argv (2 .. Argv'Last) = "bargs"
3995                    or else Argv (2 .. Argv'Last) = "largs")
3996       then
3997          if not File_Name_Seen then
3998             Fail ("-cargs, -bargs, -largs ",
3999                   "must appear after unit or file name");
4000          end if;
4001
4002          case Argv (2) is
4003             when 'c' => Program_Args := Compiler;
4004             when 'b' => Program_Args := Binder;
4005             when 'l' => Program_Args := Linker;
4006
4007             when others =>
4008                raise Program_Error;
4009          end case;
4010
4011       --  A special test is needed for the -o switch within a -largs
4012       --  since that is another way to specify the name of the final
4013       --  executable.
4014
4015       elsif Program_Args = Linker
4016         and then (Argv (1) = Switch_Character or else Argv (1) = '-')
4017         and then Argv (2 .. Argv'Last) = "o"
4018       then
4019          Fail ("switch -o not allowed within a -largs. Use -o directly.");
4020
4021       --  Check to see if we are reading switches after a -cargs,
4022       --  -bargs or -largs switch. If yes save it.
4023
4024       elsif Program_Args /= None then
4025
4026          --  Check to see if we are reading -I switches in order
4027          --  to take into account in the src & lib search directories.
4028
4029          if Argv'Length > 2 and then Argv (1 .. 2) = "-I" then
4030             if Argv (3 .. Argv'Last) = "-" then
4031                Opt.Look_In_Primary_Dir := False;
4032
4033             elsif Program_Args = Compiler then
4034                if Argv (3 .. Argv'Last) /= "-" then
4035                   Add_Src_Search_Dir (Argv (3 .. Argv'Last));
4036
4037                end if;
4038
4039             elsif Program_Args = Binder then
4040                Add_Lib_Search_Dir (Argv (3 .. Argv'Last));
4041
4042             end if;
4043          end if;
4044
4045          Add_Switch (Argv, Program_Args, And_Save => And_Save);
4046
4047       --  Handle non-default compiler, binder, linker
4048
4049       elsif Argv'Length > 2 and then Argv (1 .. 2) = "--" then
4050          if Argv'Length > 6
4051            and then Argv (1 .. 6) = "--GCC="
4052          then
4053             declare
4054                Program_Args : Argument_List_Access :=
4055                                 Argument_String_To_List
4056                                   (Argv (7 .. Argv'Last));
4057
4058             begin
4059                if And_Save then
4060                   Saved_Gcc := new String'(Program_Args.all (1).all);
4061                else
4062                   Gcc := new String'(Program_Args.all (1).all);
4063                end if;
4064
4065                for J in 2 .. Program_Args.all'Last loop
4066                   Add_Switch
4067                     (Program_Args.all (J).all,
4068                      Compiler,
4069                      And_Save => And_Save);
4070                end loop;
4071             end;
4072
4073          elsif Argv'Length > 11
4074            and then Argv (1 .. 11) = "--GNATBIND="
4075          then
4076             declare
4077                Program_Args : Argument_List_Access :=
4078                                 Argument_String_To_List
4079                                   (Argv (12 .. Argv'Last));
4080
4081             begin
4082                if And_Save then
4083                   Saved_Gnatbind := new String'(Program_Args.all (1).all);
4084                else
4085                   Gnatbind := new String'(Program_Args.all (1).all);
4086                end if;
4087
4088                for J in 2 .. Program_Args.all'Last loop
4089                   Add_Switch
4090                     (Program_Args.all (J).all, Binder, And_Save => And_Save);
4091                end loop;
4092             end;
4093
4094          elsif Argv'Length > 11
4095            and then Argv (1 .. 11) = "--GNATLINK="
4096          then
4097             declare
4098                Program_Args : Argument_List_Access :=
4099                                 Argument_String_To_List
4100                                   (Argv (12 .. Argv'Last));
4101             begin
4102                if And_Save then
4103                   Saved_Gnatlink := new String'(Program_Args.all (1).all);
4104                else
4105                   Gnatlink := new String'(Program_Args.all (1).all);
4106                end if;
4107
4108                for J in 2 .. Program_Args.all'Last loop
4109                   Add_Switch (Program_Args.all (J).all, Linker);
4110                end loop;
4111             end;
4112
4113          else
4114             Fail ("unknown switch: ", Argv);
4115          end if;
4116
4117       --  If we have seen a regular switch process it
4118
4119       elsif Argv (1) = Switch_Character or else Argv (1) = '-' then
4120
4121          if Argv'Length = 1 then
4122             Fail ("switch character cannot be followed by a blank");
4123
4124          --  -I-
4125
4126          elsif Argv (2 .. Argv'Last) = "I-" then
4127             Opt.Look_In_Primary_Dir := False;
4128
4129          --  Forbid  -?-  or  -??-  where ? is any character
4130
4131          elsif (Argv'Length = 3 and then Argv (3) = '-')
4132            or else (Argv'Length = 4 and then Argv (4) = '-')
4133          then
4134             Fail ("trailing ""-"" at the end of ", Argv, " forbidden.");
4135
4136          --  -Idir
4137
4138          elsif Argv (2) = 'I' then
4139             Add_Src_Search_Dir (Argv (3 .. Argv'Last));
4140             Add_Lib_Search_Dir (Argv (3 .. Argv'Last));
4141             Add_Switch (Argv, Compiler, And_Save => And_Save);
4142             Add_Switch ("-aO" & Argv (3 .. Argv'Last),
4143                         Binder,
4144                         And_Save => And_Save);
4145
4146             --  No need to pass any source dir to the binder
4147             --  since gnatmake call it with the -x flag
4148             --  (ie do not check source time stamp)
4149
4150          --  -aIdir (to gcc this is like a -I switch)
4151
4152          elsif Argv'Length >= 3 and then Argv (2 .. 3) = "aI" then
4153             Add_Src_Search_Dir (Argv (4 .. Argv'Last));
4154             Add_Switch ("-I" & Argv (4 .. Argv'Last),
4155                         Compiler,
4156                         And_Save => And_Save);
4157
4158          --  -aOdir
4159
4160          elsif Argv'Length >= 3 and then Argv (2 .. 3) = "aO" then
4161             Add_Lib_Search_Dir (Argv (4 .. Argv'Last));
4162             Add_Switch (Argv, Binder, And_Save => And_Save);
4163
4164          --  -aLdir (to gnatbind this is like a -aO switch)
4165
4166          elsif Argv'Length >= 3 and then Argv (2 .. 3) = "aL" then
4167             Mark_Directory (Argv (4 .. Argv'Last), Ada_Lib_Dir);
4168             Add_Lib_Search_Dir (Argv (4 .. Argv'Last));
4169             Add_Switch ("-aO" & Argv (4 .. Argv'Last),
4170                         Binder,
4171                         And_Save => And_Save);
4172
4173          --  -Adir (to gnatbind this is like a -aO switch, to gcc like a -I)
4174
4175          elsif Argv (2) = 'A' then
4176             Mark_Directory (Argv (3 .. Argv'Last), Ada_Lib_Dir);
4177             Add_Src_Search_Dir (Argv (3 .. Argv'Last));
4178             Add_Lib_Search_Dir (Argv (3 .. Argv'Last));
4179             Add_Switch ("-I"  & Argv (3 .. Argv'Last),
4180                         Compiler,
4181                         And_Save => And_Save);
4182             Add_Switch ("-aO" & Argv (3 .. Argv'Last),
4183                         Binder,
4184                         And_Save => And_Save);
4185
4186          --  -Ldir
4187
4188          elsif Argv (2) = 'L' then
4189             Add_Switch (Argv, Linker, And_Save => And_Save);
4190
4191          --  For -gxxxxx,-pg : give the switch to both the compiler and the
4192          --  linker (except for -gnatxxx which is only for the compiler)
4193
4194          elsif
4195            (Argv (2) = 'g' and then (Argv'Last < 5
4196                                        or else Argv (2 .. 5) /= "gnat"))
4197              or else Argv (2 .. Argv'Last) = "pg"
4198          then
4199             Add_Switch (Argv, Compiler, And_Save => And_Save);
4200             Add_Switch (Argv, Linker, And_Save => And_Save);
4201
4202          --  -d
4203
4204          elsif Argv (2) = 'd'
4205            and then Argv'Last = 2
4206          then
4207             Opt.Display_Compilation_Progress := True;
4208
4209          --  -j (need to save the result)
4210
4211          elsif Argv (2) = 'j' then
4212             Scan_Make_Switches (Argv);
4213
4214             if And_Save then
4215                Saved_Maximum_Processes := Maximum_Processes;
4216             end if;
4217
4218          --  -m
4219
4220          elsif Argv (2) = 'm'
4221            and then Argv'Last = 2
4222          then
4223             Opt.Minimal_Recompilation := True;
4224
4225          --  -u
4226
4227          elsif Argv (2) = 'u'
4228            and then Argv'Last = 2
4229          then
4230             Unique_Compile   := True;
4231             Opt.Compile_Only := True;
4232             Do_Bind_Step     := False;
4233             Do_Link_Step     := False;
4234
4235          --  -Pprj (only once, and only on the command line)
4236
4237          elsif Argv'Last > 2
4238            and then Argv (2) = 'P'
4239          then
4240             if Project_File_Name /= null then
4241                Fail ("cannot have several project files specified");
4242
4243             elsif not And_Save then
4244
4245                --  It could be a tool other than gnatmake (i.e, gnatdist)
4246                --  or a -P switch inside a project file.
4247
4248                Fail
4249                  ("either the tool is not ""project-aware"" or " &
4250                   "a project file is specified inside a project file");
4251
4252             else
4253                Project_File_Name := new String' (Argv (3 .. Argv'Last));
4254             end if;
4255
4256          --  -S (Assemble)
4257
4258          --  Since no object file is created, don't check object
4259          --  consistency.
4260
4261          elsif Argv (2) = 'S'
4262            and then Argv'Last = 2
4263          then
4264             Opt.Check_Object_Consistency := False;
4265             Add_Switch (Argv, Compiler, And_Save => And_Save);
4266
4267          --  -vPx  (verbosity of the parsing of the project files)
4268
4269          elsif Argv'Last = 4
4270            and then Argv (2 .. 3) = "vP"
4271            and then Argv (4) in '0' .. '2'
4272          then
4273             if And_Save then
4274                case Argv (4) is
4275                   when '0' =>
4276                      Current_Verbosity := Prj.Default;
4277                   when '1' =>
4278                      Current_Verbosity := Prj.Medium;
4279                   when '2' =>
4280                      Current_Verbosity := Prj.High;
4281                   when others =>
4282                      null;
4283                end case;
4284             end if;
4285
4286          --  -Wx (need to save the result)
4287
4288          elsif Argv (2) = 'W' then
4289             Scan_Make_Switches (Argv);
4290
4291             if And_Save then
4292                Saved_WC_Encoding_Method := Wide_Character_Encoding_Method;
4293                Saved_WC_Encoding_Method_Set := True;
4294             end if;
4295
4296          --  -Xext=val  (External assignment)
4297
4298          elsif Argv (2) = 'X'
4299            and then Is_External_Assignment (Argv)
4300          then
4301             --  Is_External_Assignment has side effects
4302             --  when it returns True;
4303
4304             null;
4305
4306          --  If -gnath is present, then generate the usage information
4307          --  right now for the compiler, and do not pass this option
4308          --  on to the compiler calls.
4309
4310          elsif Argv = "-gnath" then
4311             null;
4312
4313          --  If -gnatc is specified, make sure the bind step and the link
4314          --  step are not executed.
4315
4316          elsif Argv'Length >= 6 and then Argv (2 .. 6) = "gnatc" then
4317
4318             --  If -gnatc is specified, make sure the bind step and the link
4319             --  step are not executed.
4320
4321             Add_Switch (Argv, Compiler, And_Save => And_Save);
4322             Opt.Operating_Mode := Opt.Check_Semantics;
4323             Opt.Check_Object_Consistency := False;
4324             Opt.Compile_Only             := True;
4325             Do_Bind_Step                 := False;
4326             Do_Link_Step                 := False;
4327
4328          elsif Argv (2 .. Argv'Last) = "nostdlib" then
4329
4330             --  Don't pass -nostdlib to gnatlink, it will disable
4331             --  linking with all standard library files.
4332
4333             Opt.No_Stdlib := True;
4334             Add_Switch (Argv, Binder, And_Save => And_Save);
4335
4336          elsif Argv (2 .. Argv'Last) = "nostdinc" then
4337
4338             --  Pass -nostdinv to the Compiler and to gnatbind
4339
4340             Opt.No_Stdinc := True;
4341             Add_Switch (Argv, Compiler, And_Save => And_Save);
4342             Add_Switch (Argv, Binder, And_Save => And_Save);
4343
4344             --  By default all switches with more than one character
4345             --  or one character switches which are not in 'a' .. 'z'
4346             --  (except 'M') are passed to the compiler, unless we are dealing
4347             --  with a debug switch (starts with 'd')
4348
4349          elsif Argv (2) /= 'd'
4350            and then Argv (2 .. Argv'Last) /= "M"
4351            and then (Argv'Length > 2 or else Argv (2) not in 'a' .. 'z')
4352          then
4353             Add_Switch (Argv, Compiler, And_Save => And_Save);
4354
4355          --  All other options are handled by Scan_Make_Switches
4356
4357          else
4358             Scan_Make_Switches (Argv);
4359          end if;
4360
4361       --  If not a switch it must be a file name
4362
4363       else
4364          File_Name_Seen := True;
4365          Set_Main_File_Name (Argv);
4366       end if;
4367    end Scan_Make_Arg;
4368
4369    -------------------
4370    -- Set_Ada_Paths --
4371    -------------------
4372
4373    procedure Set_Ada_Paths
4374      (For_Project         : Prj.Project_Id;
4375       Including_Libraries : Boolean)
4376    is
4377       New_Ada_Include_Path : constant String_Access :=
4378                                Prj.Env.Ada_Include_Path (For_Project);
4379
4380       New_Ada_Objects_Path : constant String_Access :=
4381                                Prj.Env.Ada_Objects_Path
4382                                  (For_Project, Including_Libraries);
4383
4384    begin
4385       --  If ADA_INCLUDE_PATH needs to be changed (we are not using the same
4386       --  project file), set the new ADA_INCLUDE_PATH
4387
4388       if New_Ada_Include_Path /= Current_Ada_Include_Path then
4389          Current_Ada_Include_Path := New_Ada_Include_Path;
4390
4391          if Original_Ada_Include_Path'Length = 0 then
4392             Setenv ("ADA_INCLUDE_PATH",
4393                     New_Ada_Include_Path.all);
4394
4395          else
4396             --  If there existed an ADA_INCLUDE_PATH at the invocation of
4397             --  gnatmake, concatenate new ADA_INCLUDE_PATH with the original.
4398
4399             Setenv ("ADA_INCLUDE_PATH",
4400                     Original_Ada_Include_Path.all &
4401                     Path_Separator &
4402                     New_Ada_Include_Path.all);
4403          end if;
4404
4405          if Opt.Verbose_Mode then
4406             declare
4407                Include_Path : constant String_Access :=
4408                  Getenv ("ADA_INCLUDE_PATH");
4409
4410             begin
4411                --  Display the new ADA_INCLUDE_PATH
4412
4413                Write_Str ("ADA_INCLUDE_PATH = """);
4414                Prj.Util.Write_Str
4415                  (S          => Include_Path.all,
4416                   Max_Length => Max_Line_Length,
4417                   Separator  => Path_Separator);
4418                Write_Str ("""");
4419                Write_Eol;
4420             end;
4421          end if;
4422       end if;
4423
4424       --  If ADA_OBJECTS_PATH needs to be changed (we are not using the same
4425       --  project file), set the new ADA_OBJECTS_PATH
4426
4427       if New_Ada_Objects_Path /= Current_Ada_Objects_Path then
4428          Current_Ada_Objects_Path := New_Ada_Objects_Path;
4429
4430          if Original_Ada_Objects_Path'Length = 0 then
4431             Setenv ("ADA_OBJECTS_PATH",
4432                     New_Ada_Objects_Path.all);
4433
4434          else
4435             --  If there existed an ADA_OBJECTS_PATH at the invocation of
4436             --  gnatmake, concatenate new ADA_OBJECTS_PATH with the original.
4437
4438             Setenv ("ADA_OBJECTS_PATH",
4439                     Original_Ada_Objects_Path.all &
4440                     Path_Separator &
4441                     New_Ada_Objects_Path.all);
4442          end if;
4443
4444          if Opt.Verbose_Mode then
4445             declare
4446                Objects_Path : constant String_Access :=
4447                  Getenv ("ADA_OBJECTS_PATH");
4448
4449             begin
4450                --  Display the new ADA_OBJECTS_PATH
4451
4452                Write_Str ("ADA_OBJECTS_PATH = """);
4453                Prj.Util.Write_Str
4454                  (S          => Objects_Path.all,
4455                   Max_Length => Max_Line_Length,
4456                   Separator  => Path_Separator);
4457                Write_Str ("""");
4458                Write_Eol;
4459             end;
4460          end if;
4461       end if;
4462
4463    end Set_Ada_Paths;
4464
4465    ---------------------
4466    -- Set_Library_For --
4467    ---------------------
4468
4469    procedure Set_Library_For
4470      (Project             : Project_Id;
4471       There_Are_Libraries : in out Boolean)
4472    is
4473    begin
4474       --  Case of library project
4475
4476       if Projects.Table (Project).Library then
4477          There_Are_Libraries := True;
4478
4479          --  Add the -L switch
4480
4481          Linker_Switches.Increment_Last;
4482          Linker_Switches.Table (Linker_Switches.Last) :=
4483            new String'("-L" &
4484                        Get_Name_String
4485                        (Projects.Table (Project).Library_Dir));
4486
4487          --  Add the -l switch
4488
4489          Linker_Switches.Increment_Last;
4490          Linker_Switches.Table (Linker_Switches.Last) :=
4491            new String'("-l" &
4492                        Get_Name_String
4493                        (Projects.Table (Project).Library_Name));
4494
4495          --  Add the Wl,-rpath switch if library non static
4496
4497          if Projects.Table (Project).Library_Kind /= Static then
4498             declare
4499                Option : constant String_Access :=
4500                           MLib.Tgt.Linker_Library_Path_Option
4501                             (Get_Name_String
4502                               (Projects.Table (Project).Library_Dir));
4503
4504             begin
4505                if Option /= null then
4506                   Linker_Switches.Increment_Last;
4507                   Linker_Switches.Table (Linker_Switches.Last) :=
4508                     Option;
4509                end if;
4510
4511             end;
4512
4513          end if;
4514
4515       end if;
4516    end Set_Library_For;
4517
4518    ------------
4519    -- Unmark --
4520    ------------
4521
4522    procedure Unmark (Source_File : File_Name_Type) is
4523    begin
4524       Set_Name_Table_Byte (Source_File, 0);
4525    end Unmark;
4526
4527    -----------------
4528    -- Verbose_Msg --
4529    -----------------
4530
4531    procedure Verbose_Msg
4532      (N1     : Name_Id;
4533       S1     : String;
4534       N2     : Name_Id := No_Name;
4535       S2     : String  := "";
4536       Prefix : String := "  -> ")
4537    is
4538    begin
4539       if not Opt.Verbose_Mode then
4540          return;
4541       end if;
4542
4543       Write_Str (Prefix);
4544       Write_Str ("""");
4545       Write_Name (N1);
4546       Write_Str (""" ");
4547       Write_Str (S1);
4548
4549       if N2 /= No_Name then
4550          Write_Str (" """);
4551          Write_Name (N2);
4552          Write_Str (""" ");
4553       end if;
4554
4555       Write_Str (S2);
4556       Write_Eol;
4557    end Verbose_Msg;
4558
4559 end Make;