OSDN Git Service

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