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