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