OSDN Git Service

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