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