OSDN Git Service

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