OSDN Git Service

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