OSDN Git Service

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