OSDN Git Service

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