1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1992-2003 Free Software Foundation, Inc. --
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. --
22 -- GNAT was originally developed by the GNAT team at New York University. --
23 -- Extensive contributions were provided by Ada Core Technologies Inc. --
25 ------------------------------------------------------------------------------
28 with ALI.Util; use ALI.Util;
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;
39 with MLib.Tgt; use MLib.Tgt;
41 with Namet; use Namet;
43 with Osint.M; use Osint.M;
44 with Osint; use Osint;
46 with Output; use Output;
55 with Snames; use Snames;
56 with Switch; use Switch;
57 with Switch.M; use Switch.M;
62 with Ada.Exceptions; use Ada.Exceptions;
63 with Ada.Command_Line; use Ada.Command_Line;
65 with GNAT.Directory_Operations; use GNAT.Directory_Operations;
66 with GNAT.Case_Util; use GNAT.Case_Util;
71 -- Make control characters visible
73 Standard_Library_Package_Body_Name : constant String := "s-stalib.adb";
74 -- Every program depends on this package, that must then be checked,
75 -- especially when -f and -a are used.
77 type Sigint_Handler is access procedure;
79 procedure Install_Int_Handler (Handler : Sigint_Handler);
80 pragma Import (C, Install_Int_Handler, "__gnat_install_int_handler");
81 -- Called by Gnatmake to install the SIGINT handler below
83 procedure Sigint_Intercepted;
84 -- Called when the program is interrupted by Ctrl-C to delete the
85 -- temporary mapping files and configuration pragmas files.
87 -------------------------
88 -- Note on terminology --
89 -------------------------
91 -- In this program, we use the phrase "termination" of a file name to
92 -- refer to the suffix that appears after the unit name portion. Very
93 -- often this is simply the extension, but in some cases, the sequence
94 -- may be more complex, for example in main.1.ada, the termination in
95 -- this name is ".1.ada" and in main_.ada the termination is "_.ada".
97 -------------------------------------
98 -- Queue (Q) Manipulation Routines --
99 -------------------------------------
101 -- The Q is used in Compile_Sources below. Its implementation uses the
102 -- GNAT generic package Table (basically an extensible array). Q_Front
103 -- points to the first valid element in the Q, whereas Q.First is the first
104 -- element ever enqueued, while Q.Last - 1 is the last element in the Q.
106 -- +---+--------------+---+---+---+-----------+---+--------
107 -- Q | | ........ | | | | ....... | |
108 -- +---+--------------+---+---+---+-----------+---+--------
110 -- Q.First Q_Front Q.Last - 1
112 -- The elements comprised between Q.First and Q_Front - 1 are the
113 -- elements that have been enqueued and then dequeued, while the
114 -- elements between Q_Front and Q.Last - 1 are the elements currently
115 -- in the Q. When the Q is initialized Q_Front = Q.First = Q.Last.
116 -- After Compile_Sources has terminated its execution, Q_Front = Q.Last
117 -- and the elements contained between Q.Front and Q.Last-1 are those that
118 -- were explored and thus marked by Compile_Sources. Whenever the Q is
119 -- reinitialized, the elements between Q.First and Q.Last - 1 are unmarked.
122 -- Must be called to (re)initialize the Q.
125 (Source_File : File_Name_Type;
126 Source_Unit : Unit_Name_Type := No_Name);
127 -- Inserts Source_File at the end of Q. Provide Source_Unit when
128 -- possible for external use (gnatdist).
130 function Empty_Q return Boolean;
131 -- Returns True if Q is empty.
133 procedure Extract_From_Q
134 (Source_File : out File_Name_Type;
135 Source_Unit : out Unit_Name_Type);
136 -- Extracts the first element from the Q.
138 procedure Insert_Project_Sources
139 (The_Project : Project_Id;
140 All_Projects : Boolean;
142 -- If Into_Q is True, insert all sources of the project file(s) that are
143 -- not already marked into the Q. If Into_Q is False, call Osint.Add_File
144 -- for the first source, then insert all other sources that are not already
145 -- marked into the Q. If All_Projects is True, all sources of all projects
146 -- are concerned; otherwise, only sources of The_Project are concerned,
147 -- including, if The_Project is an extending project, sources inherited
148 -- from projects being extended.
150 First_Q_Initialization : Boolean := True;
151 -- Will be set to false after Init_Q has been called once.
154 -- Points to the first valid element in the Q.
156 Unique_Compile : Boolean := False;
157 -- Set to True if -u or -U or a project file with no main is used
159 Unique_Compile_All_Projects : Boolean := False;
160 -- Set to True if -U is used
162 RTS_Specified : String_Access := null;
163 -- Used to detect multiple --RTS= switches
165 type Q_Record is record
166 File : File_Name_Type;
167 Unit : Unit_Name_Type;
169 -- File is the name of the file to compile. Unit is for gnatdist
170 -- use in order to easily get the unit name of a file to compile
171 -- when its name is krunched or declared in gnat.adc.
173 package Q is new Table.Table (
174 Table_Component_Type => Q_Record,
175 Table_Index_Type => Natural,
176 Table_Low_Bound => 0,
177 Table_Initial => 4000,
178 Table_Increment => 100,
179 Table_Name => "Make.Q");
180 -- This is the actual Q.
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.
189 -- Mains are stored in a table. An index is used to retrieve the mains
192 procedure Add_Main (Name : String);
193 -- Add one main to the table
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.
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,
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,
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,
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,
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,
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,
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,
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,
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;
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,
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 -- Packages of project files where unknown attributes are errors.
317 Naming_String : aliased String := "naming";
318 Builder_String : aliased String := "builder";
319 Compiler_String : aliased String := "compiler";
320 Binder_String : aliased String := "binder";
321 Linker_String : aliased String := "linker";
323 Gnatmake_Packages : aliased String_List :=
324 (Naming_String 'Access,
325 Builder_String 'Access,
326 Compiler_String 'Access,
327 Binder_String 'Access,
328 Linker_String 'Access);
330 Packages_To_Check_By_Gnatmake : constant String_List_Access :=
331 Gnatmake_Packages'Access;
333 procedure Add_Source_Dir (N : String);
334 -- Call Add_Src_Search_Dir.
335 -- Output one line when in verbose mode.
337 procedure Add_Source_Directories is
338 new Prj.Env.For_All_Source_Dirs (Action => Add_Source_Dir);
340 procedure Add_Object_Dir (N : String);
341 -- Call Add_Lib_Search_Dir.
342 -- Output one line when in verbose mode.
344 procedure Add_Object_Directories is
345 new Prj.Env.For_All_Object_Dirs (Action => Add_Object_Dir);
347 type Bad_Compilation_Info is record
348 File : File_Name_Type;
349 Unit : Unit_Name_Type;
352 -- File is the name of the file for which a compilation failed.
353 -- Unit is for gnatdist use in order to easily get the unit name
354 -- of a file when its name is krunched or declared in gnat.adc.
355 -- Found is False if the compilation failed because the file could
358 package Bad_Compilation is new Table.Table (
359 Table_Component_Type => Bad_Compilation_Info,
360 Table_Index_Type => Natural,
361 Table_Low_Bound => 1,
363 Table_Increment => 100,
364 Table_Name => "Make.Bad_Compilation");
365 -- Full name of all the source files for which compilation fails.
367 Do_Compile_Step : Boolean := True;
368 Do_Bind_Step : Boolean := True;
369 Do_Link_Step : Boolean := True;
370 -- Flags to indicate what step should be executed.
371 -- Can be set to False with the switches -c, -b and -l.
372 -- These flags are reset to True for each invokation of procedure Gnatmake.
374 Shared_String : aliased String := "-shared";
376 No_Shared_Switch : aliased Argument_List := (1 .. 0 => null);
377 Shared_Switch : aliased Argument_List := (1 => Shared_String'Access);
378 Bind_Shared : Argument_List_Access := No_Shared_Switch'Access;
379 -- Switch to added in front of gnatbind switches. By default no switch is
380 -- added. Switch "-shared" is added if there is a non-static Library
383 Bind_Shared_Known : Boolean := False;
384 -- Set to True after the first time Bind_Shared is computed
386 procedure Make_Failed (S1 : String; S2 : String := ""; S3 : String := "");
387 -- Delete all temp files created by Gnatmake and call Osint.Fail,
388 -- with the parameter S1, S2 and S3 (see osint.ads).
389 -- This is called from the Prj hierarchy and the MLib hierarchy.
391 --------------------------
392 -- Obsolete Executables --
393 --------------------------
395 Executable_Obsolete : Boolean := False;
396 -- Executable_Obsolete is initially set to False for each executable,
397 -- and is set to True whenever one of the source of the executable is
398 -- compiled, or has already been compiled for another executable.
400 Max_Header : constant := 200; -- Arbitrary
402 type Header_Num is range 1 .. Max_Header;
403 -- Header_Num for the hash table Obsoleted below
405 function Hash (F : Name_Id) return Header_Num;
406 -- Hash function for the hash table Obsoleted below
408 package Obsoleted is new System.HTable.Simple_HTable
409 (Header_Num => Header_Num,
415 -- A hash table to keep all files that have been compiled, to detect
416 -- if an executable is up to date or not.
418 procedure Enter_Into_Obsoleted (F : Name_Id);
419 -- Enter a file name, without directory information, into the has table
422 function Is_In_Obsoleted (F : Name_Id) return Boolean;
423 -- Check if a file name, without directory information, has already been
424 -- entered into the hash table Obsoleted.
426 type Dependency is record
428 Depends_On : Name_Id;
430 -- Components of table Dependencies below.
432 package Dependencies is new Table.Table (
433 Table_Component_Type => Dependency,
434 Table_Index_Type => Integer,
435 Table_Low_Bound => 1,
437 Table_Increment => 100,
438 Table_Name => "Make.Dependencies");
439 -- A table to keep dependencies, to be able to decide if an executable
442 procedure Add_Dependency (S : Name_Id; On : Name_Id);
443 -- Add one entry in table Dependencies
445 ----------------------------
446 -- Arguments and Switches --
447 ----------------------------
449 Arguments : Argument_List_Access;
450 -- Used to gather the arguments for invocation of the compiler
452 Last_Argument : Natural := 0;
453 -- Last index of arguments in Arguments above
455 Arguments_Collected : Boolean := False;
456 -- Set to True when the arguments for the next invocation of the compiler
457 -- have been collected.
459 Arguments_Project : Project_Id;
460 -- Project id, if any, of the source to be compiled
462 Arguments_Path_Name : File_Name_Type;
463 -- Full path of the source to be compiled, when Arguments_Project is not
466 Dummy_Switch : constant String_Access := new String'("- ");
467 -- Used to initialized Prev_Switch in procedure Check
469 procedure Add_Arguments (Args : Argument_List);
470 -- Add arguments to global variable Arguments, increasing its size
471 -- if necessary and adjusting Last_Argument.
473 function Configuration_Pragmas_Switch
474 (For_Project : Project_Id) return Argument_List;
475 -- Return an argument list of one element, if there is a configuration
476 -- pragmas file to be specified for For_Project,
477 -- otherwise return an empty argument list.
479 ----------------------
480 -- Marking Routines --
481 ----------------------
483 Marking_Label : Byte := 1;
484 -- Value to mark the source files
486 procedure Mark (Source_File : File_Name_Type);
487 -- Mark Source_File. Marking is used to signal that Source_File has
488 -- already been inserted in the Q.
490 function Is_Marked (Source_File : File_Name_Type) return Boolean;
491 -- Returns True if Source_File was previously marked.
497 procedure List_Depend;
498 -- Prints to standard output the list of object dependencies. This list
499 -- can be used directly in a Makefile. A call to Compile_Sources must
500 -- precede the call to List_Depend. Also because this routine uses the
501 -- ALI files that were originally loaded and scanned by Compile_Sources,
502 -- no additional ALI files should be scanned between the two calls (i.e.
503 -- between the call to Compile_Sources and List_Depend.)
505 procedure Inform (N : Name_Id := No_Name; Msg : String);
506 -- Prints out the program name followed by a colon, N and S.
508 procedure List_Bad_Compilations;
509 -- Prints out the list of all files for which the compilation failed.
511 procedure Verbose_Msg
514 N2 : Name_Id := No_Name;
516 Prefix : String := " -> ");
517 -- If the verbose flag (Verbose_Mode) is set then print Prefix to standard
518 -- output followed by N1 and S1. If N2 /= No_Name then N2 is then printed
519 -- after S1. S2 is printed last. Both N1 and N2 are printed in quotation
522 Usage_Needed : Boolean := True;
523 -- Flag used to make sure Makeusg is call at most once
526 -- Call Makeusg, if Usage_Needed is True.
527 -- Set Usage_Needed to False.
529 procedure Debug_Msg (S : String; N : Name_Id);
530 -- If Debug.Debug_Flag_W is set outputs string S followed by name N.
532 type Project_Array is array (Positive range <>) of Project_Id;
533 No_Projects : constant Project_Array := (1 .. 0 => No_Project);
535 procedure Recursive_Compute_Depth
536 (Project : Project_Id;
537 Visited : Project_Array;
539 -- Compute depth of Project and of the projects it depends on
541 -----------------------
542 -- Gnatmake Routines --
543 -----------------------
545 Gnatmake_Called : Boolean := False;
546 -- Set to True when procedure Gnatmake is called.
547 -- Attempt to delete temporary files is made only when Gnatmake_Called
550 subtype Lib_Mark_Type is Byte;
551 -- Used in Mark_Directory
553 Ada_Lib_Dir : constant Lib_Mark_Type := 1;
554 -- Used to mark a directory as a GNAT lib dir
556 -- Note that the notion of GNAT lib dir is no longer used. The code
557 -- related to it has not been removed to give an idea on how to use
558 -- the directory prefix marking mechanism.
560 -- An Ada library directory is a directory containing ali and object
561 -- files but no source files for the bodies (the specs can be in the
562 -- same or some other directory). These directories are specified
563 -- in the Gnatmake command line with the switch "-Adir" (to specify the
564 -- spec location -Idir cab be used). Gnatmake skips the missing sources
565 -- whose ali are in Ada library directories. For an explanation of why
566 -- Gnatmake behaves that way, see the spec of Make.Compile_Sources.
567 -- The directory lookup penalty is incurred every single time this
568 -- routine is called.
570 procedure Check_Steps;
571 -- Check what steps (Compile, Bind, Link) must be executed.
572 -- Set the step flags accordingly.
574 function Is_External_Assignment (Argv : String) return Boolean;
575 -- Verify that an external assignment switch is syntactically correct.
578 -- -X"name=other value"
579 -- Assumptions: 'First = 1, Argv (1 .. 2) = "-X"
580 -- When this function returns True, the external assignment has
581 -- been entered by a call to Prj.Ext.Add, so that in a project
582 -- file, External ("name") will return "value".
584 function In_Ada_Lib_Dir (File : File_Name_Type) return Boolean;
585 -- Get directory prefix of this file and get lib mark stored in name
586 -- table for this directory. Then check if an Ada lib mark has been set.
588 procedure Mark_Directory
590 Mark : Lib_Mark_Type);
591 -- Store Dir in name table and set lib mark as name info to identify
594 Output_Is_Object : Boolean := True;
595 -- Set to False when using a switch -S for the compiler
597 procedure Check_For_S_Switch;
598 -- Set Output_Is_Object to False when the -S switch is used for the
602 (Source_File : Name_Id;
603 Source_File_Name : String;
604 Naming : Naming_Data;
605 In_Package : Package_Id;
606 Allow_ALI : Boolean) return Variable_Value;
607 -- Return the switches for the source file in the specified package
608 -- of a project file. If the Source_File ends with a standard GNAT
609 -- extension (".ads" or ".adb"), try first the full name, then the
610 -- name without the extension, then, if Allow_ALI is True, the name with
611 -- the extension ".ali". If there is no switches for either names, try the
612 -- default switches for Ada. If all failed, return No_Variable_Value.
614 procedure Test_If_Relative_Path
615 (Switch : in out String_Access;
616 Parent : String_Access;
617 Including_L_Switch : Boolean := True);
618 -- Test if Switch is a relative search path switch.
619 -- If it is, fail if Parent is null, otherwise prepend the path with
620 -- Parent. This subprogram is only called when using project files.
621 -- For gnatbind switches, Including_L_Switch is False, because the
622 -- argument of the -L switch is not a path.
624 function Is_In_Object_Directory
625 (Source_File : File_Name_Type;
626 Full_Lib_File : File_Name_Type) return Boolean;
627 -- Check if, when using a project file, the ALI file is in the project
628 -- directory of the ultimate extending project. If it is not, we ignore
629 -- the fact that this ALI file is read-only.
631 ----------------------------------------------------
632 -- Compiler, Binder & Linker Data and Subprograms --
633 ----------------------------------------------------
635 Gcc : String_Access := Program_Name ("gcc");
636 Gnatbind : String_Access := Program_Name ("gnatbind");
637 Gnatlink : String_Access := Program_Name ("gnatlink");
638 -- Default compiler, binder, linker programs
640 Saved_Gcc : String_Access := null;
641 Saved_Gnatbind : String_Access := null;
642 Saved_Gnatlink : String_Access := null;
643 -- Given by the command line. Will be used, if non null.
645 Gcc_Path : String_Access :=
646 GNAT.OS_Lib.Locate_Exec_On_Path (Gcc.all);
647 Gnatbind_Path : String_Access :=
648 GNAT.OS_Lib.Locate_Exec_On_Path (Gnatbind.all);
649 Gnatlink_Path : String_Access :=
650 GNAT.OS_Lib.Locate_Exec_On_Path (Gnatlink.all);
651 -- Path for compiler, binder, linker programs, defaulted now for gnatdist.
652 -- Changed later if overridden on command line.
654 Comp_Flag : constant String_Access := new String'("-c");
655 Output_Flag : constant String_Access := new String'("-o");
656 Ada_Flag_1 : constant String_Access := new String'("-x");
657 Ada_Flag_2 : constant String_Access := new String'("ada");
658 No_gnat_adc : constant String_Access := new String'("-gnatA");
659 GNAT_Flag : constant String_Access := new String'("-gnatpg");
660 Do_Not_Check_Flag : constant String_Access := new String'("-x");
662 Object_Suffix : constant String := Get_Object_Suffix.all;
663 Executable_Suffix : constant String := Get_Executable_Suffix.all;
665 Syntax_Only : Boolean := False;
666 -- Set to True when compiling with -gnats
668 Display_Executed_Programs : Boolean := True;
669 -- Set to True if name of commands should be output on stderr.
671 Output_File_Name_Seen : Boolean := False;
672 -- Set to True after having scanned the file_name for
673 -- switch "-o file_name"
675 Object_Directory_Seen : Boolean := False;
676 -- Set to True after having scanned the object directory for
677 -- switch "-D obj_dir".
679 Object_Directory_Path : String_Access := null;
680 -- The path name of the object directory, set with switch -D.
682 type Make_Program_Type is (None, Compiler, Binder, Linker);
684 Program_Args : Make_Program_Type := None;
685 -- Used to indicate if we are scanning gnatmake, gcc, gnatbind, or gnatbind
686 -- options within the gnatmake command line.
687 -- Used in Scan_Make_Arg only, but must be a global variable.
689 Temporary_Config_File : Boolean := False;
690 -- Set to True when there is a temporary config file used for a project
691 -- file, to avoid displaying the -gnatec switch for a temporary file.
693 procedure Add_Switches
694 (The_Package : Package_Id;
696 Program : Make_Program_Type);
699 Program : Make_Program_Type;
700 Append_Switch : Boolean := True;
701 And_Save : Boolean := True);
704 Program : Make_Program_Type;
705 Append_Switch : Boolean := True;
706 And_Save : Boolean := True);
707 -- Make invokes one of three programs (the compiler, the binder or the
708 -- linker). For the sake of convenience, some program specific switches
709 -- can be passed directly on the gnatmake commande line. This procedure
710 -- records these switches so that gnamake can pass them to the right
711 -- program. S is the switch to be added at the end of the command line
712 -- for Program if Append_Switch is True. If Append_Switch is False S is
713 -- added at the beginning of the command line.
716 (Source_File : File_Name_Type;
717 The_Args : Argument_List;
718 Lib_File : File_Name_Type;
721 O_File : out File_Name_Type;
722 O_Stamp : out Time_Stamp_Type);
723 -- Determines whether the library file Lib_File is up-to-date or not. The
724 -- full name (with path information) of the object file corresponding to
725 -- Lib_File is returned in O_File. Its time stamp is saved in O_Stamp.
726 -- ALI is the ALI_Id corresponding to Lib_File. If Lib_File in not
727 -- up-to-date, then the corresponding source file needs to be recompiled.
728 -- In this case ALI = No_ALI_Id.
730 procedure Check_Linker_Options
731 (E_Stamp : Time_Stamp_Type;
732 O_File : out File_Name_Type;
733 O_Stamp : out Time_Stamp_Type);
734 -- Checks all linker options for linker files that are newer
735 -- than E_Stamp. If such objects are found, the youngest object
736 -- is returned in O_File and its stamp in O_Stamp.
738 -- If no obsolete linker files were found, the first missing
739 -- linker file is returned in O_File and O_Stamp is empty.
740 -- Otherwise O_File is No_File.
742 procedure Collect_Arguments
743 (Source_File : File_Name_Type;
744 Args : Argument_List);
745 -- Collect all arguments for a source to be compiled, including those
746 -- that come from a project file.
748 procedure Display (Program : String; Args : Argument_List);
749 -- Displays Program followed by the arguments in Args if variable
750 -- Display_Executed_Programs is set. The lower bound of Args must be 1.
756 type Temp_File_Names is
757 array (Project_Id range <>, Positive range <>) of Name_Id;
759 type Temp_Files_Ptr is access Temp_File_Names;
761 type Indices is array (Project_Id range <>) of Natural;
763 type Indices_Ptr is access Indices;
765 type Free_File_Indices is array
766 (Project_Id range <>, Positive range <>) of Positive;
768 type Free_Indices_Ptr is access Free_File_Indices;
770 The_Mapping_File_Names : Temp_Files_Ptr;
771 -- For each project, the name ids of the temporary mapping files used
773 Last_Mapping_File_Names : Indices_Ptr;
774 -- For each project, the index of the last mapping file created
776 The_Free_Mapping_File_Indices : Free_Indices_Ptr;
777 -- For each project, the indices in The_Mapping_File_Names of the mapping
778 -- file names that can be reused for subsequent compilations.
780 Last_Free_Indices : Indices_Ptr;
781 -- For each project, the number of mapping files that can be reused
783 Gnatmake_Mapping_File : String_Access := null;
784 -- The path name of a mapping file specified by switch -C=
786 procedure Delete_Mapping_Files;
787 -- Delete all temporary mapping files
789 procedure Init_Mapping_File
790 (Project : Project_Id;
791 File_Index : in out Natural);
792 -- Create a new temporary mapping file, and fill it with the project file
793 -- mappings, when using project file(s). The out parameter File_Index is
794 -- the index to the name of the file in the array The_Mapping_File_Names.
796 procedure Delete_Temp_Config_Files;
797 -- Delete all temporary config files
799 procedure Delete_All_Temp_Files;
800 -- Delete all temp files (config files, mapping files, path files)
806 procedure Add_Arguments (Args : Argument_List) is
808 if Arguments = null then
809 Arguments := new Argument_List (1 .. Args'Length + 10);
812 while Last_Argument + Args'Length > Arguments'Last loop
814 New_Arguments : Argument_List_Access :=
815 new Argument_List (1 .. Arguments'Last * 2);
818 New_Arguments (1 .. Last_Argument) :=
819 Arguments (1 .. Last_Argument);
820 Arguments := New_Arguments;
825 Arguments (Last_Argument + 1 .. Last_Argument + Args'Length) := Args;
826 Last_Argument := Last_Argument + Args'Length;
833 procedure Add_Dependency (S : Name_Id; On : Name_Id) is
835 Dependencies.Increment_Last;
836 Dependencies.Table (Dependencies.Last) := (S, On);
843 procedure Add_Object_Dir (N : String) is
845 Add_Lib_Search_Dir (N);
847 if Opt.Verbose_Mode then
848 Write_Str ("Adding object directory """);
859 procedure Add_Source_Dir (N : String) is
861 Add_Src_Search_Dir (N);
863 if Opt.Verbose_Mode then
864 Write_Str ("Adding source directory """);
877 Program : Make_Program_Type;
878 Append_Switch : Boolean := True;
879 And_Save : Boolean := True)
882 with package T is new Table.Table (<>);
883 procedure Generic_Position (New_Position : out Integer);
884 -- Generic procedure that chooses a position for S in T at the
885 -- beginning or the end, depending on the boolean Append_Switch.
886 -- Calling this procedure may expand the table.
888 ----------------------
889 -- Generic_Position --
890 ----------------------
892 procedure Generic_Position (New_Position : out Integer) is
896 if Append_Switch then
897 New_Position := Integer (T.Last);
899 for J in reverse T.Table_Index_Type'Succ (T.First) .. T.Last loop
900 T.Table (J) := T.Table (T.Table_Index_Type'Pred (J));
903 New_Position := Integer (T.First);
905 end Generic_Position;
907 procedure Gcc_Switches_Pos is new Generic_Position (Gcc_Switches);
908 procedure Binder_Switches_Pos is new Generic_Position (Binder_Switches);
909 procedure Linker_Switches_Pos is new Generic_Position (Linker_Switches);
911 procedure Saved_Gcc_Switches_Pos is new
912 Generic_Position (Saved_Gcc_Switches);
914 procedure Saved_Binder_Switches_Pos is new
915 Generic_Position (Saved_Binder_Switches);
917 procedure Saved_Linker_Switches_Pos is new
918 Generic_Position (Saved_Linker_Switches);
920 New_Position : Integer;
922 -- Start of processing for Add_Switch
928 Saved_Gcc_Switches_Pos (New_Position);
929 Saved_Gcc_Switches.Table (New_Position) := S;
932 Saved_Binder_Switches_Pos (New_Position);
933 Saved_Binder_Switches.Table (New_Position) := S;
936 Saved_Linker_Switches_Pos (New_Position);
937 Saved_Linker_Switches.Table (New_Position) := S;
946 Gcc_Switches_Pos (New_Position);
947 Gcc_Switches.Table (New_Position) := S;
950 Binder_Switches_Pos (New_Position);
951 Binder_Switches.Table (New_Position) := S;
954 Linker_Switches_Pos (New_Position);
955 Linker_Switches.Table (New_Position) := S;
965 Program : Make_Program_Type;
966 Append_Switch : Boolean := True;
967 And_Save : Boolean := True)
970 Add_Switch (S => new String'(S),
972 Append_Switch => Append_Switch,
973 And_Save => And_Save);
980 procedure Add_Switches
981 (The_Package : Package_Id;
983 Program : Make_Program_Type)
985 Switches : Variable_Value;
986 Switch_List : String_List_Id;
987 Element : String_Element;
990 if File_Name'Length > 0 then
991 Name_Len := File_Name'Length;
992 Name_Buffer (1 .. Name_Len) := File_Name;
995 (Source_File => Name_Find,
996 Source_File_Name => File_Name,
997 Naming => Projects.Table (Main_Project).Naming,
998 In_Package => The_Package,
1000 Program = Binder or else Program = Linker);
1002 case Switches.Kind is
1007 Program_Args := Program;
1009 Switch_List := Switches.Values;
1011 while Switch_List /= Nil_String loop
1012 Element := String_Elements.Table (Switch_List);
1013 Get_Name_String (Element.Value);
1015 if Name_Len > 0 then
1017 Argv : constant String := Name_Buffer (1 .. Name_Len);
1018 -- We need a copy, because Name_Buffer may be
1022 if Opt.Verbose_Mode then
1023 Write_Str (" Adding ");
1027 Scan_Make_Arg (Argv, And_Save => False);
1031 Switch_List := Element.Next;
1035 Program_Args := Program;
1036 Get_Name_String (Switches.Value);
1038 if Name_Len > 0 then
1040 Argv : constant String := Name_Buffer (1 .. Name_Len);
1041 -- We need a copy, because Name_Buffer may be modified
1044 if Opt.Verbose_Mode then
1045 Write_Str (" Adding ");
1049 Scan_Make_Arg (Argv, And_Save => False);
1060 procedure Bind (ALI_File : File_Name_Type; Args : Argument_List) is
1061 Bind_Args : Argument_List (1 .. Args'Last + 2);
1062 Bind_Last : Integer;
1066 pragma Assert (Args'First = 1);
1068 -- Optimize the simple case where the gnatbind command line looks like
1069 -- gnatbind -aO. -I- file.ali --into-> gnatbind file.adb
1072 and then Args (Args'First).all = "-aO" & Normalized_CWD
1073 and then Args (Args'Last).all = "-I-"
1074 and then ALI_File = Strip_Directory (ALI_File)
1076 Bind_Last := Args'First - 1;
1079 Bind_Last := Args'Last;
1080 Bind_Args (Args'Range) := Args;
1083 -- It is completely pointless to re-check source file time stamps.
1084 -- This has been done already by gnatmake
1086 Bind_Last := Bind_Last + 1;
1087 Bind_Args (Bind_Last) := Do_Not_Check_Flag;
1089 Get_Name_String (ALI_File);
1091 Bind_Last := Bind_Last + 1;
1092 Bind_Args (Bind_Last) := new String'(Name_Buffer (1 .. Name_Len));
1094 GNAT.OS_Lib.Normalize_Arguments (Bind_Args (Args'First .. Bind_Last));
1096 Display (Gnatbind.all, Bind_Args (Args'First .. Bind_Last));
1098 if Gnatbind_Path = null then
1099 Make_Failed ("error, unable to locate ", Gnatbind.all);
1103 (Gnatbind_Path.all, Bind_Args (Args'First .. Bind_Last), Success);
1115 (Source_File : File_Name_Type;
1116 The_Args : Argument_List;
1117 Lib_File : File_Name_Type;
1118 Read_Only : Boolean;
1120 O_File : out File_Name_Type;
1121 O_Stamp : out Time_Stamp_Type)
1123 function First_New_Spec (A : ALI_Id) return File_Name_Type;
1124 -- Looks in the with table entries of A and returns the spec file name
1125 -- of the first withed unit (subprogram) for which no spec existed when
1126 -- A was generated but for which there exists one now, implying that A
1127 -- is now obsolete. If no such unit is found No_File is returned.
1128 -- Otherwise the spec file name of the unit is returned.
1130 -- **WARNING** in the event of Uname format modifications, one *MUST*
1131 -- make sure this function is also updated.
1133 -- Note: This function should really be in ali.adb and use Uname
1134 -- services, but this causes the whole compiler to be dragged along
1135 -- for gnatbind and gnatmake.
1137 --------------------
1138 -- First_New_Spec --
1139 --------------------
1141 function First_New_Spec (A : ALI_Id) return File_Name_Type is
1142 Spec_File_Name : File_Name_Type := No_File;
1144 function New_Spec (Uname : Unit_Name_Type) return Boolean;
1145 -- Uname is the name of the spec or body of some ada unit.
1146 -- This function returns True if the Uname is the name of a body
1147 -- which has a spec not mentioned inali file A. If True is returned
1148 -- Spec_File_Name above is set to the name of this spec file.
1154 function New_Spec (Uname : Unit_Name_Type) return Boolean is
1155 Spec_Name : Unit_Name_Type;
1156 File_Name : File_Name_Type;
1159 -- Test whether Uname is the name of a body unit (ie ends with %b)
1161 Get_Name_String (Uname);
1163 Assert (Name_Len > 2 and then Name_Buffer (Name_Len - 1) = '%');
1165 if Name_Buffer (Name_Len) /= 'b' then
1169 -- Convert unit name into spec name
1171 -- ??? this code seems dubious in presence of pragma
1172 -- Source_File_Name since there is no more direct relationship
1173 -- between unit name and file name.
1175 -- ??? Further, what about alternative subunit naming
1177 Name_Buffer (Name_Len) := 's';
1178 Spec_Name := Name_Find;
1179 File_Name := Get_File_Name (Spec_Name, Subunit => False);
1181 -- Look if File_Name is mentioned in A's sdep list.
1182 -- If not look if the file exists. If it does return True.
1185 ALIs.Table (A).First_Sdep .. ALIs.Table (A).Last_Sdep
1187 if Sdep.Table (D).Sfile = File_Name then
1192 if Full_Source_Name (File_Name) /= No_File then
1193 Spec_File_Name := File_Name;
1200 -- Start of processing for First_New_Spec
1204 ALIs.Table (A).First_Unit .. ALIs.Table (A).Last_Unit
1206 exit U_Chk when Units.Table (U).Utype = Is_Body_Only
1207 and then New_Spec (Units.Table (U).Uname);
1209 for W in Units.Table (U).First_With
1211 Units.Table (U).Last_With
1214 Withs.Table (W).Afile /= No_File
1215 and then New_Spec (Withs.Table (W).Uname);
1219 return Spec_File_Name;
1222 ---------------------------------
1223 -- Data declarations for Check --
1224 ---------------------------------
1226 Full_Lib_File : File_Name_Type;
1227 -- Full name of current library file
1229 Full_Obj_File : File_Name_Type;
1230 -- Full name of the object file corresponding to Lib_File.
1232 Lib_Stamp : Time_Stamp_Type;
1233 -- Time stamp of the current ada library file.
1235 Obj_Stamp : Time_Stamp_Type;
1236 -- Time stamp of the current object file.
1238 Modified_Source : File_Name_Type;
1239 -- The first source in Lib_File whose current time stamp differs
1240 -- from that stored in Lib_File.
1242 New_Spec : File_Name_Type;
1243 -- If Lib_File contains in its W (with) section a body (for a
1244 -- subprogram) for which there exists a spec and the spec did not
1245 -- appear in the Sdep section of Lib_File, New_Spec contains the file
1246 -- name of this new spec.
1248 Source_Name : Name_Id;
1249 Text : Text_Buffer_Ptr;
1251 Prev_Switch : String_Access;
1252 -- Previous switch processed
1254 Arg : Arg_Id := Arg_Id'First;
1255 -- Current index in Args.Table for a given unit (init to stop warning)
1257 Switch_Found : Boolean;
1258 -- True if a given switch has been found
1260 -- Start of processing for Check
1263 pragma Assert (Lib_File /= No_File);
1265 -- If the ALI file is read-only, set temporarily
1266 -- Check_Object_Consistency to False: we don't care if the object file
1267 -- is not there; presumably, a library will be used for linking.
1271 Saved_Check_Object_Consistency : constant Boolean :=
1272 Opt.Check_Object_Consistency;
1274 Opt.Check_Object_Consistency := False;
1275 Text := Read_Library_Info (Lib_File);
1276 Opt.Check_Object_Consistency := Saved_Check_Object_Consistency;
1280 Text := Read_Library_Info (Lib_File);
1283 Full_Lib_File := Full_Library_Info_Name;
1284 Full_Obj_File := Full_Object_File_Name;
1285 Lib_Stamp := Current_Library_File_Stamp;
1286 Obj_Stamp := Current_Object_File_Stamp;
1288 if Full_Lib_File = No_File then
1289 Verbose_Msg (Lib_File, "being checked ...", Prefix => " ");
1291 Verbose_Msg (Full_Lib_File, "being checked ...", Prefix => " ");
1295 O_File := Full_Obj_File;
1296 O_Stamp := Obj_Stamp;
1299 if Full_Lib_File = No_File then
1300 Verbose_Msg (Lib_File, "missing.");
1302 elsif Obj_Stamp (Obj_Stamp'First) = ' ' then
1303 Verbose_Msg (Full_Obj_File, "missing.");
1307 (Full_Lib_File, "(" & String (Lib_Stamp) & ") newer than",
1308 Full_Obj_File, "(" & String (Obj_Stamp) & ")");
1312 ALI := Scan_ALI (Lib_File, Text, Ignore_ED => False, Err => True);
1315 if ALI = No_ALI_Id then
1316 Verbose_Msg (Full_Lib_File, "incorrectly formatted ALI file");
1319 elsif ALIs.Table (ALI).Ver (1 .. ALIs.Table (ALI).Ver_Len) /=
1322 Verbose_Msg (Full_Lib_File, "compiled with old GNAT version");
1327 -- Don't take Ali file into account if it was generated with
1330 if ALIs.Table (ALI).Compile_Errors then
1331 Verbose_Msg (Full_Lib_File, "had errors, must be recompiled");
1336 -- Don't take Ali file into account if it was generated without
1339 if Opt.Operating_Mode /= Opt.Check_Semantics
1340 and then ALIs.Table (ALI).No_Object
1342 Verbose_Msg (Full_Lib_File, "has no corresponding object");
1347 -- Check for matching compiler switches if needed
1349 if Opt.Check_Switches then
1351 -- First, collect all the switches
1353 Collect_Arguments (Source_File, The_Args);
1355 Prev_Switch := Dummy_Switch;
1357 Get_Name_String (ALIs.Table (ALI).Sfile);
1359 Switches_To_Check.Set_Last (0);
1361 for J in 1 .. Last_Argument loop
1363 -- Skip non switches -c, -I and -o switches
1365 if Arguments (J) (1) = '-'
1366 and then Arguments (J) (2) /= 'c'
1367 and then Arguments (J) (2) /= 'o'
1368 and then Arguments (J) (2) /= 'I'
1370 Normalize_Compiler_Switches
1372 Normalized_Switches,
1375 for K in 1 .. Last_Norm_Switch loop
1376 Switches_To_Check.Increment_Last;
1377 Switches_To_Check.Table (Switches_To_Check.Last) :=
1378 Normalized_Switches (K);
1383 for J in 1 .. Switches_To_Check.Last loop
1385 -- Comparing switches is delicate because gcc reorders
1386 -- a number of switches, according to lang-specs.h, but
1387 -- gnatmake doesn't have the sufficient knowledge to
1388 -- perform the same reordering. Instead, we ignore orders
1389 -- between different "first letter" switches, but keep
1390 -- orders between same switches, e.g -O -O2 is different
1391 -- than -O2 -O, but -g -O is equivalent to -O -g.
1393 if Switches_To_Check.Table (J) (2) /= Prev_Switch (2) or else
1394 (Prev_Switch'Length >= 6 and then
1395 Prev_Switch (2 .. 5) = "gnat" and then
1396 Switches_To_Check.Table (J)'Length >= 6 and then
1397 Switches_To_Check.Table (J) (2 .. 5) = "gnat" and then
1398 Prev_Switch (6) /= Switches_To_Check.Table (J) (6))
1400 Prev_Switch := Switches_To_Check.Table (J);
1402 Units.Table (ALIs.Table (ALI).First_Unit).First_Arg;
1405 Switch_Found := False;
1408 Units.Table (ALIs.Table (ALI).First_Unit).Last_Arg
1411 Switches_To_Check.Table (J).all = Args.Table (K).all
1414 Switch_Found := True;
1419 if not Switch_Found then
1420 if Opt.Verbose_Mode then
1421 Verbose_Msg (ALIs.Table (ALI).Sfile,
1422 "switch mismatch """ &
1423 Switches_To_Check.Table (J).all & '"');
1431 if Switches_To_Check.Last /=
1432 Integer (Units.Table (ALIs.Table (ALI).First_Unit).Last_Arg -
1433 Units.Table (ALIs.Table (ALI).First_Unit).First_Arg + 1)
1435 if Opt.Verbose_Mode then
1436 Verbose_Msg (ALIs.Table (ALI).Sfile,
1437 "different number of switches");
1439 for K in Units.Table (ALIs.Table (ALI).First_Unit).First_Arg
1440 .. Units.Table (ALIs.Table (ALI).First_Unit).Last_Arg
1442 Write_Str (Args.Table (K).all);
1448 for J in 1 .. Switches_To_Check.Last loop
1449 Write_Str (Switches_To_Check.Table (J).all);
1461 -- Get the source files and their message digests. Note that some
1462 -- sources may be missing if ALI is out-of-date.
1464 Set_Source_Table (ALI);
1466 Modified_Source := Time_Stamp_Mismatch (ALI, Read_Only);
1468 if Modified_Source /= No_File then
1471 if Opt.Verbose_Mode then
1472 Source_Name := Full_Source_Name (Modified_Source);
1474 if Source_Name /= No_File then
1475 Verbose_Msg (Source_Name, "time stamp mismatch");
1477 Verbose_Msg (Modified_Source, "missing");
1482 New_Spec := First_New_Spec (ALI);
1484 if New_Spec /= No_File then
1487 if Opt.Verbose_Mode then
1488 Source_Name := Full_Source_Name (New_Spec);
1490 if Source_Name /= No_File then
1491 Verbose_Msg (Source_Name, "new spec");
1493 Verbose_Msg (New_Spec, "old spec missing");
1501 ------------------------
1502 -- Check_For_S_Switch --
1503 ------------------------
1505 procedure Check_For_S_Switch is
1507 -- By default, we generate an object file
1509 Output_Is_Object := True;
1511 for Arg in 1 .. Last_Argument loop
1512 if Arguments (Arg).all = "-S" then
1513 Output_Is_Object := False;
1515 elsif Arguments (Arg).all = "-c" then
1516 Output_Is_Object := True;
1519 end Check_For_S_Switch;
1521 --------------------------
1522 -- Check_Linker_Options --
1523 --------------------------
1525 procedure Check_Linker_Options
1526 (E_Stamp : Time_Stamp_Type;
1527 O_File : out File_Name_Type;
1528 O_Stamp : out Time_Stamp_Type)
1530 procedure Check_File (File : File_Name_Type);
1531 -- Update O_File and O_Stamp if the given file is younger than E_Stamp
1532 -- and O_Stamp, or if O_File is No_File and File does not exist.
1534 function Get_Library_File (Name : String) return File_Name_Type;
1535 -- Return the full file name including path of a library based
1536 -- on the name specified with the -l linker option, using the
1537 -- Ada object path. Return No_File if no such file can be found.
1539 type Char_Array is array (Natural) of Character;
1540 type Char_Array_Access is access constant Char_Array;
1542 Template : Char_Array_Access;
1543 pragma Import (C, Template, "__gnat_library_template");
1549 procedure Check_File (File : File_Name_Type) is
1550 Stamp : Time_Stamp_Type;
1551 Name : File_Name_Type := File;
1554 Get_Name_String (Name);
1556 -- Remove any trailing NUL characters
1558 while Name_Len >= Name_Buffer'First
1559 and then Name_Buffer (Name_Len) = NUL
1561 Name_Len := Name_Len - 1;
1564 if Name_Len <= 0 then
1567 elsif Name_Buffer (1) = '-' then
1569 -- Do not check if File is a switch other than "-l"
1571 if Name_Buffer (2) /= 'l' then
1575 -- The argument is a library switch, get actual name. It
1576 -- is necessary to make a copy of the relevant part of
1577 -- Name_Buffer as Get_Library_Name uses Name_Buffer as well.
1580 Base_Name : constant String := Name_Buffer (3 .. Name_Len);
1583 Name := Get_Library_File (Base_Name);
1586 if Name = No_File then
1591 Stamp := File_Stamp (Name);
1593 -- Find the youngest object file that is younger than the
1594 -- executable. If no such file exist, record the first object
1595 -- file that is not found.
1597 if (O_Stamp < Stamp and then E_Stamp < Stamp)
1598 or else (O_File = No_File and then Stamp (Stamp'First) = ' ')
1603 -- Strip the trailing NUL if present
1605 Get_Name_String (O_File);
1607 if Name_Buffer (Name_Len) = NUL then
1608 Name_Len := Name_Len - 1;
1609 O_File := Name_Find;
1614 ----------------------
1615 -- Get_Library_Name --
1616 ----------------------
1618 -- See comments in a-adaint.c about template syntax
1620 function Get_Library_File (Name : String) return File_Name_Type is
1621 File : File_Name_Type := No_File;
1626 for Ptr in Template'Range loop
1627 case Template (Ptr) is
1629 Add_Str_To_Name_Buffer (Name);
1632 File := Full_Lib_File_Name (Name_Find);
1633 exit when File /= No_File;
1640 Add_Char_To_Name_Buffer (Template (Ptr));
1644 -- The for loop exited because the end of the template
1645 -- was reached. File contains the last possible file name
1648 if File = No_File and then Name_Len > 0 then
1649 File := Full_Lib_File_Name (Name_Find);
1653 end Get_Library_File;
1655 -- Start of processing for Check_Linker_Options
1659 O_Stamp := (others => ' ');
1661 -- Process linker options from the ALI files.
1663 for Opt in 1 .. Linker_Options.Last loop
1664 Check_File (Linker_Options.Table (Opt).Name);
1667 -- Process options given on the command line.
1669 for Opt in Linker_Switches.First .. Linker_Switches.Last loop
1671 -- Check if the previous Opt has one of the two switches
1672 -- that take an extra parameter. (See GCC manual.)
1674 if Opt = Linker_Switches.First
1675 or else (Linker_Switches.Table (Opt - 1).all /= "-u"
1677 Linker_Switches.Table (Opt - 1).all /= "-Xlinker"
1679 Linker_Switches.Table (Opt - 1).all /= "-L")
1682 Add_Str_To_Name_Buffer (Linker_Switches.Table (Opt).all);
1683 Check_File (Name_Find);
1687 end Check_Linker_Options;
1693 procedure Check_Steps is
1695 -- If either -c, -b or -l has been specified, we will not necessarily
1696 -- execute all steps.
1699 Do_Compile_Step := Do_Compile_Step and Compile_Only;
1700 Do_Bind_Step := Do_Bind_Step and Bind_Only;
1701 Do_Link_Step := Do_Link_Step and Link_Only;
1703 -- If -c has been specified, but not -b, ignore any potential -l
1705 if Do_Compile_Step and then not Do_Bind_Step then
1706 Do_Link_Step := False;
1711 -----------------------
1712 -- Collect_Arguments --
1713 -----------------------
1715 procedure Collect_Arguments
1716 (Source_File : File_Name_Type;
1717 Args : Argument_List)
1720 Arguments_Collected := True;
1721 Arguments_Project := No_Project;
1723 Add_Arguments (Args);
1725 if Main_Project /= No_Project then
1727 Source_File_Name : constant String :=
1728 Get_Name_String (Source_File);
1729 Compiler_Package : Prj.Package_Id;
1730 Switches : Prj.Variable_Value;
1731 Data : Project_Data;
1736 (Source_File_Name => Source_File_Name,
1737 Project => Arguments_Project,
1738 Path => Arguments_Path_Name);
1740 -- If the source is not a source of a project file,
1741 -- we simply add the saved gcc switches.
1743 if Arguments_Project = No_Project then
1745 Add_Arguments (The_Saved_Gcc_Switches.all);
1748 -- We get the project directory for the relative path
1749 -- switches and arguments.
1751 Data := Projects.Table (Arguments_Project);
1753 -- If the source is in an extended project, we go to
1754 -- the ultimate extending project.
1756 while Data.Extended_By /= No_Project loop
1757 Arguments_Project := Data.Extended_By;
1758 Data := Projects.Table (Arguments_Project);
1761 -- If building a dynamic or relocatable library, compile with
1762 -- PIC option, if it exists.
1764 if Data.Library and then Data.Library_Kind /= Static then
1766 PIC : constant String := MLib.Tgt.PIC_Option;
1770 Add_Arguments ((1 => new String'(PIC)));
1775 if Data.Dir_Path = null then
1777 new String'(Get_Name_String (Data.Display_Directory));
1778 Projects.Table (Arguments_Project) := Data;
1781 -- We now look for package Compiler
1782 -- and get the switches from this package.
1786 (Name => Name_Compiler,
1787 In_Packages => Data.Decl.Packages);
1789 if Compiler_Package /= No_Package then
1791 -- If package Gnatmake.Compiler exists, we get
1792 -- the specific switches for the current source,
1793 -- or the global switches, if any.
1795 Switches := Switches_Of
1796 (Source_File => Source_File,
1797 Source_File_Name => Source_File_Name,
1798 Naming => Data.Naming,
1799 In_Package => Compiler_Package,
1800 Allow_ALI => False);
1804 case Switches.Kind is
1806 -- We have a list of switches. We add these switches,
1807 -- plus the saved gcc switches.
1812 Current : String_List_Id := Switches.Values;
1813 Element : String_Element;
1814 Number : Natural := 0;
1817 while Current /= Nil_String loop
1818 Element := String_Elements.Table (Current);
1819 Number := Number + 1;
1820 Current := Element.Next;
1824 New_Args : Argument_List (1 .. Number);
1827 Current := Switches.Values;
1829 for Index in New_Args'Range loop
1830 Element := String_Elements.Table (Current);
1831 Get_Name_String (Element.Value);
1833 new String'(Name_Buffer (1 .. Name_Len));
1834 Test_If_Relative_Path
1835 (New_Args (Index), Parent => Data.Dir_Path);
1836 Current := Element.Next;
1840 (Configuration_Pragmas_Switch
1841 (Arguments_Project) &
1842 New_Args & The_Saved_Gcc_Switches.all);
1846 -- We have a single switch. We add this switch,
1847 -- plus the saved gcc switches.
1850 Get_Name_String (Switches.Value);
1853 New_Args : Argument_List :=
1855 (Name_Buffer (1 .. Name_Len)));
1858 Test_If_Relative_Path
1859 (New_Args (1), Parent => Data.Dir_Path);
1861 (Configuration_Pragmas_Switch (Arguments_Project) &
1862 New_Args & The_Saved_Gcc_Switches.all);
1865 -- We have no switches from Gnatmake.Compiler.
1866 -- We add the saved gcc switches.
1870 (Configuration_Pragmas_Switch (Arguments_Project) &
1871 The_Saved_Gcc_Switches.all);
1877 -- Set Output_Is_Object, depending if there is a -S switch.
1878 -- If the bind step is not performed, and there is a -S switch,
1879 -- then we will not check for a valid object file.
1882 end Collect_Arguments;
1884 ---------------------
1885 -- Compile_Sources --
1886 ---------------------
1888 procedure Compile_Sources
1889 (Main_Source : File_Name_Type;
1890 Args : Argument_List;
1891 First_Compiled_File : out Name_Id;
1892 Most_Recent_Obj_File : out Name_Id;
1893 Most_Recent_Obj_Stamp : out Time_Stamp_Type;
1894 Main_Unit : out Boolean;
1895 Compilation_Failures : out Natural;
1896 Check_Readonly_Files : Boolean := False;
1897 Do_Not_Execute : Boolean := False;
1898 Force_Compilations : Boolean := False;
1899 Keep_Going : Boolean := False;
1900 In_Place_Mode : Boolean := False;
1901 Initialize_ALI_Data : Boolean := True;
1902 Max_Process : Positive := 1)
1907 Args : Argument_List) return Process_Id;
1908 -- Compiles S using Args. If S is a GNAT predefined source
1909 -- "-gnatpg" is added to Args. Non blocking call. L corresponds to the
1910 -- expected library file name. Process_Id of the process spawned to
1911 -- execute the compile.
1913 No_Mapping_File : constant Natural := 0;
1915 type Compilation_Data is record
1917 Full_Source_File : File_Name_Type;
1918 Lib_File : File_Name_Type;
1919 Source_Unit : Unit_Name_Type;
1920 Mapping_File : Natural := No_Mapping_File;
1921 Project : Project_Id := No_Project;
1922 Syntax_Only : Boolean := False;
1923 Output_Is_Object : Boolean := True;
1926 Running_Compile : array (1 .. Max_Process) of Compilation_Data;
1927 -- Used to save information about outstanding compilations.
1929 Outstanding_Compiles : Natural := 0;
1930 -- Current number of outstanding compiles
1932 Source_Unit : Unit_Name_Type;
1933 -- Current source unit
1935 Source_File : File_Name_Type;
1936 -- Current source file
1938 Full_Source_File : File_Name_Type;
1939 -- Full name of the current source file
1941 Lib_File : File_Name_Type;
1942 -- Current library file
1944 Full_Lib_File : File_Name_Type;
1945 -- Full name of the current library file
1947 Obj_File : File_Name_Type;
1948 -- Full name of the object file corresponding to Lib_File.
1950 Obj_Stamp : Time_Stamp_Type;
1951 -- Time stamp of the current object file.
1953 Sfile : File_Name_Type;
1954 -- Contains the source file of the units withed by Source_File
1957 -- ALI Id of the current ALI file
1959 Read_Only : Boolean := False;
1961 Compilation_OK : Boolean;
1962 Need_To_Compile : Boolean;
1965 Text : Text_Buffer_Ptr;
1967 Mfile : Natural := No_Mapping_File;
1969 Need_To_Check_Standard_Library : Boolean :=
1970 Check_Readonly_Files and not Unique_Compile;
1972 Mapping_File_Arg : String_Access;
1974 procedure Add_Process
1976 Sfile : File_Name_Type;
1977 Afile : File_Name_Type;
1978 Uname : Unit_Name_Type;
1979 Mfile : Natural := No_Mapping_File);
1980 -- Adds process Pid to the current list of outstanding compilation
1981 -- processes and record the full name of the source file Sfile that
1982 -- we are compiling, the name of its library file Afile and the
1983 -- name of its unit Uname. If Mfile is not equal to No_Mapping_File,
1984 -- it is the index of the mapping file used during compilation in the
1985 -- array The_Mapping_File_Names.
1987 procedure Await_Compile
1988 (Sfile : out File_Name_Type;
1989 Afile : out File_Name_Type;
1990 Uname : out Unit_Name_Type;
1992 -- Awaits that an outstanding compilation process terminates. When
1993 -- it does set Sfile to the name of the source file that was compiled
1994 -- Afile to the name of its library file and Uname to the name of its
1995 -- unit. Note that this time stamp can be used to check whether the
1996 -- compilation did generate an object file. OK is set to True if the
1997 -- compilation succeeded. Note that Sfile, Afile and Uname could be
1998 -- resp. No_File, No_File and No_Name if there were no compilations
2001 procedure Collect_Arguments_And_Compile (Source_File : File_Name_Type);
2002 -- Collect arguments from project file (if any) and compile
2004 package Good_ALI is new Table.Table (
2005 Table_Component_Type => ALI_Id,
2006 Table_Index_Type => Natural,
2007 Table_Low_Bound => 1,
2008 Table_Initial => 50,
2009 Table_Increment => 100,
2010 Table_Name => "Make.Good_ALI");
2011 -- Contains the set of valid ALI files that have not yet been scanned.
2013 procedure Record_Good_ALI (A : ALI_Id);
2014 -- Records in the previous set the Id of an ALI file.
2016 function Good_ALI_Present return Boolean;
2017 -- Returns True if any ALI file was recorded in the previous set.
2019 function Get_Next_Good_ALI return ALI_Id;
2020 -- Returns the next good ALI_Id record;
2022 procedure Record_Failure
2023 (File : File_Name_Type;
2024 Unit : Unit_Name_Type;
2025 Found : Boolean := True);
2026 -- Records in the previous table that the compilation for File failed.
2027 -- If Found is False then the compilation of File failed because we
2028 -- could not find it. Records also Unit when possible.
2030 function Bad_Compilation_Count return Natural;
2031 -- Returns the number of compilation failures.
2033 procedure Get_Mapping_File (Project : Project_Id);
2034 -- Get a mapping file name. If there is one to be reused, reuse it.
2035 -- Otherwise, create a new mapping file.
2041 procedure Add_Process
2043 Sfile : File_Name_Type;
2044 Afile : File_Name_Type;
2045 Uname : Unit_Name_Type;
2046 Mfile : Natural := No_Mapping_File)
2048 OC1 : constant Positive := Outstanding_Compiles + 1;
2051 pragma Assert (OC1 <= Max_Process);
2052 pragma Assert (Pid /= Invalid_Pid);
2054 Running_Compile (OC1).Pid := Pid;
2055 Running_Compile (OC1).Full_Source_File := Sfile;
2056 Running_Compile (OC1).Lib_File := Afile;
2057 Running_Compile (OC1).Source_Unit := Uname;
2058 Running_Compile (OC1).Mapping_File := Mfile;
2059 Running_Compile (OC1).Project := Arguments_Project;
2060 Running_Compile (OC1).Syntax_Only := Syntax_Only;
2061 Running_Compile (OC1).Output_Is_Object := Output_Is_Object;
2063 Outstanding_Compiles := OC1;
2066 --------------------
2070 procedure Await_Compile
2071 (Sfile : out File_Name_Type;
2072 Afile : out File_Name_Type;
2073 Uname : out File_Name_Type;
2077 Project : Project_Id;
2080 pragma Assert (Outstanding_Compiles > 0);
2087 -- The loop here is a work-around for a problem on VMS; in some
2088 -- circumstances (shared library and several executables, for
2089 -- example), there are child processes other than compilation
2090 -- processes that are received. Until this problem is resolved,
2091 -- we will ignore such processes.
2094 Wait_Process (Pid, OK);
2096 if Pid = Invalid_Pid then
2100 for J in Running_Compile'First .. Outstanding_Compiles loop
2101 if Pid = Running_Compile (J).Pid then
2102 Sfile := Running_Compile (J).Full_Source_File;
2103 Afile := Running_Compile (J).Lib_File;
2104 Uname := Running_Compile (J).Source_Unit;
2105 Syntax_Only := Running_Compile (J).Syntax_Only;
2106 Output_Is_Object := Running_Compile (J).Output_Is_Object;
2107 Project := Running_Compile (J).Project;
2109 -- If a mapping file was used by this compilation,
2110 -- get its file name for reuse by a subsequent compilation
2112 if Running_Compile (J).Mapping_File /= No_Mapping_File then
2113 Last_Free_Indices (Project) :=
2114 Last_Free_Indices (Project) + 1;
2115 The_Free_Mapping_File_Indices
2116 (Project, Last_Free_Indices (Project)) :=
2117 Running_Compile (J).Mapping_File;
2120 -- To actually remove this Pid and related info from
2121 -- Running_Compile replace its entry with the last valid
2122 -- entry in Running_Compile.
2124 if J = Outstanding_Compiles then
2128 Running_Compile (J) :=
2129 Running_Compile (Outstanding_Compiles);
2132 Outstanding_Compiles := Outstanding_Compiles - 1;
2137 -- This child process was not one of our compilation processes;
2138 -- just ignore it for now.
2140 -- raise Program_Error;
2144 ---------------------------
2145 -- Bad_Compilation_Count --
2146 ---------------------------
2148 function Bad_Compilation_Count return Natural is
2150 return Bad_Compilation.Last - Bad_Compilation.First + 1;
2151 end Bad_Compilation_Count;
2153 -----------------------------------
2154 -- Collect_Arguments_And_Compile --
2155 -----------------------------------
2157 procedure Collect_Arguments_And_Compile (Source_File : File_Name_Type) is
2160 -- If arguments have not yet been collected (in Check), collect them
2163 if not Arguments_Collected then
2164 Collect_Arguments (Source_File, Args);
2167 -- If we use mapping file (-P or -C switches), then get one
2169 if Create_Mapping_File then
2170 Get_Mapping_File (Arguments_Project);
2173 -- If the source is part of a project file, we set the ADA_*_PATHs,
2174 -- check for an eventual library project, and use the full path.
2176 if Arguments_Project /= No_Project then
2177 Prj.Env.Set_Ada_Paths (Arguments_Project, True);
2179 if MLib.Tgt.Support_For_Libraries /= MLib.Tgt.None then
2181 The_Data : Project_Data :=
2182 Projects.Table (Arguments_Project);
2183 Prj : Project_Id := Arguments_Project;
2186 while The_Data.Extended_By /= No_Project loop
2187 Prj := The_Data.Extended_By;
2188 The_Data := Projects.Table (Prj);
2191 if The_Data.Library and then not The_Data.Flag1 then
2192 -- Add to the Q all sources of the project that
2193 -- have not been marked
2195 Insert_Project_Sources
2196 (The_Project => Prj,
2197 All_Projects => False,
2200 -- Now mark the project as processed
2202 Projects.Table (Prj).Flag1 := True;
2207 -- Change to the object directory of the project file, if it is
2208 -- not the main project file.
2210 if Arguments_Project /= Main_Project then
2213 (Projects.Table (Arguments_Project).Object_Directory));
2216 Pid := Compile (Arguments_Path_Name, Lib_File,
2217 Arguments (1 .. Last_Argument));
2219 -- Change back to the object directory of the main project file,
2222 if Arguments_Project /= Main_Project then
2225 (Projects.Table (Main_Project).Object_Directory));
2229 Pid := Compile (Full_Source_File, Lib_File,
2230 Arguments (1 .. Last_Argument));
2232 end Collect_Arguments_And_Compile;
2241 Args : Argument_List) return Process_Id
2243 Comp_Args : Argument_List (Args'First .. Args'Last + 8);
2244 Comp_Next : Integer := Args'First;
2245 Comp_Last : Integer;
2247 function Ada_File_Name (Name : Name_Id) return Boolean;
2248 -- Returns True if Name is the name of an ada source file
2249 -- (i.e. suffix is .ads or .adb)
2255 function Ada_File_Name (Name : Name_Id) return Boolean is
2257 Get_Name_String (Name);
2260 and then Name_Buffer (Name_Len - 3 .. Name_Len - 1) = ".ad"
2261 and then (Name_Buffer (Name_Len) = 'b'
2263 Name_Buffer (Name_Len) = 's');
2266 -- Start of processing for Compile
2269 Enter_Into_Obsoleted (S);
2271 -- By default, Syntax_Only is False
2273 Syntax_Only := False;
2275 for J in Args'Range loop
2276 if Args (J).all = "-gnats" then
2278 -- If we compile with -gnats, the bind step and the link step
2279 -- are inhibited. Also, we set Syntax_Only to True, so that
2280 -- we don't fail when we don't find the ALI file, after
2283 Do_Bind_Step := False;
2284 Do_Link_Step := False;
2285 Syntax_Only := True;
2287 elsif Args (J).all = "-gnatc" then
2289 -- If we compile with -gnatc, the bind step and the link step
2290 -- are inhibited. We set Syntax_Only to False for the case when
2291 -- -gnats was previously specified.
2293 Do_Bind_Step := False;
2294 Do_Link_Step := False;
2295 Syntax_Only := False;
2299 Comp_Args (Comp_Next) := Comp_Flag;
2300 Comp_Next := Comp_Next + 1;
2302 -- Optimize the simple case where the gcc command line looks like
2303 -- gcc -c -I. ... -I- file.adb --into-> gcc -c ... file.adb
2305 if Args (Args'First).all = "-I" & Normalized_CWD
2306 and then Args (Args'Last).all = "-I-"
2307 and then S = Strip_Directory (S)
2309 Comp_Last := Comp_Next + Args'Length - 3;
2310 Comp_Args (Comp_Next .. Comp_Last) :=
2311 Args (Args'First + 1 .. Args'Last - 1);
2314 Comp_Last := Comp_Next + Args'Length - 1;
2315 Comp_Args (Comp_Next .. Comp_Last) := Args;
2318 -- Set -gnatpg for predefined files (for this purpose the renamings
2319 -- such as Text_IO do not count as predefined). Note that we strip
2320 -- the directory name from the source file name becase the call to
2321 -- Fname.Is_Predefined_File_Name cannot deal with directory prefixes.
2324 Fname : constant File_Name_Type := Strip_Directory (S);
2327 if Is_Predefined_File_Name (Fname, False) then
2328 if Check_Readonly_Files then
2329 Comp_Last := Comp_Last + 1;
2330 Comp_Args (Comp_Last) := GNAT_Flag;
2334 ("not allowed to compile """ &
2335 Get_Name_String (Fname) &
2336 """; use -a switch, or compile file with " &
2337 """-gnatg"" switch");
2342 -- Now check if the file name has one of the suffixes familiar to
2343 -- the gcc driver. If this is not the case then add the ada flag
2346 if not Ada_File_Name (S) and then not Targparm.AAMP_On_Target then
2347 Comp_Last := Comp_Last + 1;
2348 Comp_Args (Comp_Last) := Ada_Flag_1;
2349 Comp_Last := Comp_Last + 1;
2350 Comp_Args (Comp_Last) := Ada_Flag_2;
2353 if L /= Strip_Directory (L) or else Object_Directory_Path /= null then
2355 -- Build -o argument.
2357 Get_Name_String (L);
2359 for J in reverse 1 .. Name_Len loop
2360 if Name_Buffer (J) = '.' then
2361 Name_Len := J + Object_Suffix'Length - 1;
2362 Name_Buffer (J .. Name_Len) := Object_Suffix;
2367 Comp_Last := Comp_Last + 1;
2368 Comp_Args (Comp_Last) := Output_Flag;
2369 Comp_Last := Comp_Last + 1;
2371 -- If an object directory was specified, prepend the object file
2372 -- name with this object directory.
2374 if Object_Directory_Path /= null then
2375 Comp_Args (Comp_Last) :=
2376 new String'(Object_Directory_Path.all &
2377 Name_Buffer (1 .. Name_Len));
2380 Comp_Args (Comp_Last) :=
2381 new String'(Name_Buffer (1 .. Name_Len));
2385 if Create_Mapping_File then
2386 Comp_Last := Comp_Last + 1;
2387 Comp_Args (Comp_Last) := Mapping_File_Arg;
2390 Get_Name_String (S);
2392 Comp_Last := Comp_Last + 1;
2393 Comp_Args (Comp_Last) := new String'(Name_Buffer (1 .. Name_Len));
2395 GNAT.OS_Lib.Normalize_Arguments (Comp_Args (Args'First .. Comp_Last));
2397 Display (Gcc.all, Comp_Args (Args'First .. Comp_Last));
2399 if Gcc_Path = null then
2400 Make_Failed ("error, unable to locate ", Gcc.all);
2404 GNAT.OS_Lib.Non_Blocking_Spawn
2405 (Gcc_Path.all, Comp_Args (Args'First .. Comp_Last));
2408 ----------------------
2409 -- Get_Mapping_File --
2410 ----------------------
2412 procedure Get_Mapping_File (Project : Project_Id) is
2414 -- If there is a mapping file ready to be reused, reuse it
2416 if Last_Free_Indices (Project) > 0 then
2417 Mfile := The_Free_Mapping_File_Indices
2418 (Project, Last_Free_Indices (Project));
2419 Last_Free_Indices (Project) := Last_Free_Indices (Project) - 1;
2421 -- Otherwise, create and initialize a new one
2424 Init_Mapping_File (Project => Project, File_Index => Mfile);
2427 -- Put the name in the mapping file argument for the invocation
2430 Free (Mapping_File_Arg);
2432 new String'("-gnatem=" &
2434 (The_Mapping_File_Names (Project, Mfile)));
2436 end Get_Mapping_File;
2438 -----------------------
2439 -- Get_Next_Good_ALI --
2440 -----------------------
2442 function Get_Next_Good_ALI return ALI_Id is
2446 pragma Assert (Good_ALI_Present);
2447 ALI := Good_ALI.Table (Good_ALI.Last);
2448 Good_ALI.Decrement_Last;
2450 end Get_Next_Good_ALI;
2452 ----------------------
2453 -- Good_ALI_Present --
2454 ----------------------
2456 function Good_ALI_Present return Boolean is
2458 return Good_ALI.First <= Good_ALI.Last;
2459 end Good_ALI_Present;
2461 --------------------
2462 -- Record_Failure --
2463 --------------------
2465 procedure Record_Failure
2466 (File : File_Name_Type;
2467 Unit : Unit_Name_Type;
2468 Found : Boolean := True)
2471 Bad_Compilation.Increment_Last;
2472 Bad_Compilation.Table (Bad_Compilation.Last) := (File, Unit, Found);
2475 ---------------------
2476 -- Record_Good_ALI --
2477 ---------------------
2479 procedure Record_Good_ALI (A : ALI_Id) is
2481 Good_ALI.Increment_Last;
2482 Good_ALI.Table (Good_ALI.Last) := A;
2483 end Record_Good_ALI;
2485 -- Start of processing for Compile_Sources
2488 pragma Assert (Args'First = 1);
2490 -- Package and Queue initializations.
2493 Output.Set_Standard_Error;
2495 if First_Q_Initialization then
2499 if Initialize_ALI_Data then
2501 Initialize_ALI_Source;
2504 -- The following two flags affect the behavior of ALI.Set_Source_Table.
2505 -- We set Opt.Check_Source_Files to True to ensure that source file
2506 -- time stamps are checked, and we set Opt.All_Sources to False to
2507 -- avoid checking the presence of the source files listed in the
2508 -- source dependency section of an ali file (which would be a mistake
2509 -- since the ali file may be obsolete).
2511 Opt.Check_Source_Files := True;
2512 Opt.All_Sources := False;
2514 Insert_Q (Main_Source);
2517 First_Compiled_File := No_File;
2518 Most_Recent_Obj_File := No_File;
2519 Most_Recent_Obj_Stamp := Empty_Time_Stamp;
2522 -- Keep looping until there is no more work to do (the Q is empty)
2523 -- and all the outstanding compilations have terminated
2525 Make_Loop : while not Empty_Q or else Outstanding_Compiles > 0 loop
2527 -- If the user does not want to keep going in case of errors then
2528 -- wait for the remaining outstanding compiles and then exit.
2530 if Bad_Compilation_Count > 0 and then not Keep_Going then
2531 while Outstanding_Compiles > 0 loop
2533 (Full_Source_File, Lib_File, Source_Unit, Compilation_OK);
2535 if not Compilation_OK then
2536 Record_Failure (Full_Source_File, Source_Unit);
2543 -- PHASE 1: Check if there is more work that we can do (ie the Q
2544 -- is non empty). If there is, do it only if we have not yet used
2545 -- up all the available processes.
2547 if not Empty_Q and then Outstanding_Compiles < Max_Process then
2548 Extract_From_Q (Source_File, Source_Unit);
2549 Full_Source_File := Osint.Full_Source_Name (Source_File);
2550 Lib_File := Osint.Lib_File_Name (Source_File);
2551 Full_Lib_File := Osint.Full_Lib_File_Name (Lib_File);
2553 -- If this source has already been compiled, the executable is
2556 if Is_In_Obsoleted (Source_File) then
2557 Executable_Obsolete := True;
2560 -- If the library file is an Ada library skip it
2562 if Full_Lib_File /= No_File
2563 and then In_Ada_Lib_Dir (Full_Lib_File)
2565 Verbose_Msg (Lib_File, "is in an Ada library", Prefix => " ");
2567 -- If the library file is a read-only library skip it, but only
2568 -- if, when using project files, this library file is in the
2569 -- right object directory (a read-only ALI file in the object
2570 -- directory of a project being extended should not be skipped).
2572 elsif Full_Lib_File /= No_File
2573 and then not Check_Readonly_Files
2574 and then Is_Readonly_Library (Full_Lib_File)
2575 and then Is_In_Object_Directory (Source_File, Full_Lib_File)
2578 (Lib_File, "is a read-only library", Prefix => " ");
2580 -- The source file that we are checking cannot be located
2582 elsif Full_Source_File = No_File then
2583 Record_Failure (Source_File, Source_Unit, False);
2585 -- Source and library files can be located but are internal
2588 elsif not Check_Readonly_Files
2589 and then Full_Lib_File /= No_File
2590 and then Is_Internal_File_Name (Source_File)
2593 if Force_Compilations then
2595 ("not allowed to compile """ &
2596 Get_Name_String (Source_File) &
2597 """; use -a switch, or compile file with " &
2598 """-gnatg"" switch");
2602 (Lib_File, "is an internal library", Prefix => " ");
2604 -- The source file that we are checking can be located
2607 Arguments_Collected := False;
2609 -- Don't waste any time if we have to recompile anyway
2611 Obj_Stamp := Empty_Time_Stamp;
2612 Need_To_Compile := Force_Compilations;
2614 if not Force_Compilations then
2616 Full_Lib_File /= No_File
2617 and then not Check_Readonly_Files
2618 and then Is_Readonly_Library (Full_Lib_File);
2619 Check (Source_File, Args, Lib_File, Read_Only,
2620 ALI, Obj_File, Obj_Stamp);
2621 Need_To_Compile := (ALI = No_ALI_Id);
2624 if not Need_To_Compile then
2626 -- The ALI file is up-to-date. Record its Id.
2628 Record_Good_ALI (ALI);
2630 -- Record the time stamp of the most recent object file
2631 -- as long as no (re)compilations are needed.
2633 if First_Compiled_File = No_File
2634 and then (Most_Recent_Obj_File = No_File
2635 or else Obj_Stamp > Most_Recent_Obj_Stamp)
2637 Most_Recent_Obj_File := Obj_File;
2638 Most_Recent_Obj_Stamp := Obj_Stamp;
2642 -- Is this the first file we have to compile?
2644 if First_Compiled_File = No_File then
2645 First_Compiled_File := Full_Source_File;
2646 Most_Recent_Obj_File := No_File;
2648 if Do_Not_Execute then
2653 if In_Place_Mode then
2655 -- If the library file was not found, then save the
2656 -- library file near the source file.
2658 if Full_Lib_File = No_File then
2659 Get_Name_String (Full_Source_File);
2661 for J in reverse 1 .. Name_Len loop
2662 if Name_Buffer (J) = '.' then
2663 Name_Buffer (J + 1 .. J + 3) := "ali";
2669 Lib_File := Name_Find;
2671 -- If the library file was found, then save the
2672 -- library file in the same place.
2675 Lib_File := Full_Lib_File;
2680 -- Start the compilation and record it. We can do this
2681 -- because there is at least one free process.
2683 Collect_Arguments_And_Compile (Source_File);
2685 -- Make sure we could successfully start the compilation
2687 if Pid = Invalid_Pid then
2688 Record_Failure (Full_Source_File, Source_Unit);
2701 -- PHASE 2: Now check if we should wait for a compilation to
2702 -- finish. This is the case if all the available processes are
2703 -- busy compiling sources or there is nothing else to do
2704 -- (that is the Q is empty and there are no good ALIs to process).
2706 if Outstanding_Compiles = Max_Process
2708 and then not Good_ALI_Present
2709 and then Outstanding_Compiles > 0)
2712 (Full_Source_File, Lib_File, Source_Unit, Compilation_OK);
2714 if not Compilation_OK then
2715 Record_Failure (Full_Source_File, Source_Unit);
2718 if Compilation_OK or else Keep_Going then
2720 -- Re-read the updated library file
2723 Saved_Object_Consistency : constant Boolean :=
2724 Opt.Check_Object_Consistency;
2727 -- If compilation was not OK, or if output is not an
2728 -- object file and we don't do the bind step, don't check
2729 -- for object consistency.
2731 Opt.Check_Object_Consistency :=
2732 Opt.Check_Object_Consistency
2734 and (Output_Is_Object or Do_Bind_Step);
2735 Text := Read_Library_Info (Lib_File);
2737 -- Restore Check_Object_Consistency to its initial value
2739 Opt.Check_Object_Consistency := Saved_Object_Consistency;
2742 -- If an ALI file was generated by this compilation, scan
2743 -- the ALI file and record it.
2744 -- If the scan fails, a previous ali file is inconsistent with
2745 -- the unit just compiled.
2747 if Text /= null then
2749 Scan_ALI (Lib_File, Text, Ignore_ED => False, Err => True);
2751 if ALI = No_ALI_Id then
2753 -- Record a failure only if not already done
2755 if Compilation_OK then
2758 "incompatible ALI file, please recompile");
2759 Record_Failure (Full_Source_File, Source_Unit);
2763 Record_Good_ALI (ALI);
2766 -- If we could not read the ALI file that was just generated
2767 -- then there could be a problem reading either the ALI or the
2768 -- corresponding object file (if Opt.Check_Object_Consistency
2769 -- is set Read_Library_Info checks that the time stamp of the
2770 -- object file is more recent than that of the ALI). For an
2771 -- example of problems caught by this test see [6625-009].
2772 -- However, we record a failure only if not already done.
2775 if Compilation_OK and not Syntax_Only then
2778 "WARNING: ALI or object file not found after compile");
2779 Record_Failure (Full_Source_File, Source_Unit);
2785 -- PHASE 3: Check if we recorded good ALI files. If yes process
2786 -- them now in the order in which they have been recorded. There
2787 -- are two occasions in which we record good ali files. The first is
2788 -- in phase 1 when, after scanning an existing ALI file we realize
2789 -- it is up-to-date, the second instance is after a successful
2792 while Good_ALI_Present loop
2793 ALI := Get_Next_Good_ALI;
2795 -- If we are processing the library file corresponding to the
2796 -- main source file check if this source can be a main unit.
2798 if ALIs.Table (ALI).Sfile = Main_Source then
2799 Main_Unit := ALIs.Table (ALI).Main_Program /= None;
2802 -- The following adds the standard library (s-stalib) to the
2803 -- list of files to be handled by gnatmake: this file and any
2804 -- files it depends on are always included in every bind,
2805 -- even if they are not in the explicit dependency list.
2806 -- Of course, it is not added if Suppress_Standard_Library
2809 -- However, to avoid annoying output about s-stalib.ali being
2810 -- read only, when "-v" is used, we add the standard library
2811 -- only when "-a" is used.
2813 if Need_To_Check_Standard_Library then
2814 Need_To_Check_Standard_Library := False;
2816 if not Targparm.Suppress_Standard_Library_On_Target then
2819 Add_It : Boolean := True;
2822 Name_Len := Standard_Library_Package_Body_Name'Length;
2823 Name_Buffer (1 .. Name_Len) :=
2824 Standard_Library_Package_Body_Name;
2825 Sfile := Name_Enter;
2827 -- If we have a special runtime, we add the standard
2828 -- library only if we can find it.
2830 if Opt.RTS_Switch then
2831 Add_It := Find_File (Sfile, Osint.Source) /= No_File;
2835 if Is_Marked (Sfile) then
2836 if Is_In_Obsoleted (Sfile) then
2837 Executable_Obsolete := True;
2849 -- Now insert in the Q the unmarked source files (i.e. those
2850 -- which have never been inserted in the Q and hence never
2851 -- considered). Only do that if Unique_Compile is False.
2853 if not Unique_Compile then
2855 ALIs.Table (ALI).First_Unit .. ALIs.Table (ALI).Last_Unit
2858 Units.Table (J).First_With .. Units.Table (J).Last_With
2860 Sfile := Withs.Table (K).Sfile;
2861 Add_Dependency (ALIs.Table (ALI).Sfile, Sfile);
2863 if Is_In_Obsoleted (Sfile) then
2864 Executable_Obsolete := True;
2867 if Sfile = No_File then
2868 Debug_Msg ("Skipping generic:", Withs.Table (K).Uname);
2870 elsif Is_Marked (Sfile) then
2871 Debug_Msg ("Skipping marked file:", Sfile);
2873 elsif not Check_Readonly_Files
2874 and then Is_Internal_File_Name (Sfile)
2876 Debug_Msg ("Skipping internal file:", Sfile);
2879 Insert_Q (Sfile, Withs.Table (K).Uname);
2887 if Opt.Display_Compilation_Progress then
2888 Write_Str ("completed ");
2889 Write_Int (Int (Q_Front));
2890 Write_Str (" out of ");
2891 Write_Int (Int (Q.Last));
2893 Write_Int (Int ((Q_Front * 100) / (Q.Last - Q.First)));
2894 Write_Str ("%)...");
2899 Compilation_Failures := Bad_Compilation_Count;
2901 -- Compilation is finished
2903 -- Delete any temporary configuration pragma file
2905 Delete_Temp_Config_Files;
2907 end Compile_Sources;
2909 ----------------------------------
2910 -- Configuration_Pragmas_Switch --
2911 ----------------------------------
2913 function Configuration_Pragmas_Switch
2914 (For_Project : Project_Id) return Argument_List
2916 The_Packages : Package_Id;
2917 Gnatmake : Package_Id;
2918 Compiler : Package_Id;
2920 Global_Attribute : Variable_Value := Nil_Variable_Value;
2921 Local_Attribute : Variable_Value := Nil_Variable_Value;
2923 Global_Attribute_Present : Boolean := False;
2924 Local_Attribute_Present : Boolean := False;
2926 Result : Argument_List (1 .. 3);
2927 Last : Natural := 0;
2929 function Absolute_Path
2931 Project : Project_Id) return String;
2932 -- Returns an absolute path for a configuration pragmas file.
2938 function Absolute_Path
2940 Project : Project_Id) return String
2943 Get_Name_String (Path);
2946 Path_Name : constant String := Name_Buffer (1 .. Name_Len);
2949 if Is_Absolute_Path (Path_Name) then
2954 Parent_Directory : constant String :=
2955 Get_Name_String (Projects.Table (Project).Directory);
2958 if Parent_Directory (Parent_Directory'Last) =
2961 return Parent_Directory & Path_Name;
2964 return Parent_Directory & Directory_Separator & Path_Name;
2971 -- Start of processing for Configuration_Pragmas_Switch
2974 Prj.Env.Create_Config_Pragmas_File (For_Project, Main_Project);
2976 if Projects.Table (For_Project).Config_File_Name /= No_Name then
2977 Temporary_Config_File :=
2978 Projects.Table (For_Project).Config_File_Temp;
2984 (Projects.Table (For_Project).Config_File_Name));
2987 Temporary_Config_File := False;
2990 -- Check for attribute Builder'Global_Configuration_Pragmas
2992 The_Packages := Projects.Table (Main_Project).Decl.Packages;
2995 (Name => Name_Builder,
2996 In_Packages => The_Packages);
2998 if Gnatmake /= No_Package then
2999 Global_Attribute := Prj.Util.Value_Of
3000 (Variable_Name => Name_Global_Configuration_Pragmas,
3001 In_Variables => Packages.Table (Gnatmake).Decl.Attributes);
3002 Global_Attribute_Present :=
3003 Global_Attribute /= Nil_Variable_Value
3004 and then Get_Name_String (Global_Attribute.Value) /= "";
3006 if Global_Attribute_Present then
3008 Path : constant String :=
3010 (Global_Attribute.Value, Global_Attribute.Project);
3012 if not Is_Regular_File (Path) then
3014 ("cannot find configuration pragmas file ", Path);
3018 Result (Last) := new String'("-gnatec=" & Path);
3023 -- Check for attribute Compiler'Local_Configuration_Pragmas
3025 The_Packages := Projects.Table (For_Project).Decl.Packages;
3028 (Name => Name_Compiler,
3029 In_Packages => The_Packages);
3031 if Compiler /= No_Package then
3032 Local_Attribute := Prj.Util.Value_Of
3033 (Variable_Name => Name_Local_Configuration_Pragmas,
3034 In_Variables => Packages.Table (Compiler).Decl.Attributes);
3035 Local_Attribute_Present :=
3036 Local_Attribute /= Nil_Variable_Value
3037 and then Get_Name_String (Local_Attribute.Value) /= "";
3039 if Local_Attribute_Present then
3041 Path : constant String :=
3043 (Local_Attribute.Value, Local_Attribute.Project);
3045 if not Is_Regular_File (Path) then
3047 ("cannot find configuration pragmas file ", Path);
3051 Result (Last) := new String'("-gnatec=" & Path);
3056 return Result (1 .. Last);
3057 end Configuration_Pragmas_Switch;
3063 procedure Debug_Msg (S : String; N : Name_Id) is
3065 if Debug.Debug_Flag_W then
3066 Write_Str (" ... ");
3074 ---------------------------
3075 -- Delete_All_Temp_Files --
3076 ---------------------------
3078 procedure Delete_All_Temp_Files is
3080 if Gnatmake_Called and not Debug.Debug_Flag_N then
3081 Delete_Mapping_Files;
3082 Delete_Temp_Config_Files;
3083 Prj.Env.Delete_All_Path_Files;
3085 end Delete_All_Temp_Files;
3087 --------------------------
3088 -- Delete_Mapping_Files --
3089 --------------------------
3091 procedure Delete_Mapping_Files is
3094 if not Debug.Debug_Flag_N then
3095 if The_Mapping_File_Names /= null then
3096 for Project in The_Mapping_File_Names'Range (1) loop
3097 for Index in 1 .. Last_Mapping_File_Names (Project) loop
3099 (Name => Get_Name_String
3100 (The_Mapping_File_Names (Project, Index)),
3101 Success => Success);
3106 end Delete_Mapping_Files;
3108 ------------------------------
3109 -- Delete_Temp_Config_Files --
3110 ------------------------------
3112 procedure Delete_Temp_Config_Files is
3115 if (not Debug.Debug_Flag_N) and Main_Project /= No_Project then
3116 for Project in 1 .. Projects.Last loop
3117 if Projects.Table (Project).Config_File_Temp then
3118 if Opt.Verbose_Mode then
3119 Write_Str ("Deleting temp configuration file """);
3120 Write_Str (Get_Name_String
3121 (Projects.Table (Project).Config_File_Name));
3126 (Name => Get_Name_String
3127 (Projects.Table (Project).Config_File_Name),
3128 Success => Success);
3130 -- Make sure that we don't have a config file for this
3131 -- project, in case when there are several mains.
3132 -- In this case, we will recreate another config file:
3133 -- we cannot reuse the one that we just deleted!
3135 Projects.Table (Project).Config_Checked := False;
3136 Projects.Table (Project).Config_File_Name := No_Name;
3137 Projects.Table (Project).Config_File_Temp := False;
3141 end Delete_Temp_Config_Files;
3147 procedure Display (Program : String; Args : Argument_List) is
3149 pragma Assert (Args'First = 1);
3151 if Display_Executed_Programs then
3152 Write_Str (Program);
3154 for J in Args'Range loop
3156 -- Do not display the mapping file argument automatically
3157 -- created when using a project file.
3159 if Main_Project = No_Project
3160 or else Debug.Debug_Flag_N
3161 or else Args (J)'Length < 8
3163 Args (J)(Args (J)'First .. Args (J)'First + 6) /= "-gnatem"
3165 -- When -dn is not specified, do not display the config
3166 -- pragmas switch (-gnatec) for the temporary file created
3167 -- by the project manager (always the first -gnatec switch).
3168 -- Reset Temporary_Config_File to False so that the eventual
3169 -- other -gnatec switches will be displayed.
3171 if (not Debug.Debug_Flag_N)
3172 and then Temporary_Config_File
3173 and then Args (J)'Length > 7
3174 and then Args (J)(Args (J)'First .. Args (J)'First + 6)
3177 Temporary_Config_File := False;
3179 -- Do not display the -F=mapping_file switch for gnatbind,
3180 -- if -dn is not specified.
3182 elsif Debug.Debug_Flag_N
3183 or else Args (J)'Length < 4
3184 or else Args (J)(Args (J)'First .. Args (J)'First + 2) /=
3188 Write_Str (Args (J).all);
3197 ----------------------
3198 -- Display_Commands --
3199 ----------------------
3201 procedure Display_Commands (Display : Boolean := True) is
3203 Display_Executed_Programs := Display;
3204 end Display_Commands;
3210 function Empty_Q return Boolean is
3212 if Debug.Debug_Flag_P then
3213 Write_Str (" Q := [");
3215 for J in Q_Front .. Q.Last - 1 loop
3217 Write_Name (Q.Table (J).File);
3226 return Q_Front >= Q.Last;
3229 --------------------------
3230 -- Enter_Into_Obsoleted --
3231 --------------------------
3233 procedure Enter_Into_Obsoleted (F : Name_Id) is
3234 Name : String := Get_Name_String (F);
3235 First : Natural := Name'Last;
3239 while First > Name'First
3240 and then Name (First - 1) /= Directory_Separator
3241 and then Name (First - 1) /= '/'
3246 if First /= Name'First then
3248 Add_Str_To_Name_Buffer (Name (First .. Name'Last));
3252 Debug_Msg ("New entry in Obsoleted table:", F2);
3253 Obsoleted.Set (F2, True);
3254 end Enter_Into_Obsoleted;
3256 ---------------------
3257 -- Extract_Failure --
3258 ---------------------
3260 procedure Extract_Failure
3261 (File : out File_Name_Type;
3262 Unit : out Unit_Name_Type;
3263 Found : out Boolean)
3266 File := Bad_Compilation.Table (Bad_Compilation.Last).File;
3267 Unit := Bad_Compilation.Table (Bad_Compilation.Last).Unit;
3268 Found := Bad_Compilation.Table (Bad_Compilation.Last).Found;
3269 Bad_Compilation.Decrement_Last;
3270 end Extract_Failure;
3272 --------------------
3273 -- Extract_From_Q --
3274 --------------------
3276 procedure Extract_From_Q
3277 (Source_File : out File_Name_Type;
3278 Source_Unit : out Unit_Name_Type)
3280 File : constant File_Name_Type := Q.Table (Q_Front).File;
3281 Unit : constant Unit_Name_Type := Q.Table (Q_Front).Unit;
3284 if Debug.Debug_Flag_Q then
3285 Write_Str (" Q := Q - [ ");
3291 Q_Front := Q_Front + 1;
3292 Source_File := File;
3293 Source_Unit := Unit;
3300 procedure Make_Failed (S1 : String; S2 : String := ""; S3 : String := "") is
3302 Delete_All_Temp_Files;
3303 Osint.Fail (S1, S2, S3);
3310 procedure Gnatmake is
3311 Main_Source_File : File_Name_Type;
3312 -- The source file containing the main compilation unit
3314 Compilation_Failures : Natural;
3316 Total_Compilation_Failures : Natural := 0;
3318 Is_Main_Unit : Boolean;
3319 -- Set to True by Compile_Sources if the Main_Source_File can be a
3322 Main_ALI_File : File_Name_Type;
3323 -- The ali file corresponding to Main_Source_File
3325 Executable : File_Name_Type := No_File;
3326 -- The file name of an executable
3328 Non_Std_Executable : Boolean := False;
3329 -- Non_Std_Executable is set to True when there is a possibility
3330 -- that the linker will not choose the correct executable file name.
3332 Current_Work_Dir : constant String_Access :=
3333 new String'(Get_Current_Dir);
3334 -- The current working directory, used to modify some relative path
3335 -- switches on the command line when a project file is used.
3338 Gnatmake_Called := True;
3340 Install_Int_Handler (Sigint_Intercepted'Access);
3342 Do_Compile_Step := True;
3343 Do_Bind_Step := True;
3344 Do_Link_Step := True;
3350 Bind_Shared := No_Shared_Switch'Access;
3351 Bind_Shared_Known := False;
3353 Failed_Links.Set_Last (0);
3354 Successful_Links.Set_Last (0);
3356 if Hostparm.Java_VM then
3357 Gcc := new String'("jgnat");
3358 Gnatbind := new String'("jgnatbind");
3359 Gnatlink := new String'("jgnatlink");
3361 -- Do not check for an object file (".o") when compiling to
3362 -- Java bytecode since ".class" files are generated instead.
3364 Opt.Check_Object_Consistency := False;
3367 if Main_Project /= No_Project then
3369 -- If the main project file is a library project file, main(s)
3370 -- cannot be specified on the command line.
3372 if Osint.Number_Of_Files /= 0 then
3373 if Projects.Table (Main_Project).Library
3374 and then not Unique_Compile
3375 and then ((not Make_Steps) or else Bind_Only or else Link_Only)
3377 Make_Failed ("cannot specify a main program " &
3378 "on the command line for a library project file");
3381 -- Check that each main on the command line is a source of a
3382 -- project file and, if there are several mains, each of them
3383 -- is a source of the same project file.
3388 Real_Main_Project : Project_Id := No_Project;
3389 -- The project of the first main
3391 Proj : Project_Id := No_Project;
3392 -- The project of the current main
3399 Main : constant String := Mains.Next_Main;
3400 -- The name specified on the command line may include
3401 -- directory information.
3403 File_Name : constant String := Base_Name (Main);
3404 -- The simple file name of the current main main
3407 exit when Main = "";
3409 -- Get the project of the current main
3411 Proj := Prj.Env.Project_Of (File_Name, Main_Project);
3413 -- Fail if the current main is not a source of a
3416 if Proj = No_Project then
3419 """ is not a source of any project");
3422 -- If there is directory information, check that
3423 -- the source exists and, if it does, that the path
3424 -- is the actual path of a source of a project.
3426 if Main /= File_Name then
3428 Data : constant Project_Data :=
3429 Projects.Table (Main_Project);
3431 Project_Path : constant String :=
3432 Prj.Env.File_Name_Of_Library_Unit_Body
3434 Project => Main_Project,
3435 Main_Project_Only => False,
3437 Real_Path : String_Access :=
3441 (Data.Naming.Current_Body_Suffix),
3444 if Real_Path = null then
3449 (Data.Naming.Current_Spec_Suffix),
3453 if Real_Path = null then
3455 Locate_Regular_File (Main, "");
3458 -- Fail if the file cannot be found
3460 if Real_Path = null then
3462 ("file """ & Main & """ does not exist");
3466 Normed_Path : constant String :=
3469 Case_Sensitive => False);
3473 -- Fail if it is not the correct path
3475 if Normed_Path /= Project_Path then
3476 if Verbose_Mode then
3477 Write_Str (Normed_Path);
3479 Write_Line (Project_Path);
3484 """ is not a source of any project");
3490 if not Unique_Compile then
3492 -- Record the project, if it is the first main
3494 if Real_Main_Project = No_Project then
3495 Real_Main_Project := Proj;
3497 elsif Proj /= Real_Main_Project then
3499 -- Fail, as the current main is not a source
3500 -- of the same project as the first main.
3504 """ is not a source of project " &
3507 (Real_Main_Project).Name));
3512 -- If -u and -U are not used, we may have mains that
3513 -- are sources of a project that is not the one
3514 -- specified with switch -P.
3516 if not Unique_Compile then
3517 Main_Project := Real_Main_Project;
3524 -- If no mains have been specified on the command line,
3525 -- and we are using a project file, we either find the main(s)
3526 -- in the attribute Main of the main project, or we put all
3527 -- the sources of the project file as mains.
3531 Value : String_List_Id := Projects.Table (Main_Project).Mains;
3534 -- The attribute Main is an empty list or not specified,
3535 -- or else gnatmake was invoked with the switch "-u".
3537 if Value = Prj.Nil_String or else Unique_Compile then
3539 if (not Make_Steps) or else Compile_Only
3540 or else not Projects.Table (Main_Project).Library
3542 -- First make sure that the binder and the linker
3543 -- will not be invoked.
3545 Do_Bind_Step := False;
3546 Do_Link_Step := False;
3548 -- Put all the sources in the queue
3550 Insert_Project_Sources
3551 (The_Project => Main_Project,
3552 All_Projects => Unique_Compile_All_Projects,
3555 -- If there are no sources to compile, we fail
3557 if Osint.Number_Of_Files = 0 then
3558 Make_Failed ("no sources to compile");
3563 -- The attribute Main is not an empty list.
3564 -- Put all the main subprograms in the list as if there
3565 -- were specified on the command line. However, if attribute
3566 -- Languages includes a language other than Ada, only
3567 -- include the Ada mains; if there is no Ada main, compile
3568 -- all the sources of the project.
3571 Data : Project_Data := Projects.Table (Main_Project);
3573 Languages : Variable_Value :=
3575 (Name_Languages, Data.Decl.Attributes);
3577 Current : String_List_Id;
3578 Element : String_Element;
3580 Foreign_Language : Boolean := False;
3581 At_Least_One_Main : Boolean := False;
3584 -- First, determine if there is a foreign language in
3585 -- attribute Languages.
3587 if not Languages.Default then
3588 Current := Languages.Values;
3591 while Current /= Nil_String loop
3592 Element := String_Elements.Table (Current);
3593 Get_Name_String (Element.Value);
3594 To_Lower (Name_Buffer (1 .. Name_Len));
3596 if Name_Buffer (1 .. Name_Len) /= "ada" then
3597 Foreign_Language := True;
3598 exit Look_For_Foreign;
3601 Current := Element.Next;
3602 end loop Look_For_Foreign;
3605 -- Then, find all mains, or if there is a foreign
3606 -- language, all the Ada mains.
3608 while Value /= Prj.Nil_String loop
3609 Get_Name_String (String_Elements.Table (Value).Value);
3611 -- To know if a main is an Ada main, get its project.
3612 -- It should be the project specified on the command
3615 if (not Foreign_Language) or else
3617 (Name_Buffer (1 .. Name_Len), Main_Project) =
3620 At_Least_One_Main := True;
3623 (String_Elements.Table (Value).Value));
3626 Value := String_Elements.Table (Value).Next;
3629 -- If we did not get any main, it means that all mains
3630 -- in attribute Mains are in a foreign language. So,
3631 -- we put all sources of the main project in the Q.
3633 if not At_Least_One_Main then
3635 -- First make sure that the binder and the linker
3636 -- will not be invoked if -z is not used.
3638 if not No_Main_Subprogram then
3639 Do_Bind_Step := False;
3640 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,
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");
3663 if Opt.Verbose_Mode then
3665 Write_Str ("GNATMAKE ");
3666 Write_Str (Gnatvsn.Gnat_Version_String);
3667 Write_Str (" Copyright 1995-2003 Free Software Foundation, Inc.");
3671 if Osint.Number_Of_Files = 0 then
3672 if Main_Project /= No_Project
3673 and then Projects.Table (Main_Project).Library
3676 and then not Projects.Table (Main_Project).Standalone_Library
3678 Make_Failed ("only stand-alone libraries may be bound");
3681 -- Add the default search directories to be able to find libgnat
3683 Osint.Add_Default_Search_Dirs;
3685 -- And bind and or link the library
3687 MLib.Prj.Build_Library
3688 (For_Project => Main_Project,
3689 Gnatbind => Gnatbind.all,
3690 Gnatbind_Path => Gnatbind_Path,
3692 Gcc_Path => Gcc_Path,
3695 Exit_Program (E_Success);
3698 -- Output usage information if no files to compile
3701 Exit_Program (E_Fatal);
3705 -- If -M was specified, behave as if -n was specified
3707 if Opt.List_Dependencies then
3708 Opt.Do_Not_Execute := True;
3711 -- Note that Osint.Next_Main_Source will always return the (possibly
3712 -- abbreviated file) without any directory information.
3714 Main_Source_File := Next_Main_Source;
3716 Add_Switch ("-I-", Binder, And_Save => True);
3717 Add_Switch ("-I-", Compiler, And_Save => True);
3719 if Main_Project = No_Project then
3720 if Opt.Look_In_Primary_Dir then
3724 Normalize_Directory_Name
3725 (Get_Primary_Src_Search_Directory.all).all,
3726 Compiler, Append_Switch => False,
3729 Add_Switch ("-aO" & Normalized_CWD,
3731 Append_Switch => False,
3736 -- If we use a project file, we have already checked that a main
3737 -- specified on the command line with directory information has the
3738 -- path name corresponding to a correct source in the project tree.
3739 -- So, we don't need the directory information to be taken into
3740 -- account by Find_File, and in fact it may lead to take the wrong
3741 -- sources for other compilation units, when there are extending
3744 Opt.Look_In_Primary_Dir := False;
3747 -- If the user wants a program without a main subprogram, add the
3748 -- appropriate switch to the binder.
3750 if Opt.No_Main_Subprogram then
3751 Add_Switch ("-z", Binder, And_Save => True);
3754 if Main_Project /= No_Project then
3756 if Projects.Table (Main_Project).Object_Directory = No_Name then
3757 Make_Failed ("no sources to compile");
3760 -- Change the current directory to the object directory of the main
3766 (Projects.Table (Main_Project).Object_Directory));
3769 when Directory_Error =>
3771 -- This should never happen. But, if it does, display the
3772 -- content of the parent directory of the obj dir.
3775 Parent : constant Dir_Name_Str :=
3778 (Projects.Table (Main_Project).Object_Directory));
3780 Str : String (1 .. 200);
3784 Write_Str ("Contents of directory """);
3791 Read (Dir, Str, Last);
3794 Write_Line (Str (1 .. Last));
3801 Write_Line ("(unexpected exception)");
3802 Write_Line (Exception_Information (X));
3804 if Is_Open (Dir) then
3809 Make_Failed ("unable to change working directory to """,
3811 (Projects.Table (Main_Project).Object_Directory),
3815 -- Source file lookups should be cached for efficiency.
3816 -- Source files are not supposed to change.
3818 Osint.Source_File_Data (Cache => True);
3820 -- Find the file name of the (first) main unit
3823 Main_Source_File_Name : constant String :=
3824 Get_Name_String (Main_Source_File);
3825 Main_Unit_File_Name : constant String :=
3826 Prj.Env.File_Name_Of_Library_Unit_Body
3827 (Name => Main_Source_File_Name,
3828 Project => Main_Project,
3829 Main_Project_Only =>
3830 not Unique_Compile);
3832 The_Packages : constant Package_Id :=
3833 Projects.Table (Main_Project).Decl.Packages;
3835 Builder_Package : constant Prj.Package_Id :=
3837 (Name => Name_Builder,
3838 In_Packages => The_Packages);
3840 Binder_Package : constant Prj.Package_Id :=
3842 (Name => Name_Binder,
3843 In_Packages => The_Packages);
3845 Linker_Package : constant Prj.Package_Id :=
3847 (Name => Name_Linker,
3848 In_Packages => The_Packages);
3851 -- We fail if we cannot find the main source file
3853 if Main_Unit_File_Name = "" then
3854 Make_Failed ('"' & Main_Source_File_Name,
3855 """ is not a unit of project ",
3856 Project_File_Name.all & ".");
3858 -- Remove any directory information from the main
3859 -- source file name.
3862 Pos : Natural := Main_Unit_File_Name'Last;
3866 exit when Pos < Main_Unit_File_Name'First or else
3867 Main_Unit_File_Name (Pos) = Directory_Separator;
3871 Name_Len := Main_Unit_File_Name'Last - Pos;
3873 Name_Buffer (1 .. Name_Len) :=
3875 (Pos + 1 .. Main_Unit_File_Name'Last);
3877 Main_Source_File := Name_Find;
3879 -- We only output the main source file if there is only one
3881 if Opt.Verbose_Mode and then Osint.Number_Of_Files = 1 then
3882 Write_Str ("Main source file: """);
3883 Write_Str (Main_Unit_File_Name
3884 (Pos + 1 .. Main_Unit_File_Name'Last));
3890 -- If there is a package Builder in the main project file, add
3891 -- the switches from it.
3893 if Builder_Package /= No_Package then
3895 -- If there is only one main, we attempt to get the gnatmake
3896 -- switches for this main (if any). If there are no specific
3897 -- switch for this particular main, get the general gnatmake
3898 -- switches (if any).
3900 if Osint.Number_Of_Files = 1 then
3901 if Opt.Verbose_Mode then
3902 Write_Str ("Adding gnatmake switches for """);
3903 Write_Str (Main_Unit_File_Name);
3908 (File_Name => Main_Unit_File_Name,
3909 The_Package => Builder_Package,
3913 -- If there are several mains, we always get the general
3914 -- gnatmake switches (if any).
3916 -- Warn the user, if necessary, so that he is not surprized
3917 -- that specific switches are not taken into account.
3920 Defaults : constant Variable_Value :=
3923 Attribute_Or_Array_Name => Name_Default_Switches,
3924 In_Package => Builder_Package);
3926 Switches : constant Array_Element_Id :=
3928 (Name => Name_Switches,
3930 Packages.Table (Builder_Package).Decl.Arrays);
3933 if Defaults /= Nil_Variable_Value then
3934 if (not Opt.Quiet_Output)
3935 and then Switches /= No_Array_Element
3938 ("Warning: using Builder'Default_Switches" &
3939 "(""Ada""), as there are several mains");
3942 -- As there is never a source with name " ", we are
3943 -- guaranteed to always get the general switches.
3947 The_Package => Builder_Package,
3950 elsif (not Opt.Quiet_Output)
3951 and then Switches /= No_Array_Element
3954 ("Warning: using no switches from package Builder," &
3955 " as there are several mains");
3961 Osint.Add_Default_Search_Dirs;
3963 -- Record the current last switch index for table Binder_Switches
3964 -- and Linker_Switches, so that these tables may be reset before
3965 -- for each main, before adding swiches from the project file
3966 -- and from the command line.
3968 Last_Binder_Switch := Binder_Switches.Last;
3969 Last_Linker_Switch := Linker_Switches.Last;
3973 -- Add binder switches from the project file for the first main
3975 if Do_Bind_Step and Binder_Package /= No_Package then
3976 if Opt.Verbose_Mode then
3977 Write_Str ("Adding binder switches for """);
3978 Write_Str (Main_Unit_File_Name);
3983 (File_Name => Main_Unit_File_Name,
3984 The_Package => Binder_Package,
3988 -- Add linker switches from the project file for the first main
3990 if Do_Link_Step and Linker_Package /= No_Package then
3991 if Opt.Verbose_Mode then
3992 Write_Str ("Adding linker switches for""");
3993 Write_Str (Main_Unit_File_Name);
3998 (File_Name => Main_Unit_File_Name,
3999 The_Package => Linker_Package,
4005 -- Get the target parameters, which are only needed for a couple of
4006 -- cases in gnatmake. Protect against an exception, such as the case
4007 -- of system.ads missing from the library, and fail gracefully.
4010 Targparm.Get_Target_Parameters;
4013 when Unrecoverable_Error =>
4014 Make_Failed ("*** make failed.");
4017 Display_Commands (not Opt.Quiet_Output);
4021 if Main_Project /= No_Project then
4023 -- For all library project, if the library file does not exist
4024 -- put all the project sources in the queue, and flag the project
4025 -- so that the library is generated.
4027 if MLib.Tgt.Support_For_Libraries /= MLib.Tgt.None then
4028 for Proj in Projects.First .. Projects.Last loop
4029 if Projects.Table (Proj).Library then
4030 Projects.Table (Proj).Flag1 :=
4031 not MLib.Tgt.Library_Exists_For (Proj);
4033 if Projects.Table (Proj).Flag1 then
4034 if Opt.Verbose_Mode then
4036 ("Library file does not exist for project """);
4038 (Get_Name_String (Projects.Table (Proj).Name));
4042 Insert_Project_Sources
4043 (The_Project => Proj,
4044 All_Projects => False,
4051 -- If a relative path output file has been specified, we add
4052 -- the exec directory.
4054 for J in reverse 1 .. Saved_Linker_Switches.Last - 1 loop
4055 if Saved_Linker_Switches.Table (J).all = Output_Flag.all then
4057 Exec_File_Name : constant String :=
4058 Saved_Linker_Switches.Table (J + 1).all;
4061 if not Is_Absolute_Path (Exec_File_Name) then
4062 for Index in Exec_File_Name'Range loop
4063 if Exec_File_Name (Index) = Directory_Separator then
4064 Make_Failed ("relative executable (""",
4066 """) with directory part not " &
4067 "allowed when using project files");
4071 Get_Name_String (Projects.Table
4072 (Main_Project).Exec_Directory);
4074 if Name_Buffer (Name_Len) /= Directory_Separator then
4075 Name_Len := Name_Len + 1;
4076 Name_Buffer (Name_Len) := Directory_Separator;
4079 Name_Buffer (Name_Len + 1 ..
4080 Name_Len + Exec_File_Name'Length) :=
4082 Name_Len := Name_Len + Exec_File_Name'Length;
4083 Saved_Linker_Switches.Table (J + 1) :=
4084 new String'(Name_Buffer (1 .. Name_Len));
4092 -- If we are using a project file, for relative paths we add the
4093 -- current working directory for any relative path on the command
4094 -- line and the project directory, for any relative path in the
4098 Dir_Path : constant String_Access :=
4099 new String'(Get_Name_String
4100 (Projects.Table (Main_Project).Directory));
4102 for J in 1 .. Binder_Switches.Last loop
4103 Test_If_Relative_Path
4104 (Binder_Switches.Table (J),
4105 Parent => Dir_Path, Including_L_Switch => False);
4108 for J in 1 .. Saved_Binder_Switches.Last loop
4109 Test_If_Relative_Path
4110 (Saved_Binder_Switches.Table (J),
4111 Parent => Current_Work_Dir, Including_L_Switch => False);
4114 for J in 1 .. Linker_Switches.Last loop
4115 Test_If_Relative_Path
4116 (Linker_Switches.Table (J), Parent => Dir_Path);
4119 for J in 1 .. Saved_Linker_Switches.Last loop
4120 Test_If_Relative_Path
4121 (Saved_Linker_Switches.Table (J), Parent => Current_Work_Dir);
4124 for J in 1 .. Gcc_Switches.Last loop
4125 Test_If_Relative_Path
4126 (Gcc_Switches.Table (J), Parent => Dir_Path);
4129 for J in 1 .. Saved_Gcc_Switches.Last loop
4130 Test_If_Relative_Path
4131 (Saved_Gcc_Switches.Table (J), Parent => Current_Work_Dir);
4136 -- We now put in the Binder_Switches and Linker_Switches tables,
4137 -- the binder and linker switches of the command line that have been
4138 -- put in the Saved_ tables. If a project file was used, then the
4139 -- command line switches will follow the project file switches.
4141 for J in 1 .. Saved_Binder_Switches.Last loop
4143 (Saved_Binder_Switches.Table (J),
4148 for J in 1 .. Saved_Linker_Switches.Last loop
4150 (Saved_Linker_Switches.Table (J),
4155 -- If no project file is used, we just put the gcc switches
4156 -- from the command line in the Gcc_Switches table.
4158 if Main_Project = No_Project then
4159 for J in 1 .. Saved_Gcc_Switches.Last loop
4161 (Saved_Gcc_Switches.Table (J),
4167 -- And we put the command line gcc switches in the variable
4168 -- The_Saved_Gcc_Switches. They are going to be used later
4169 -- in procedure Compile_Sources.
4171 The_Saved_Gcc_Switches :=
4172 new Argument_List (1 .. Saved_Gcc_Switches.Last + 1);
4174 for J in 1 .. Saved_Gcc_Switches.Last loop
4175 The_Saved_Gcc_Switches (J) := Saved_Gcc_Switches.Table (J);
4178 -- We never use gnat.adc when a project file is used
4180 The_Saved_Gcc_Switches (The_Saved_Gcc_Switches'Last) :=
4185 -- If there was a --GCC, --GNATBIND or --GNATLINK switch on
4186 -- the command line, then we have to use it, even if there was
4187 -- another switch in the project file.
4189 if Saved_Gcc /= null then
4193 if Saved_Gnatbind /= null then
4194 Gnatbind := Saved_Gnatbind;
4197 if Saved_Gnatlink /= null then
4198 Gnatlink := Saved_Gnatlink;
4201 Gcc_Path := GNAT.OS_Lib.Locate_Exec_On_Path (Gcc.all);
4202 Gnatbind_Path := GNAT.OS_Lib.Locate_Exec_On_Path (Gnatbind.all);
4203 Gnatlink_Path := GNAT.OS_Lib.Locate_Exec_On_Path (Gnatlink.all);
4205 -- If we have specified -j switch both from the project file
4206 -- and on the command line, the one from the command line takes
4209 if Saved_Maximum_Processes = 0 then
4210 Saved_Maximum_Processes := Opt.Maximum_Processes;
4213 -- Allocate as many temporary mapping file names as the maximum
4214 -- number of compilation processed, for each possible project.
4216 The_Mapping_File_Names :=
4218 (No_Project .. Projects.Last, 1 .. Saved_Maximum_Processes);
4219 Last_Mapping_File_Names :=
4220 new Indices'(No_Project .. Projects.Last => 0);
4222 The_Free_Mapping_File_Indices :=
4223 new Free_File_Indices
4224 (No_Project .. Projects.Last, 1 .. Saved_Maximum_Processes);
4225 Last_Free_Indices :=
4226 new Indices'(No_Project .. Projects.Last => 0);
4228 Bad_Compilation.Init;
4230 -- Here is where the make process is started
4232 -- We do the same process for each main
4234 Multiple_Main_Loop : for N_File in 1 .. Osint.Number_Of_Files loop
4236 -- Increase the marking label to be sure to check sources
4237 -- for all executables.
4239 Marking_Label := Marking_Label + 1;
4241 -- Make sure it is not 0, which is the default value for
4242 -- a file that has never been marked.
4244 if Marking_Label = 0 then
4248 -- First, find the executable name and path
4250 Executable := No_File;
4251 Executable_Obsolete := False;
4252 Non_Std_Executable := False;
4254 -- Look inside the linker switches to see if the name
4255 -- of the final executable program was specified.
4258 J in reverse Linker_Switches.First .. Linker_Switches.Last
4260 if Linker_Switches.Table (J).all = Output_Flag.all then
4261 pragma Assert (J < Linker_Switches.Last);
4263 -- We cannot specify a single executable for several
4264 -- main subprograms!
4266 if Osint.Number_Of_Files > 1 then
4268 ("cannot specify a single executable " &
4269 "for several mains");
4272 Name_Len := Linker_Switches.Table (J + 1)'Length;
4273 Name_Buffer (1 .. Name_Len) :=
4274 Linker_Switches.Table (J + 1).all;
4276 -- Put in canonical case to detect suffixs such as ".EXE" on
4279 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
4281 -- If target has an executable suffix and it has not been
4282 -- specified then it is added here.
4284 if Executable_Suffix'Length /= 0
4285 and then Name_Buffer
4286 (Name_Len - Executable_Suffix'Length + 1 .. Name_Len)
4287 /= Executable_Suffix
4289 -- Get back the original name to keep the case on Windows
4291 Name_Buffer (1 .. Name_Len) :=
4292 Linker_Switches.Table (J + 1).all;
4294 -- Add the executable suffix
4296 Name_Buffer (Name_Len + 1 ..
4297 Name_Len + Executable_Suffix'Length) :=
4299 Name_Len := Name_Len + Executable_Suffix'Length;
4302 -- Get back the original name to keep the case on Windows
4304 Name_Buffer (1 .. Name_Len) :=
4305 Linker_Switches.Table (J + 1).all;
4308 Executable := Name_Enter;
4310 Verbose_Msg (Executable, "final executable");
4314 -- If the name of the final executable program was not
4315 -- specified then construct it from the main input file.
4317 if Executable = No_File then
4318 if Main_Project = No_Project then
4320 Executable_Name (Strip_Suffix (Main_Source_File));
4323 -- If we are using a project file, we attempt to
4324 -- remove the body (or spec) termination of the main
4325 -- subprogram. We find it the the naming scheme of the
4326 -- project file. This will avoid to generate an
4327 -- executable "main.2" for a main subprogram
4328 -- "main.2.ada", when the body termination is ".2.ada".
4330 Executable := Prj.Util.Executable_Of
4331 (Main_Project, Main_Source_File);
4335 if Main_Project /= No_Project then
4337 Exec_File_Name : constant String :=
4338 Get_Name_String (Executable);
4341 if not Is_Absolute_Path (Exec_File_Name) then
4342 for Index in Exec_File_Name'Range loop
4343 if Exec_File_Name (Index) = Directory_Separator then
4344 Make_Failed ("relative executable (""",
4346 """) with directory part not " &
4347 "allowed when using project files");
4351 Get_Name_String (Projects.Table
4352 (Main_Project).Exec_Directory);
4355 Name_Buffer (Name_Len) /= Directory_Separator
4357 Name_Len := Name_Len + 1;
4358 Name_Buffer (Name_Len) := Directory_Separator;
4361 Name_Buffer (Name_Len + 1 ..
4362 Name_Len + Exec_File_Name'Length) :=
4364 Name_Len := Name_Len + Exec_File_Name'Length;
4365 Executable := Name_Find;
4366 Non_Std_Executable := True;
4372 if Do_Compile_Step then
4373 Recursive_Compilation_Step : declare
4374 Args : Argument_List (1 .. Gcc_Switches.Last);
4376 First_Compiled_File : Name_Id;
4377 Youngest_Obj_File : Name_Id;
4378 Youngest_Obj_Stamp : Time_Stamp_Type;
4380 Executable_Stamp : Time_Stamp_Type;
4381 -- Executable is the final executable program.
4383 Library_Rebuilt : Boolean := False;
4386 for J in 1 .. Gcc_Switches.Last loop
4387 Args (J) := Gcc_Switches.Table (J);
4390 -- Now we invoke Compile_Sources for the current main
4393 (Main_Source => Main_Source_File,
4395 First_Compiled_File => First_Compiled_File,
4396 Most_Recent_Obj_File => Youngest_Obj_File,
4397 Most_Recent_Obj_Stamp => Youngest_Obj_Stamp,
4398 Main_Unit => Is_Main_Unit,
4399 Compilation_Failures => Compilation_Failures,
4400 Check_Readonly_Files => Opt.Check_Readonly_Files,
4401 Do_Not_Execute => Opt.Do_Not_Execute,
4402 Force_Compilations => Opt.Force_Compilations,
4403 In_Place_Mode => Opt.In_Place_Mode,
4404 Keep_Going => Opt.Keep_Going,
4405 Initialize_ALI_Data => True,
4406 Max_Process => Saved_Maximum_Processes);
4408 if Opt.Verbose_Mode then
4409 Write_Str ("End of compilation");
4413 -- Make sure the queue will be reinitialized for the next round
4415 First_Q_Initialization := True;
4417 Total_Compilation_Failures :=
4418 Total_Compilation_Failures + Compilation_Failures;
4420 if Total_Compilation_Failures /= 0 then
4421 if Opt.Keep_Going then
4425 List_Bad_Compilations;
4426 raise Compilation_Failed;
4430 -- Regenerate libraries, if any, and if object files
4431 -- have been regenerated.
4433 if Main_Project /= No_Project
4434 and then MLib.Tgt.Support_For_Libraries /= MLib.Tgt.None
4435 and then (Do_Bind_Step or Unique_Compile_All_Projects
4436 or not Compile_Only)
4437 and then (Do_Link_Step or N_File = Osint.Number_Of_Files)
4447 -- Put in Library_Projs table all library project
4448 -- file ids when the library need to be rebuilt.
4450 for Proj1 in Projects.First .. Projects.Last loop
4452 if Projects.Table (Proj1).Library
4453 and then not Projects.Table (Proj1).Flag1
4455 MLib.Prj.Check_Library (Proj1);
4458 if Projects.Table (Proj1).Flag1 then
4459 Library_Projs.Increment_Last;
4460 Current := Library_Projs.Last;
4461 Depth := Projects.Table (Proj1).Depth;
4463 -- Put the projects in decreasing depth order,
4464 -- so that if libA depends on libB, libB is first
4467 while Current > 1 loop
4468 Proj2 := Library_Projs.Table (Current - 1);
4469 exit when Projects.Table (Proj2).Depth >= Depth;
4470 Library_Projs.Table (Current) := Proj2;
4471 Current := Current - 1;
4474 Library_Projs.Table (Current) := Proj1;
4475 Projects.Table (Proj1).Flag1 := False;
4480 -- Build the libraries, if any need to be built
4482 for J in 1 .. Library_Projs.Last loop
4483 Library_Rebuilt := True;
4484 MLib.Prj.Build_Library
4485 (For_Project => Library_Projs.Table (J),
4486 Gnatbind => Gnatbind.all,
4487 Gnatbind_Path => Gnatbind_Path,
4489 Gcc_Path => Gcc_Path);
4493 if Opt.List_Dependencies then
4494 if First_Compiled_File /= No_File then
4496 (First_Compiled_File,
4497 "must be recompiled. Can't generate dependence list.");
4502 elsif First_Compiled_File = No_File
4503 and then not Do_Bind_Step
4504 and then not Opt.Quiet_Output
4505 and then not Library_Rebuilt
4506 and then Osint.Number_Of_Files = 1
4508 Inform (Msg => "objects up to date.");
4510 elsif Opt.Do_Not_Execute
4511 and then First_Compiled_File /= No_File
4513 Write_Name (First_Compiled_File);
4517 -- Stop after compile step if any of:
4519 -- 1) -n (Do_Not_Execute) specified
4521 -- 2) -M (List_Dependencies) specified (also sets
4522 -- Do_Not_Execute above, so this is probably superfluous).
4524 -- 3) -c (Compile_Only) specified, but not -b (Bind_Only)
4526 -- 4) Made unit cannot be a main unit
4528 if (Opt.Do_Not_Execute
4529 or Opt.List_Dependencies
4531 or not Is_Main_Unit)
4532 and then not No_Main_Subprogram
4534 if Osint.Number_Of_Files = 1 then
4535 exit Multiple_Main_Loop;
4542 -- If the objects were up-to-date check if the executable file
4543 -- is also up-to-date. For now always bind and link on the JVM
4544 -- since there is currently no simple way to check the
4545 -- up-to-date status of objects
4547 if not Hostparm.Java_VM
4548 and then First_Compiled_File = No_File
4550 Executable_Stamp := File_Stamp (Executable);
4552 if not Executable_Obsolete then
4553 Executable_Obsolete :=
4554 Youngest_Obj_Stamp > Executable_Stamp;
4557 if not Executable_Obsolete then
4558 for Index in reverse 1 .. Dependencies.Last loop
4560 (Dependencies.Table (Index).Depends_On)
4562 Enter_Into_Obsoleted
4563 (Dependencies.Table (Index).This);
4567 Executable_Obsolete := Is_In_Obsoleted (Main_Source_File);
4571 if not Executable_Obsolete then
4573 -- If no Ada object files obsolete the executable, check
4574 -- for younger or missing linker files.
4576 Check_Linker_Options
4579 Youngest_Obj_Stamp);
4581 Executable_Obsolete := Youngest_Obj_File /= No_File;
4584 -- Return if the executable is up to date
4585 -- and otherwise motivate the relink/rebind.
4587 if not Executable_Obsolete then
4588 if not Opt.Quiet_Output then
4589 Inform (Executable, "up to date.");
4592 if Osint.Number_Of_Files = 1 then
4593 exit Multiple_Main_Loop;
4600 if Executable_Stamp (1) = ' ' then
4601 Verbose_Msg (Executable, "missing.", Prefix => " ");
4603 elsif Youngest_Obj_Stamp (1) = ' ' then
4609 elsif Youngest_Obj_Stamp > Executable_Stamp then
4612 "(" & String (Youngest_Obj_Stamp) & ") newer than",
4614 "(" & String (Executable_Stamp) & ")");
4618 (Executable, "needs to be rebuild.",
4623 end Recursive_Compilation_Step;
4626 -- If we are here, it means that we need to rebuilt the current
4627 -- main. So we set Executable_Obsolete to True to make sure that
4628 -- the subsequent mains will be rebuilt.
4630 Main_ALI_In_Place_Mode_Step : declare
4631 ALI_File : File_Name_Type;
4632 Src_File : File_Name_Type;
4635 Src_File := Strip_Directory (Main_Source_File);
4636 ALI_File := Lib_File_Name (Src_File);
4637 Main_ALI_File := Full_Lib_File_Name (ALI_File);
4639 -- When In_Place_Mode, the library file can be located in the
4640 -- Main_Source_File directory which may not be present in the
4641 -- library path. In this case, use the corresponding library file
4644 if Main_ALI_File = No_File and then Opt.In_Place_Mode then
4645 Get_Name_String (Get_Directory (Full_Source_Name (Src_File)));
4646 Get_Name_String_And_Append (ALI_File);
4647 Main_ALI_File := Name_Find;
4648 Main_ALI_File := Full_Lib_File_Name (Main_ALI_File);
4651 if Main_ALI_File = No_File then
4652 Make_Failed ("could not find the main ALI file");
4654 end Main_ALI_In_Place_Mode_Step;
4656 if Do_Bind_Step then
4658 Args : Argument_List
4659 (Binder_Switches.First .. Binder_Switches.Last + 1);
4660 -- The arguments for the invocation of gnatbind
4662 Last_Arg : Natural := Binder_Switches.Last;
4663 -- Index of the last argument in Args
4665 Mapping_FD : File_Descriptor := Invalid_FD;
4666 -- A File Descriptor for an eventual mapping file
4668 Mapping_Path : Name_Id := No_Name;
4669 -- The path name of the mapping file
4671 ALI_Unit : Name_Id := No_Name;
4672 -- The unit name of an ALI file
4674 ALI_Name : Name_Id := No_Name;
4675 -- The file name of the ALI file
4677 ALI_Project : Project_Id := No_Project;
4678 -- The project of the ALI file
4681 OK : Boolean := True;
4684 -- For call to Close
4687 -- If it is the first time the bind step is performed,
4688 -- check if there are shared libraries, so that gnatbind is
4689 -- called with -shared.
4691 if not Bind_Shared_Known then
4692 if Main_Project /= No_Project
4693 and then MLib.Tgt.Support_For_Libraries /= MLib.Tgt.None
4695 for Proj in Projects.First .. Projects.Last loop
4696 if Projects.Table (Proj).Library and then
4697 Projects.Table (Proj).Library_Kind /= Static
4699 Bind_Shared := Shared_Switch'Access;
4705 Bind_Shared_Known := True;
4708 -- Get all the binder switches
4710 for J in Binder_Switches.First .. Last_Arg loop
4711 Args (J) := Binder_Switches.Table (J);
4714 if Main_Project /= No_Project then
4716 -- Put all the source directories in ADA_INCLUDE_PATH,
4717 -- and all the object directories in ADA_OBJECTS_PATH
4719 Prj.Env.Set_Ada_Paths (Main_Project, False);
4721 -- If switch -C was specified, create a binder mapping file
4723 if Create_Mapping_File then
4724 Tempdir.Create_Temp_File (Mapping_FD, Mapping_Path);
4726 if Mapping_FD /= Invalid_FD then
4728 -- Traverse all units
4730 for J in Prj.Com.Units.First .. Prj.Com.Units.Last loop
4732 Unit : constant Prj.Com.Unit_Data :=
4733 Prj.Com.Units.Table (J);
4737 if Unit.Name /= No_Name then
4739 -- If there is a body, put it in the mapping
4741 if Unit.File_Names (Body_Part).Name /= No_Name
4742 and then Unit.File_Names (Body_Part).Project
4745 Get_Name_String (Unit.Name);
4747 (Name_Len + 1 .. Name_Len + 2) := "%b";
4748 Name_Len := Name_Len + 2;
4749 ALI_Unit := Name_Find;
4752 (Unit.File_Names (Body_Part).Name);
4754 Unit.File_Names (Body_Part).Project;
4756 -- Otherwise, if there is a spec, put it
4759 elsif Unit.File_Names (Specification).Name
4761 and then Unit.File_Names
4762 (Specification).Project
4765 Get_Name_String (Unit.Name);
4767 (Name_Len + 1 .. Name_Len + 2) := "%s";
4768 Name_Len := Name_Len + 2;
4769 ALI_Unit := Name_Find;
4770 ALI_Name := Lib_File_Name
4771 (Unit.File_Names (Specification).Name);
4773 Unit.File_Names (Specification).Project;
4776 ALI_Name := No_Name;
4779 -- If we have something to put in the mapping
4780 -- then we do it now. However, if the project
4781 -- is extended, we don't put anything in the
4782 -- mapping file, because we do not know where
4783 -- the ALI file is: it might be in the ext-
4784 -- ended project obj dir as well as in the
4785 -- extending project obj dir.
4787 if ALI_Name /= No_Name
4788 and then Projects.Table
4789 (ALI_Project).Extended_By
4791 and then Projects.Table
4792 (ALI_Project).Extends
4795 -- First line is the unit name
4797 Get_Name_String (ALI_Unit);
4798 Name_Len := Name_Len + 1;
4799 Name_Buffer (Name_Len) := ASCII.LF;
4803 Name_Buffer (1)'Address,
4805 OK := Bytes = Name_Len;
4809 -- Second line it the ALI file name
4811 Get_Name_String (ALI_Name);
4812 Name_Len := Name_Len + 1;
4813 Name_Buffer (Name_Len) := ASCII.LF;
4817 Name_Buffer (1)'Address,
4819 OK := Bytes = Name_Len;
4824 -- Third line it the ALI path name,
4825 -- concatenation of the project
4826 -- directory with the ALI file name.
4829 ALI : constant String :=
4830 Get_Name_String (ALI_Name);
4833 (Projects.Table (ALI_Project).
4836 if Name_Buffer (Name_Len) /=
4839 Name_Len := Name_Len + 1;
4840 Name_Buffer (Name_Len) :=
4841 Directory_Separator;
4846 Name_Len + ALI'Length) := ALI;
4848 Name_Len + ALI'Length + 1;
4849 Name_Buffer (Name_Len) := ASCII.LF;
4853 Name_Buffer (1)'Address,
4855 OK := Bytes = Name_Len;
4859 -- If OK is False, it means we were unable
4860 -- to write a line. No point in continuing
4861 -- with the other units.
4869 Close (Mapping_FD, Status);
4871 OK := OK and Status;
4873 -- If the creation of the mapping file was successful,
4874 -- we add the switch to the arguments of gnatbind.
4877 Last_Arg := Last_Arg + 1;
4878 Args (Last_Arg) := new String'
4879 ("-F=" & Get_Name_String (Mapping_Path));
4887 Bind (Main_ALI_File,
4888 Bind_Shared.all & Args (Args'First .. Last_Arg));
4893 -- If -dn was not specified, delete the temporary mapping
4894 -- file, if one was created.
4896 if not Debug.Debug_Flag_N
4897 and then Mapping_Path /= No_Name
4899 Delete_File (Get_Name_String (Mapping_Path), OK);
4902 -- And reraise the exception
4907 -- If -dn was not specified, delete the temporary mapping file,
4908 -- if one was created.
4910 if not Debug.Debug_Flag_N and then Mapping_Path /= No_Name then
4911 Delete_File (Get_Name_String (Mapping_Path), OK);
4916 if Do_Link_Step then
4918 There_Are_Libraries : Boolean := False;
4919 Linker_Switches_Last : constant Integer := Linker_Switches.Last;
4920 Path_Option : constant String_Access :=
4921 MLib.Tgt.Linker_Library_Path_Option;
4927 if not Run_Path_Option then
4928 Linker_Switches.Increment_Last;
4929 Linker_Switches.Table (Linker_Switches.Last) :=
4933 if Main_Project /= No_Project then
4934 Library_Paths.Set_Last (0);
4937 if MLib.Tgt.Support_For_Libraries /= MLib.Tgt.None then
4938 -- Check for library projects
4940 for Proj1 in 1 .. Projects.Last loop
4941 if Proj1 /= Main_Project
4942 and then Projects.Table (Proj1).Library
4944 -- Add this project to table Library_Projs
4946 There_Are_Libraries := True;
4947 Depth := Projects.Table (Proj1).Depth;
4948 Library_Projs.Increment_Last;
4949 Current := Library_Projs.Last;
4951 -- Any project with a greater depth should be
4952 -- after this project in the list.
4954 while Current > 1 loop
4955 Proj2 := Library_Projs.Table (Current - 1);
4956 exit when Projects.Table (Proj2).Depth <= Depth;
4957 Library_Projs.Table (Current) := Proj2;
4958 Current := Current - 1;
4961 Library_Projs.Table (Current) := Proj1;
4963 -- If it is not a static library and path option
4964 -- is set, add it to the Library_Paths table.
4966 if Projects.Table (Proj1).Library_Kind /= Static
4967 and then Path_Option /= null
4969 Library_Paths.Increment_Last;
4970 Library_Paths.Table (Library_Paths.Last) :=
4973 (Projects.Table (Proj1).Library_Dir));
4978 for Index in 1 .. Library_Projs.Last loop
4979 -- Add the -L switch
4981 Linker_Switches.Increment_Last;
4982 Linker_Switches.Table (Linker_Switches.Last) :=
4986 (Library_Projs.Table (Index)).
4989 -- Add the -l switch
4991 Linker_Switches.Increment_Last;
4992 Linker_Switches.Table (Linker_Switches.Last) :=
4996 (Library_Projs.Table (Index)).
5001 if There_Are_Libraries then
5003 -- If Path_Option is not null, create the switch
5004 -- ("-Wl,-rpath," or equivalent) with all the non static
5005 -- library dirs plus the standard GNAT library dir.
5006 -- We do that only if Run_Path_Option is True
5007 -- (not disabled by -R switch).
5009 if Run_Path_Option and Path_Option /= null then
5011 Option : String_Access;
5012 Length : Natural := Path_Option'Length;
5017 Library_Paths.First .. Library_Paths.Last
5019 -- Add the length of the library dir plus one
5020 -- for the directory separator.
5024 Library_Paths.Table (Index)'Length + 1;
5027 -- Finally, add the length of the standard GNAT
5030 Length := Length + MLib.Utl.Lib_Directory'Length;
5031 Option := new String (1 .. Length);
5032 Option (1 .. Path_Option'Length) := Path_Option.all;
5033 Current := Path_Option'Length;
5035 -- Put each library dir followed by a dir separator
5038 Library_Paths.First .. Library_Paths.Last
5043 Library_Paths.Table (Index)'Length) :=
5044 Library_Paths.Table (Index).all;
5047 Library_Paths.Table (Index)'Length + 1;
5048 Option (Current) := Path_Separator;
5051 -- Finally put the standard GNAT library dir
5055 Current + MLib.Utl.Lib_Directory'Length) :=
5056 MLib.Utl.Lib_Directory;
5058 -- And add the switch to the linker switches
5060 Linker_Switches.Increment_Last;
5061 Linker_Switches.Table (Linker_Switches.Last) :=
5068 -- Put the object directories in ADA_OBJECTS_PATH
5070 Prj.Env.Set_Ada_Paths (Main_Project, False);
5072 -- Check for attributes Linker'Linker_Options in projects
5073 -- other than the main project
5076 Linker_Package : Package_Id;
5077 Options : Variable_Value;
5082 for Index in 1 .. Projects.Last loop
5083 if Index /= Main_Project then
5086 (Name => Name_Linker,
5088 Projects.Table (Index).Decl.Packages);
5092 Attribute_Or_Array_Name => Name_Linker_Options,
5093 In_Package => Linker_Package);
5095 -- If attribute is present, add the project with
5096 -- the attribute to table Linker_Opts.
5098 if Options /= Nil_Variable_Value then
5099 Linker_Opts.Increment_Last;
5100 Linker_Opts.Table (Linker_Opts.Last) :=
5101 (Project => Index, Options => Options.Values);
5108 Opt1 : Linker_Options_Data;
5109 Opt2 : Linker_Options_Data;
5111 Options : String_List_Id;
5114 -- Sort the project by increasing depths
5116 for Index in 1 .. Linker_Opts.Last loop
5117 Opt1 := Linker_Opts.Table (Index);
5118 Depth := Projects.Table (Opt1.Project).Depth;
5120 for J in Index + 1 .. Linker_Opts.Last loop
5121 Opt2 := Linker_Opts.Table (J);
5124 Projects.Table (Opt2.Project).Depth < Depth
5126 Linker_Opts.Table (Index) := Opt2;
5127 Linker_Opts.Table (J) := Opt1;
5130 Projects.Table (Opt1.Project).Depth;
5134 -- If Dir_Path has not been computed for this project,
5137 if Projects.Table (Opt1.Project).Dir_Path = null then
5138 Projects.Table (Opt1.Project).Dir_Path :=
5141 (Projects.Table (Opt1.Project). Directory));
5144 Options := Opt1.Options;
5146 -- Add each of the options to the linker switches
5148 while Options /= Nil_String loop
5149 Option := String_Elements.Table (Options).Value;
5150 Options := String_Elements.Table (Options).Next;
5151 Linker_Switches.Increment_Last;
5152 Linker_Switches.Table (Linker_Switches.Last) :=
5153 new String'(Get_Name_String (Option));
5155 -- Object files and -L switches specified with
5156 -- relative paths and must be converted to
5159 Test_If_Relative_Path
5161 Linker_Switches.Table (Linker_Switches.Last),
5162 Parent => Projects.Table (Opt1.Project).Dir_Path,
5163 Including_L_Switch => True);
5170 Args : Argument_List
5171 (Linker_Switches.First .. Linker_Switches.Last + 2);
5173 Last_Arg : Integer := Linker_Switches.First - 1;
5174 Skip : Boolean := False;
5177 -- Get all the linker switches
5179 for J in Linker_Switches.First .. Linker_Switches.Last loop
5183 elsif Non_Std_Executable
5184 and then Linker_Switches.Table (J).all = "-o"
5189 Last_Arg := Last_Arg + 1;
5190 Args (Last_Arg) := Linker_Switches.Table (J);
5194 -- If need be, add the -o switch
5196 if Non_Std_Executable then
5197 Last_Arg := Last_Arg + 1;
5198 Args (Last_Arg) := new String'("-o");
5199 Last_Arg := Last_Arg + 1;
5201 new String'(Get_Name_String (Executable));
5204 -- And invoke the linker
5207 Link (Main_ALI_File, Args (Args'First .. Last_Arg));
5208 Successful_Links.Increment_Last;
5209 Successful_Links.Table (Successful_Links.Last) :=
5214 if Osint.Number_Of_Files = 1 or not Opt.Keep_Going then
5218 Write_Line ("*** link failed");
5219 Failed_Links.Increment_Last;
5220 Failed_Links.Table (Failed_Links.Last) :=
5226 Linker_Switches.Set_Last (Linker_Switches_Last);
5230 -- We go to here when we skip the bind and link steps.
5234 -- We go to the next main, if we did not process the last one
5236 if N_File < Osint.Number_Of_Files then
5237 Main_Source_File := Next_Main_Source;
5239 if Main_Project /= No_Project then
5241 -- Find the file name of the main unit
5244 Main_Source_File_Name : constant String :=
5245 Get_Name_String (Main_Source_File);
5247 Main_Unit_File_Name : constant String :=
5249 File_Name_Of_Library_Unit_Body
5250 (Name => Main_Source_File_Name,
5251 Project => Main_Project,
5252 Main_Project_Only =>
5253 not Unique_Compile);
5255 The_Packages : constant Package_Id :=
5256 Projects.Table (Main_Project).Decl.Packages;
5258 Binder_Package : constant Prj.Package_Id :=
5260 (Name => Name_Binder,
5261 In_Packages => The_Packages);
5263 Linker_Package : constant Prj.Package_Id :=
5265 (Name => Name_Linker,
5266 In_Packages => The_Packages);
5269 -- We fail if we cannot find the main source file
5270 -- as an immediate source of the main project file.
5272 if Main_Unit_File_Name = "" then
5273 Make_Failed ('"' & Main_Source_File_Name,
5274 """ is not a unit of project ",
5275 Project_File_Name.all & ".");
5278 -- Remove any directory information from the main
5279 -- source file name.
5282 Pos : Natural := Main_Unit_File_Name'Last;
5286 exit when Pos < Main_Unit_File_Name'First
5288 Main_Unit_File_Name (Pos) = Directory_Separator;
5292 Name_Len := Main_Unit_File_Name'Last - Pos;
5294 Name_Buffer (1 .. Name_Len) :=
5296 (Pos + 1 .. Main_Unit_File_Name'Last);
5298 Main_Source_File := Name_Find;
5302 -- We now deal with the binder and linker switches.
5303 -- If no project file is used, there is nothing to do
5304 -- because the binder and linker switches are the same
5307 -- Reset the tables Binder_Switches and Linker_Switches
5309 Binder_Switches.Set_Last (Last_Binder_Switch);
5310 Linker_Switches.Set_Last (Last_Linker_Switch);
5312 -- Add binder switches from the project file for this main,
5315 if Do_Bind_Step and Binder_Package /= No_Package then
5316 if Opt.Verbose_Mode then
5317 Write_Str ("Adding binder switches for """);
5318 Write_Str (Main_Unit_File_Name);
5323 (File_Name => Main_Unit_File_Name,
5324 The_Package => Binder_Package,
5328 -- Add linker switches from the project file for this main,
5331 if Do_Link_Step and Linker_Package /= No_Package then
5332 if Opt.Verbose_Mode then
5333 Write_Str ("Adding linker switches for""");
5334 Write_Str (Main_Unit_File_Name);
5339 (File_Name => Main_Unit_File_Name,
5340 The_Package => Linker_Package,
5344 -- As we are using a project file, for relative paths we add
5345 -- the current working directory for any relative path on
5346 -- the command line and the project directory, for any
5347 -- relative path in the project file.
5350 Dir_Path : constant String_Access :=
5351 new String'(Get_Name_String
5352 (Projects.Table (Main_Project).Directory));
5355 J in Last_Binder_Switch + 1 .. Binder_Switches.Last
5357 Test_If_Relative_Path
5358 (Binder_Switches.Table (J),
5359 Parent => Dir_Path, Including_L_Switch => False);
5363 J in Last_Linker_Switch + 1 .. Linker_Switches.Last
5365 Test_If_Relative_Path
5366 (Linker_Switches.Table (J), Parent => Dir_Path);
5370 -- We now put in the Binder_Switches and Linker_Switches
5371 -- tables, the binder and linker switches of the command
5372 -- line that have been put in the Saved_ tables.
5373 -- These switches will follow the project file switches.
5375 for J in 1 .. Saved_Binder_Switches.Last loop
5377 (Saved_Binder_Switches.Table (J),
5382 for J in 1 .. Saved_Linker_Switches.Last loop
5384 (Saved_Linker_Switches.Table (J),
5391 end loop Multiple_Main_Loop;
5393 if Failed_Links.Last > 0 then
5394 for Index in 1 .. Successful_Links.Last loop
5395 Write_Str ("Linking of """);
5396 Write_Str (Get_Name_String (Successful_Links.Table (Index)));
5397 Write_Line (""" succeeded.");
5400 for Index in 1 .. Failed_Links.Last loop
5401 Write_Str ("Linking of """);
5402 Write_Str (Get_Name_String (Failed_Links.Table (Index)));
5403 Write_Line (""" failed.");
5406 if Total_Compilation_Failures = 0 then
5407 raise Compilation_Failed;
5411 if Total_Compilation_Failures /= 0 then
5412 List_Bad_Compilations;
5413 raise Compilation_Failed;
5416 -- Delete the temporary mapping file that was created if we are
5417 -- using project files.
5419 if not Debug.Debug_Flag_N then
5420 Delete_Mapping_Files;
5421 Prj.Env.Delete_All_Path_Files;
5424 Exit_Program (E_Success);
5428 Make_Failed ("*** bind failed.");
5430 when Compilation_Failed =>
5431 if not Debug.Debug_Flag_N then
5432 Delete_Mapping_Files;
5433 Prj.Env.Delete_All_Path_Files;
5436 Exit_Program (E_Fatal);
5439 Make_Failed ("*** link failed.");
5442 Write_Line (Exception_Information (X));
5443 Make_Failed ("INTERNAL ERROR. Please report.");
5451 function Hash (F : Name_Id) return Header_Num is
5453 return Header_Num (1 + F mod Max_Header);
5456 --------------------
5457 -- In_Ada_Lib_Dir --
5458 --------------------
5460 function In_Ada_Lib_Dir (File : File_Name_Type) return Boolean is
5461 D : constant Name_Id := Get_Directory (File);
5462 B : constant Byte := Get_Name_Table_Byte (D);
5465 return (B and Ada_Lib_Dir) /= 0;
5472 procedure Inform (N : Name_Id := No_Name; Msg : String) is
5474 Osint.Write_Program_Name;
5478 if N /= No_Name then
5488 -----------------------
5489 -- Init_Mapping_File --
5490 -----------------------
5492 procedure Init_Mapping_File
5493 (Project : Project_Id;
5494 File_Index : in out Natural)
5496 FD : File_Descriptor;
5499 -- For call to Close
5502 -- Increase the index of the last mapping file for this project
5504 Last_Mapping_File_Names (Project) :=
5505 Last_Mapping_File_Names (Project) + 1;
5507 -- If there is a project file, call Create_Mapping_File with
5510 if Project /= No_Project then
5511 Prj.Env.Create_Mapping_File
5513 The_Mapping_File_Names
5514 (Project, Last_Mapping_File_Names (Project)));
5516 -- Otherwise, just create an empty file
5519 Tempdir.Create_Temp_File
5521 The_Mapping_File_Names
5522 (No_Project, Last_Mapping_File_Names (No_Project)));
5523 if FD = Invalid_FD then
5524 Make_Failed ("disk full");
5530 Make_Failed ("disk full");
5534 -- And return the index of the newly created file
5536 File_Index := Last_Mapping_File_Names (Project);
5537 end Init_Mapping_File;
5545 First_Q_Initialization := False;
5547 Q.Set_Last (Q.First);
5554 procedure Initialize is
5555 Next_Arg : Positive;
5558 -- Override default initialization of Check_Object_Consistency
5559 -- since this is normally False for GNATBIND, but is True for
5560 -- GNATMAKE since we do not need to check source consistency
5561 -- again once GNATMAKE has looked at the sources to check.
5563 Opt.Check_Object_Consistency := True;
5565 -- Package initializations. The order of calls is important here.
5567 Output.Set_Standard_Error;
5570 Binder_Switches.Init;
5571 Linker_Switches.Init;
5582 RTS_Specified := null;
5587 Scan_Args : while Next_Arg <= Argument_Count loop
5588 Scan_Make_Arg (Argument (Next_Arg), And_Save => True);
5589 Next_Arg := Next_Arg + 1;
5592 if Usage_Requested then
5596 -- Test for trailing -P switch
5598 if Project_File_Name_Present and then Project_File_Name = null then
5599 Make_Failed ("project file name missing after -P");
5601 -- Test for trailing -o switch
5603 elsif Opt.Output_File_Name_Present
5604 and then not Output_File_Name_Seen
5606 Make_Failed ("output file name missing after -o");
5608 -- Test for trailing -D switch
5610 elsif Opt.Object_Directory_Present
5611 and then not Object_Directory_Seen then
5612 Make_Failed ("object directory missing after -D");
5615 -- Test for simultaneity of -i and -D
5617 if Object_Directory_Path /= null and then In_Place_Mode then
5618 Make_Failed ("-i and -D cannot be used simutaneously");
5621 -- Deal with -C= switch
5623 if Gnatmake_Mapping_File /= null then
5624 -- First, check compatibility with other switches
5626 if Project_File_Name /= null then
5627 Make_Failed ("-C= switch is not compatible with -P switch");
5629 elsif Saved_Maximum_Processes > 1 then
5630 Make_Failed ("-C= switch is not compatible with -jnnn switch");
5633 Fmap.Initialize (Gnatmake_Mapping_File.all);
5635 ("-gnatem=" & Gnatmake_Mapping_File.all,
5640 if Project_File_Name /= null then
5642 -- A project file was specified by a -P switch
5644 if Opt.Verbose_Mode then
5646 Write_Str ("Parsing Project File """);
5647 Write_Str (Project_File_Name.all);
5652 -- Avoid looking in the current directory for ALI files
5654 -- Opt.Look_In_Primary_Dir := False;
5656 -- Set the project parsing verbosity to whatever was specified
5657 -- by a possible -vP switch.
5659 Prj.Pars.Set_Verbosity (To => Current_Verbosity);
5661 -- Parse the project file.
5662 -- If there is an error, Main_Project will still be No_Project.
5665 (Project => Main_Project,
5666 Project_File_Name => Project_File_Name.all,
5667 Packages_To_Check => Packages_To_Check_By_Gnatmake);
5669 if Main_Project = No_Project then
5670 Make_Failed ("""", Project_File_Name.all, """ processing failed");
5673 if Opt.Verbose_Mode then
5675 Write_Str ("Parsing of Project File """);
5676 Write_Str (Project_File_Name.all);
5677 Write_Str (""" is finished.");
5681 -- We add the source directories and the object directories
5682 -- to the search paths.
5684 Add_Source_Directories (Main_Project);
5685 Add_Object_Directories (Main_Project);
5687 -- Compute depth of each project
5689 Recursive_Compute_Depth
5690 (Main_Project, Visited => No_Projects, Depth => 0);
5694 Osint.Add_Default_Search_Dirs;
5696 -- Source file lookups should be cached for efficiency.
5697 -- Source files are not supposed to change. However, we do that now
5698 -- only if no project file is used; if a project file is used, we
5699 -- do it just after changing the directory to the object directory.
5701 Osint.Source_File_Data (Cache => True);
5703 -- Read gnat.adc file to initialize Fname.UF
5705 Fname.UF.Initialize;
5708 Fname.SF.Read_Source_File_Name_Pragmas;
5711 when Err : SFN_Scan.Syntax_Error_In_GNAT_ADC =>
5712 Make_Failed (Exception_Message (Err));
5716 -- Set the marking label to a value that is not zero
5721 -----------------------------------
5722 -- Insert_Project_Sources_Into_Q --
5723 -----------------------------------
5725 procedure Insert_Project_Sources
5726 (The_Project : Project_Id;
5727 All_Projects : Boolean;
5730 Put_In_Q : Boolean := Into_Q;
5731 Unit : Com.Unit_Data;
5734 Extending : constant Boolean :=
5735 Projects.Table (The_Project).Extends /= No_Project;
5737 function Check_Project (P : Project_Id) return Boolean;
5738 -- Returns True if P is The_Project or a project extended by
5745 function Check_Project (P : Project_Id) return Boolean is
5747 if All_Projects or P = The_Project then
5749 elsif Extending then
5751 Data : Project_Data := Projects.Table (The_Project);
5755 if P = Data.Extends then
5759 Data := Projects.Table (Data.Extends);
5760 exit when Data.Extends = No_Project;
5768 -- Start of processing of Insert_Project_Sources
5771 -- For all the sources in the project files,
5773 for Id in Com.Units.First .. Com.Units.Last loop
5774 Unit := Com.Units.Table (Id);
5777 -- If there is a source for the body, and the body has not been
5780 if Unit.File_Names (Com.Body_Part).Name /= No_Name
5781 and then Unit.File_Names (Com.Body_Part).Path /= Slash
5784 -- And it is a source for the specified project
5786 if Check_Project (Unit.File_Names (Com.Body_Part).Project) then
5788 -- If we don't have a spec, we cannot consider the source
5789 -- if it is a subunit
5791 if Unit.File_Names (Com.Specification).Name = No_Name then
5793 Src_Ind : Source_File_Index;
5795 -- Here we are cheating a little bit: we don't want to
5796 -- use Sinput.L, because it depends on the GNAT tree
5797 -- (Atree, Sinfo, ...). So, we pretend that it is
5798 -- a project file, and we use Sinput.P.
5799 -- Source_File_Is_Subunit is just scanning through
5800 -- the file until it finds one of the reserved words
5801 -- separate, procedure, function, generic or package.
5802 -- Fortunately, these Ada reserved words are also
5803 -- reserved for project files.
5806 Src_Ind := Sinput.P.Load_Project_File
5808 (Unit.File_Names (Com.Body_Part).Path));
5810 -- If it is a subunit, discard it
5812 if Sinput.P.Source_File_Is_Subunit (Src_Ind) then
5816 Sfile := Unit.File_Names (Com.Body_Part).Name;
5821 Sfile := Unit.File_Names (Com.Body_Part).Name;
5825 elsif Unit.File_Names (Com.Specification).Name /= No_Name
5826 and then Unit.File_Names (Com.Specification).Path /= Slash
5827 and then Check_Project (Unit.File_Names (Com.Specification).Project)
5829 -- If there is no source for the body, but there is a source
5830 -- for the spec which has not been locally removed, then we take
5833 Sfile := Unit.File_Names (Com.Specification).Name;
5836 -- If Put_In_Q is True, we insert into the Q
5840 -- For the first source inserted into the Q, we need
5841 -- to initialize the Q, but not for the subsequent sources.
5843 if First_Q_Initialization then
5847 -- And of course, we only insert in the Q if the source
5850 if Sfile /= No_Name and then not Is_Marked (Sfile) then
5851 if Opt.Verbose_Mode then
5852 Write_Str ("Adding """);
5853 Write_Str (Get_Name_String (Sfile));
5854 Write_Line (""" to the queue");
5861 elsif Sfile /= No_Name then
5863 -- If Put_In_Q is False, we add the source as it it were
5864 -- specified on the command line, and we set Put_In_Q to True,
5865 -- so that the following sources will be put directly in the
5866 -- queue. This will allow parallel compilation processes if -jx
5869 if Opt.Verbose_Mode then
5870 Write_Str ("Adding """);
5871 Write_Str (Get_Name_String (Sfile));
5872 Write_Line (""" as if on the command line");
5875 Osint.Add_File (Get_Name_String (Sfile));
5879 end Insert_Project_Sources;
5886 (Source_File : File_Name_Type;
5887 Source_Unit : Unit_Name_Type := No_Name)
5890 if Debug.Debug_Flag_Q then
5891 Write_Str (" Q := Q + [ ");
5892 Write_Name (Source_File);
5897 Q.Table (Q.Last).File := Source_File;
5898 Q.Table (Q.Last).Unit := Source_Unit;
5902 ----------------------------
5903 -- Is_External_Assignment --
5904 ----------------------------
5906 function Is_External_Assignment (Argv : String) return Boolean is
5907 Start : Positive := 3;
5908 Finish : Natural := Argv'Last;
5909 Equal_Pos : Natural;
5912 if Argv'Last < 5 then
5915 elsif Argv (3) = '"' then
5916 if Argv (Argv'Last) /= '"' or else Argv'Last < 7 then
5920 Finish := Argv'Last - 1;
5926 while Equal_Pos <= Finish and then Argv (Equal_Pos) /= '=' loop
5927 Equal_Pos := Equal_Pos + 1;
5930 if Equal_Pos = Start
5931 or else Equal_Pos >= Finish
5937 (External_Name => Argv (Start .. Equal_Pos - 1),
5938 Value => Argv (Equal_Pos + 1 .. Finish));
5941 end Is_External_Assignment;
5943 ---------------------
5944 -- Is_In_Obsoleted --
5945 ---------------------
5947 function Is_In_Obsoleted (F : Name_Id) return Boolean is
5954 Name : String := Get_Name_String (F);
5955 First : Natural := Name'Last;
5959 while First > Name'First
5960 and then Name (First - 1) /= Directory_Separator
5961 and then Name (First - 1) /= '/'
5966 if First /= Name'First then
5968 Add_Str_To_Name_Buffer (Name (First .. Name'Last));
5972 return Obsoleted.Get (F2);
5975 end Is_In_Obsoleted;
5977 ----------------------------
5978 -- Is_In_Object_Directory --
5979 ----------------------------
5981 function Is_In_Object_Directory
5982 (Source_File : File_Name_Type;
5983 Full_Lib_File : File_Name_Type) return Boolean
5986 -- There is something to check only when using project files.
5987 -- Otherwise, this function returns True (last line of the function).
5989 if Main_Project /= No_Project then
5991 Source_File_Name : constant String :=
5992 Get_Name_String (Source_File);
5993 Saved_Verbosity : constant Verbosity := Prj.Com.Current_Verbosity;
5994 Project : Project_Id := No_Project;
5995 Path_Name : Name_Id := No_Name;
5996 Data : Project_Data;
5999 -- Call Get_Reference to know the ultimate extending project of
6000 -- the source. Call it with verbosity default to avoid verbose
6003 Prj.Com.Current_Verbosity := Default;
6006 (Source_File_Name => Source_File_Name,
6009 Prj.Com.Current_Verbosity := Saved_Verbosity;
6011 -- If this source is in a project, check that the ALI file is
6012 -- in its object directory. If it is not, return False, so that
6013 -- the ALI file will not be skipped.
6015 -- If the source is not in an extending project, we fall back to
6016 -- the general case and return True at the end of the function.
6018 if Project /= No_Project
6019 and then Projects.Table (Project).Extends /= No_Project
6021 Data := Projects.Table (Project);
6024 Object_Directory : constant String :=
6027 (Data.Object_Directory));
6029 Olast : Natural := Object_Directory'Last;
6031 Lib_File_Directory : constant String :=
6032 Normalize_Pathname (Dir_Name
6033 (Get_Name_String (Full_Lib_File)));
6035 Llast : Natural := Lib_File_Directory'Last;
6038 -- For directories, Normalize_Pathname may or may not put
6039 -- a directory separator at the end, depending on its input.
6040 -- Remove any last directory separator before comparaison.
6041 -- Returns True only if the two directories are the same.
6043 if Object_Directory (Olast) = Directory_Separator then
6047 if Lib_File_Directory (Llast) = Directory_Separator then
6051 return Object_Directory (Object_Directory'First .. Olast) =
6052 Lib_File_Directory (Lib_File_Directory'First .. Llast);
6058 -- When the source is not in a project file, always return True
6061 end Is_In_Object_Directory;
6067 function Is_Marked (Source_File : File_Name_Type) return Boolean is
6069 return Get_Name_Table_Byte (Source_File) = Marking_Label;
6076 procedure Link (ALI_File : File_Name_Type; Args : Argument_List) is
6077 Link_Args : Argument_List (1 .. Args'Length + 1);
6081 Get_Name_String (ALI_File);
6082 Link_Args (1) := new String'(Name_Buffer (1 .. Name_Len));
6084 Link_Args (2 .. Args'Length + 1) := Args;
6086 GNAT.OS_Lib.Normalize_Arguments (Link_Args);
6088 Display (Gnatlink.all, Link_Args);
6090 if Gnatlink_Path = null then
6091 Make_Failed ("error, unable to locate ", Gnatlink.all);
6094 GNAT.OS_Lib.Spawn (Gnatlink_Path.all, Link_Args, Success);
6101 ---------------------------
6102 -- List_Bad_Compilations --
6103 ---------------------------
6105 procedure List_Bad_Compilations is
6107 for J in Bad_Compilation.First .. Bad_Compilation.Last loop
6108 if Bad_Compilation.Table (J).File = No_File then
6110 elsif not Bad_Compilation.Table (J).Found then
6111 Inform (Bad_Compilation.Table (J).File, "not found");
6113 Inform (Bad_Compilation.Table (J).File, "compilation error");
6116 end List_Bad_Compilations;
6122 procedure List_Depend is
6129 Line_Size : constant := 77;
6132 Set_Standard_Output;
6134 for A in ALIs.First .. ALIs.Last loop
6135 Lib_Name := ALIs.Table (A).Afile;
6137 -- We have to provide the full library file name in In_Place_Mode
6139 if Opt.In_Place_Mode then
6140 Lib_Name := Full_Lib_File_Name (Lib_Name);
6143 Obj_Name := Object_File_Name (Lib_Name);
6144 Write_Name (Obj_Name);
6147 Get_Name_String (Obj_Name);
6149 Line_Pos := Len + 2;
6151 for D in ALIs.Table (A).First_Sdep .. ALIs.Table (A).Last_Sdep loop
6152 Src_Name := Sdep.Table (D).Sfile;
6154 if Is_Internal_File_Name (Src_Name)
6155 and then not Check_Readonly_Files
6159 if not Opt.Quiet_Output then
6160 Src_Name := Full_Source_Name (Src_Name);
6163 Get_Name_String (Src_Name);
6166 if Line_Pos + Len + 1 > Line_Size then
6172 Line_Pos := Line_Pos + Len + 1;
6175 Write_Name (Src_Name);
6189 package body Mains is
6191 package Names is new Table.Table
6192 (Table_Component_Type => File_Name_Type,
6193 Table_Index_Type => Integer,
6194 Table_Low_Bound => 1,
6195 Table_Initial => 10,
6196 Table_Increment => 100,
6197 Table_Name => "Make.Mains.Names");
6198 -- The table that stores the main
6200 Current : Natural := 0;
6201 -- The index of the last main retrieved from the table
6207 procedure Add_Main (Name : String) is
6210 Add_Str_To_Name_Buffer (Name);
6211 Names.Increment_Last;
6212 Names.Table (Names.Last) := Name_Find;
6229 function Next_Main return String is
6231 if Current >= Names.Last then
6235 Current := Current + 1;
6236 return Get_Name_String (Names.Table (Current));
6251 procedure Mark (Source_File : File_Name_Type) is
6253 Set_Name_Table_Byte (Source_File, Marking_Label);
6256 --------------------
6257 -- Mark_Directory --
6258 --------------------
6260 procedure Mark_Directory
6262 Mark : Lib_Mark_Type)
6268 -- Dir last character is supposed to be a directory separator.
6270 Name_Len := Dir'Length;
6271 Name_Buffer (1 .. Name_Len) := Dir;
6273 if not Is_Directory_Separator (Name_Buffer (Name_Len)) then
6274 Name_Len := Name_Len + 1;
6275 Name_Buffer (Name_Len) := Directory_Separator;
6278 -- Add flags to the already existing flags
6281 B := Get_Name_Table_Byte (N);
6282 Set_Name_Table_Byte (N, B or Mark);
6285 -----------------------------
6286 -- Recursive_Compute_Depth --
6287 -----------------------------
6289 procedure Recursive_Compute_Depth
6290 (Project : Project_Id;
6291 Visited : Project_Array;
6294 List : Project_List;
6297 New_Visited : constant Project_Array := Visited & Project;
6300 -- Nothing to do if there is no project
6302 if Project = No_Project then
6306 -- If current depth of project is lower than Depth, adjust it
6308 if Projects.Table (Project).Depth < Depth then
6309 Projects.Table (Project).Depth := Depth;
6312 List := Projects.Table (Project).Imported_Projects;
6314 -- Visit each imported project
6316 while List /= Empty_Project_List loop
6317 Proj := Project_Lists.Table (List).Project;
6318 List := Project_Lists.Table (List).Next;
6322 -- To avoid endless loops due to cycles with limited widts,
6323 -- do not revisit a project that is already in the chain of imports
6324 -- that brought us here.
6326 for J in Visited'Range loop
6327 if Visited (J) = Proj then
6334 Recursive_Compute_Depth
6336 Visited => New_Visited,
6337 Depth => Depth + 1);
6341 -- Visit a project being extended, if any
6343 Recursive_Compute_Depth
6344 (Project => Projects.Table (Project).Extends,
6345 Visited => New_Visited,
6346 Depth => Depth + 1);
6347 end Recursive_Compute_Depth;
6349 -----------------------
6350 -- Sigint_Intercpted --
6351 -----------------------
6353 procedure Sigint_Intercepted is
6355 Write_Line ("*** Interrupted ***");
6356 Delete_All_Temp_Files;
6358 end Sigint_Intercepted;
6364 procedure Scan_Make_Arg (Argv : String; And_Save : Boolean) is
6366 pragma Assert (Argv'First = 1);
6368 if Argv'Length = 0 then
6372 -- If the previous switch has set the Project_File_Name_Present
6373 -- flag (that is we have seen a -P alone), then the next argument is
6374 -- the name of the project file.
6376 if Project_File_Name_Present and then Project_File_Name = null then
6377 if Argv (1) = '-' then
6378 Make_Failed ("project file name missing after -P");
6381 Project_File_Name_Present := False;
6382 Project_File_Name := new String'(Argv);
6385 -- If the previous switch has set the Output_File_Name_Present
6386 -- flag (that is we have seen a -o), then the next argument is
6387 -- the name of the output executable.
6389 elsif Opt.Output_File_Name_Present
6390 and then not Output_File_Name_Seen
6392 Output_File_Name_Seen := True;
6394 if Argv (1) = '-' then
6395 Make_Failed ("output file name missing after -o");
6398 Add_Switch ("-o", Linker, And_Save => And_Save);
6400 -- Automatically add the executable suffix if it has not been
6401 -- specified explicitly.
6403 if Executable_Suffix'Length /= 0
6404 and then (Argv'Length <= Executable_Suffix'Length
6405 or else Argv (Argv'Last - Executable_Suffix'Length + 1
6406 .. Argv'Last) /= Executable_Suffix)
6409 (Argv & Executable_Suffix,
6411 And_Save => And_Save);
6413 Add_Switch (Argv, Linker, And_Save => And_Save);
6417 -- If the previous switch has set the Object_Directory_Present flag
6418 -- (that is we have seen a -D), then the next argument is
6419 -- the path name of the object directory..
6421 elsif Opt.Object_Directory_Present
6422 and then not Object_Directory_Seen
6424 Object_Directory_Seen := True;
6426 if Argv (1) = '-' then
6427 Make_Failed ("object directory path name missing after -D");
6429 elsif not Is_Directory (Argv) then
6430 Make_Failed ("cannot find object directory """, Argv, """");
6433 Add_Lib_Search_Dir (Argv);
6435 -- Specify the object directory to the binder
6437 Add_Switch ("-aO" & Argv, Binder, And_Save => And_Save);
6439 -- Record the object directory. Make sure it ends with a directory
6442 if Argv (Argv'Last) = Directory_Separator then
6443 Object_Directory_Path := new String'(Argv);
6446 Object_Directory_Path :=
6447 new String'(Argv & Directory_Separator);
6451 -- Then check if we are dealing with -cargs/-bargs/-largs/-margs
6453 elsif Argv = "-bargs"
6462 when 'c' => Program_Args := Compiler;
6463 when 'b' => Program_Args := Binder;
6464 when 'l' => Program_Args := Linker;
6465 when 'm' => Program_Args := None;
6468 raise Program_Error;
6471 -- A special test is needed for the -o switch within a -largs
6472 -- since that is another way to specify the name of the final
6475 elsif Program_Args = Linker
6476 and then Argv = "-o"
6478 Make_Failed ("switch -o not allowed within a -largs. " &
6479 "Use -o directly.");
6481 -- Check to see if we are reading switches after a -cargs,
6482 -- -bargs or -largs switch. If yes save it.
6484 elsif Program_Args /= None then
6486 -- Check to see if we are reading -I switches in order
6487 -- to take into account in the src & lib search directories.
6489 if Argv'Length > 2 and then Argv (1 .. 2) = "-I" then
6490 if Argv (3 .. Argv'Last) = "-" then
6491 Opt.Look_In_Primary_Dir := False;
6493 elsif Program_Args = Compiler then
6494 if Argv (3 .. Argv'Last) /= "-" then
6495 Add_Src_Search_Dir (Argv (3 .. Argv'Last));
6498 elsif Program_Args = Binder then
6499 Add_Lib_Search_Dir (Argv (3 .. Argv'Last));
6503 Add_Switch (Argv, Program_Args, And_Save => And_Save);
6505 -- Handle non-default compiler, binder, linker, and handle --RTS switch
6507 elsif Argv'Length > 2 and then Argv (1 .. 2) = "--" then
6509 and then Argv (1 .. 6) = "--GCC="
6512 Program_Args : constant Argument_List_Access :=
6513 Argument_String_To_List
6514 (Argv (7 .. Argv'Last));
6518 Saved_Gcc := new String'(Program_Args.all (1).all);
6520 Gcc := new String'(Program_Args.all (1).all);
6523 for J in 2 .. Program_Args.all'Last loop
6525 (Program_Args.all (J).all,
6527 And_Save => And_Save);
6531 elsif Argv'Length > 11
6532 and then Argv (1 .. 11) = "--GNATBIND="
6535 Program_Args : constant Argument_List_Access :=
6536 Argument_String_To_List
6537 (Argv (12 .. Argv'Last));
6541 Saved_Gnatbind := new String'(Program_Args.all (1).all);
6543 Gnatbind := new String'(Program_Args.all (1).all);
6546 for J in 2 .. Program_Args.all'Last loop
6548 (Program_Args.all (J).all, Binder, And_Save => And_Save);
6552 elsif Argv'Length > 11
6553 and then Argv (1 .. 11) = "--GNATLINK="
6556 Program_Args : constant Argument_List_Access :=
6557 Argument_String_To_List
6558 (Argv (12 .. Argv'Last));
6561 Saved_Gnatlink := new String'(Program_Args.all (1).all);
6563 Gnatlink := new String'(Program_Args.all (1).all);
6566 for J in 2 .. Program_Args.all'Last loop
6567 Add_Switch (Program_Args.all (J).all, Linker);
6571 elsif Argv'Length >= 5 and then
6572 Argv (1 .. 5) = "--RTS"
6574 Add_Switch (Argv, Compiler, And_Save => And_Save);
6575 Add_Switch (Argv, Binder, And_Save => And_Save);
6577 if Argv'Length <= 6 or else Argv (6) /= '=' then
6578 Make_Failed ("missing path for --RTS");
6581 -- Check that this is the first time we see this switch or
6582 -- if it is not the first time, the same path is specified.
6584 if RTS_Specified = null then
6585 RTS_Specified := new String'(Argv (7 .. Argv'Last));
6587 elsif RTS_Specified.all /= Argv (7 .. Argv'Last) then
6588 Make_Failed ("--RTS cannot be specified multiple times");
6591 -- Valid --RTS switch
6593 Opt.No_Stdinc := True;
6594 Opt.No_Stdlib := True;
6595 Opt.RTS_Switch := True;
6598 Src_Path_Name : constant String_Ptr :=
6600 (Argv (7 .. Argv'Last), Include);
6602 Lib_Path_Name : constant String_Ptr :=
6604 (Argv (7 .. Argv'Last), Objects);
6607 if Src_Path_Name /= null and then
6608 Lib_Path_Name /= null
6610 -- Set the RTS_*_Path_Name variables, so that the correct
6611 -- directories will be set when
6612 -- Osint.Add_Default_Search_Dirs will be called later.
6614 RTS_Src_Path_Name := Src_Path_Name;
6615 RTS_Lib_Path_Name := Lib_Path_Name;
6617 elsif Src_Path_Name = null
6618 and Lib_Path_Name = null then
6619 Make_Failed ("RTS path not valid: missing " &
6620 "adainclude and adalib directories");
6622 elsif Src_Path_Name = null then
6623 Make_Failed ("RTS path not valid: missing adainclude " &
6626 elsif Lib_Path_Name = null then
6627 Make_Failed ("RTS path not valid: missing adalib " &
6634 Make_Failed ("unknown switch: ", Argv);
6637 -- If we have seen a regular switch process it
6639 elsif Argv (1) = '-' then
6641 if Argv'Length = 1 then
6642 Make_Failed ("switch character cannot be followed by a blank");
6646 elsif Argv (2 .. Argv'Last) = "I-" then
6647 Opt.Look_In_Primary_Dir := False;
6649 -- Forbid -?- or -??- where ? is any character
6651 elsif (Argv'Length = 3 and then Argv (3) = '-')
6652 or else (Argv'Length = 4 and then Argv (4) = '-')
6654 Make_Failed ("trailing ""-"" at the end of ", Argv, " forbidden.");
6658 elsif Argv (2) = 'I' then
6659 Add_Src_Search_Dir (Argv (3 .. Argv'Last));
6660 Add_Lib_Search_Dir (Argv (3 .. Argv'Last));
6661 Add_Switch (Argv, Compiler, And_Save => And_Save);
6662 Add_Switch (Argv, Binder, And_Save => And_Save);
6664 -- -aIdir (to gcc this is like a -I switch)
6666 elsif Argv'Length >= 3 and then Argv (2 .. 3) = "aI" then
6667 Add_Src_Search_Dir (Argv (4 .. Argv'Last));
6668 Add_Switch ("-I" & Argv (4 .. Argv'Last),
6670 And_Save => And_Save);
6671 Add_Switch (Argv, Binder, And_Save => And_Save);
6675 elsif Argv'Length >= 3 and then Argv (2 .. 3) = "aO" then
6676 Add_Lib_Search_Dir (Argv (4 .. Argv'Last));
6677 Add_Switch (Argv, Binder, And_Save => And_Save);
6679 -- -aLdir (to gnatbind this is like a -aO switch)
6681 elsif Argv'Length >= 3 and then Argv (2 .. 3) = "aL" then
6682 Mark_Directory (Argv (4 .. Argv'Last), Ada_Lib_Dir);
6683 Add_Lib_Search_Dir (Argv (4 .. Argv'Last));
6684 Add_Switch ("-aO" & Argv (4 .. Argv'Last),
6686 And_Save => And_Save);
6688 -- -Adir (to gnatbind this is like a -aO switch, to gcc like a -I)
6690 elsif Argv (2) = 'A' then
6691 Mark_Directory (Argv (3 .. Argv'Last), Ada_Lib_Dir);
6692 Add_Src_Search_Dir (Argv (3 .. Argv'Last));
6693 Add_Lib_Search_Dir (Argv (3 .. Argv'Last));
6694 Add_Switch ("-I" & Argv (3 .. Argv'Last),
6696 And_Save => And_Save);
6697 Add_Switch ("-aO" & Argv (3 .. Argv'Last),
6699 And_Save => And_Save);
6703 elsif Argv (2) = 'L' then
6704 Add_Switch (Argv, Linker, And_Save => And_Save);
6706 -- For -gxxxxx,-pg,-mxxx: give the switch to both the compiler and
6707 -- the linker (except for -gnatxxx which is only for the compiler)
6710 (Argv (2) = 'g' and then (Argv'Last < 5
6711 or else Argv (2 .. 5) /= "gnat"))
6712 or else Argv (2 .. Argv'Last) = "pg"
6713 or else (Argv (2) = 'm' and then Argv'Last > 2)
6715 Add_Switch (Argv, Compiler, And_Save => And_Save);
6716 Add_Switch (Argv, Linker, And_Save => And_Save);
6718 -- -C=<mapping file>
6720 elsif Argv'Last > 2 and then Argv (2) = 'C' then
6722 if Argv (3) /= '=' or else Argv'Last <= 3 then
6723 Make_Failed ("illegal switch ", Argv);
6726 Gnatmake_Mapping_File := new String'(Argv (4 .. Argv'Last));
6731 elsif Argv'Last = 2 and then Argv (2) = 'D' then
6732 if Project_File_Name /= null then
6733 Make_Failed ("-D cannot be used in conjunction with a " &
6737 Scan_Make_Switches (Argv);
6742 elsif Argv (2) = 'd'
6743 and then Argv'Last = 2
6745 Opt.Display_Compilation_Progress := True;
6749 elsif Argv'Last = 2 and then Argv (2) = 'i' then
6750 if Project_File_Name /= null then
6751 Make_Failed ("-i cannot be used in conjunction with a " &
6755 Scan_Make_Switches (Argv);
6758 -- -j (need to save the result)
6760 elsif Argv (2) = 'j' then
6761 Scan_Make_Switches (Argv);
6764 Saved_Maximum_Processes := Maximum_Processes;
6769 elsif Argv (2) = 'm'
6770 and then Argv'Last = 2
6772 Opt.Minimal_Recompilation := True;
6776 elsif Argv (2) = 'u'
6777 and then Argv'Last = 2
6779 Unique_Compile := True;
6780 Opt.Compile_Only := True;
6781 Do_Bind_Step := False;
6782 Do_Link_Step := False;
6786 elsif Argv (2) = 'U'
6787 and then Argv'Last = 2
6789 Unique_Compile_All_Projects := True;
6790 Unique_Compile := True;
6791 Opt.Compile_Only := True;
6792 Do_Bind_Step := False;
6793 Do_Link_Step := False;
6795 -- -Pprj or -P prj (only once, and only on the command line)
6797 elsif Argv (2) = 'P' then
6798 if Project_File_Name /= null then
6799 Make_Failed ("cannot have several project files specified");
6801 elsif Object_Directory_Path /= null then
6802 Make_Failed ("-D cannot be used in conjunction with a " &
6805 elsif In_Place_Mode then
6806 Make_Failed ("-i cannot be used in conjunction with a " &
6809 elsif not And_Save then
6811 -- It could be a tool other than gnatmake (i.e, gnatdist)
6812 -- or a -P switch inside a project file.
6815 ("either the tool is not ""project-aware"" or " &
6816 "a project file is specified inside a project file");
6818 elsif Argv'Last = 2 then
6820 -- -P is used alone: the project file name is the next option
6822 Project_File_Name_Present := True;
6825 Project_File_Name := new String'(Argv (3 .. Argv'Last));
6828 -- -vPx (verbosity of the parsing of the project files)
6831 and then Argv (2 .. 3) = "vP"
6832 and then Argv (4) in '0' .. '2'
6837 Current_Verbosity := Prj.Default;
6839 Current_Verbosity := Prj.Medium;
6841 Current_Verbosity := Prj.High;
6847 -- -Xext=val (External assignment)
6849 elsif Argv (2) = 'X'
6850 and then Is_External_Assignment (Argv)
6852 -- Is_External_Assignment has side effects
6853 -- when it returns True;
6857 -- If -gnath is present, then generate the usage information
6858 -- right now and do not pass this option on to the compiler calls.
6860 elsif Argv = "-gnath" then
6863 -- If -gnatc is specified, make sure the bind step and the link
6864 -- step are not executed.
6866 elsif Argv'Length >= 6 and then Argv (2 .. 6) = "gnatc" then
6868 -- If -gnatc is specified, make sure the bind step and the link
6869 -- step are not executed.
6871 Add_Switch (Argv, Compiler, And_Save => And_Save);
6872 Opt.Operating_Mode := Opt.Check_Semantics;
6873 Opt.Check_Object_Consistency := False;
6874 Opt.Compile_Only := True;
6875 Do_Bind_Step := False;
6876 Do_Link_Step := False;
6878 elsif Argv (2 .. Argv'Last) = "nostdlib" then
6880 -- Don't pass -nostdlib to gnatlink, it will disable
6881 -- linking with all standard library files.
6883 Opt.No_Stdlib := True;
6885 Add_Switch (Argv, Compiler, And_Save => And_Save);
6886 Add_Switch (Argv, Binder, And_Save => And_Save);
6888 elsif Argv (2 .. Argv'Last) = "nostdinc" then
6890 -- Pass -nostdinc to the Compiler and to gnatbind
6892 Opt.No_Stdinc := True;
6893 Add_Switch (Argv, Compiler, And_Save => And_Save);
6894 Add_Switch (Argv, Binder, And_Save => And_Save);
6896 -- By default all switches with more than one character
6897 -- or one character switches which are not in 'a' .. 'z'
6898 -- (except 'C', 'F', and 'M') are passed to the compiler,
6899 -- unless we are dealing with a debug switch (starts with 'd')
6901 elsif Argv (2) /= 'd'
6902 and then Argv (2 .. Argv'Last) /= "C"
6903 and then Argv (2 .. Argv'Last) /= "F"
6904 and then Argv (2 .. Argv'Last) /= "M"
6905 and then (Argv'Length > 2 or else Argv (2) not in 'a' .. 'z')
6907 Add_Switch (Argv, Compiler, And_Save => And_Save);
6909 -- All other options are handled by Scan_Make_Switches
6912 Scan_Make_Switches (Argv);
6915 -- If not a switch it must be a file name
6919 Mains.Add_Main (Argv);
6927 function Switches_Of
6928 (Source_File : Name_Id;
6929 Source_File_Name : String;
6930 Naming : Naming_Data;
6931 In_Package : Package_Id;
6932 Allow_ALI : Boolean) return Variable_Value
6934 Switches : Variable_Value;
6936 Defaults : constant Array_Element_Id :=
6938 (Name => Name_Default_Switches,
6940 Packages.Table (In_Package).Decl.Arrays);
6942 Switches_Array : constant Array_Element_Id :=
6944 (Name => Name_Switches,
6946 Packages.Table (In_Package).Decl.Arrays);
6951 (Index => Source_File,
6952 In_Array => Switches_Array);
6954 if Switches = Nil_Variable_Value then
6956 Name : String (1 .. Source_File_Name'Length + 3);
6957 Last : Positive := Source_File_Name'Length;
6958 Spec_Suffix : constant String :=
6959 Get_Name_String (Naming.Current_Spec_Suffix);
6960 Body_Suffix : constant String :=
6961 Get_Name_String (Naming.Current_Body_Suffix);
6962 Truncated : Boolean := False;
6965 Name (1 .. Last) := Source_File_Name;
6967 if Last > Body_Suffix'Length
6968 and then Name (Last - Body_Suffix'Length + 1 .. Last) =
6972 Last := Last - Body_Suffix'Length;
6976 and then Last > Spec_Suffix'Length
6977 and then Name (Last - Spec_Suffix'Length + 1 .. Last) =
6981 Last := Last - Spec_Suffix'Length;
6986 Name_Buffer (1 .. Name_Len) := Name (1 .. Last);
6989 (Index => Name_Find,
6990 In_Array => Switches_Array);
6992 if Switches = Nil_Variable_Value
6995 Last := Source_File_Name'Length;
6997 while Name (Last) /= '.' loop
7001 Name (Last + 1 .. Last + 3) := "ali";
7002 Name_Len := Last + 3;
7003 Name_Buffer (1 .. Name_Len) := Name (1 .. Name_Len);
7006 (Index => Name_Find,
7007 In_Array => Switches_Array);
7013 if Switches = Nil_Variable_Value then
7014 Switches := Prj.Util.Value_Of
7015 (Index => Name_Ada, In_Array => Defaults);
7021 ---------------------------
7022 -- Test_If_Relative_Path --
7023 ---------------------------
7025 procedure Test_If_Relative_Path
7026 (Switch : in out String_Access;
7027 Parent : String_Access;
7028 Including_L_Switch : Boolean := True)
7031 if Switch /= null then
7034 Sw : String (1 .. Switch'Length);
7040 if Sw (1) = '-' then
7042 and then (Sw (2) = 'A'
7043 or else Sw (2) = 'I'
7044 or else (Including_L_Switch and then Sw (2) = 'L'))
7052 elsif Sw'Length >= 4
7053 and then (Sw (2 .. 3) = "aL"
7054 or else Sw (2 .. 3) = "aO"
7055 or else Sw (2 .. 3) = "aI")
7063 -- Because relative path arguments to --RTS= may be relative
7064 -- to the search directory prefix, those relative path
7065 -- arguments are not converted.
7067 if not Is_Absolute_Path (Sw (Start .. Sw'Last)) then
7068 if Parent = null or else Parent'Length = 0 then
7070 ("relative search path switches (""",
7072 """) are not allowed");
7077 (Sw (1 .. Start - 1) &
7079 Directory_Separator &
7080 Sw (Start .. Sw'Last));
7085 if not Is_Absolute_Path (Sw) then
7086 if Parent = null or else Parent'Length = 0 then
7088 ("relative paths (""", Sw, """) are not allowed");
7092 new String'(Parent.all & Directory_Separator & Sw);
7098 end Test_If_Relative_Path;
7106 if Usage_Needed then
7107 Usage_Needed := False;
7116 procedure Verbose_Msg
7119 N2 : Name_Id := No_Name;
7121 Prefix : String := " -> ")
7124 if not Opt.Verbose_Mode then
7134 if N2 /= No_Name then
7145 Prj.Com.Fail := Make_Failed'Access;
7146 MLib.Fail := Make_Failed'Access;
7147 -- Make sure that in case of failure, the temp files will be deleted