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