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