OSDN Git Service

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