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