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