OpenCores
URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [tags/] [gnu-dev/] [fsf-gcc-snapshot-1-mar-12/] [or1k-gcc/] [gcc/] [ada/] [make.adb] - Blame information for rev 847

Go to most recent revision | Details | Compare with Previous | View Log

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

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.