OSDN Git Service

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