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