OSDN Git Service

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