OSDN Git Service

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