1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
10 -- Copyright (C) 1992-2002 Free Software Foundation, Inc. --
12 -- GNAT is free software; you can redistribute it and/or modify it under --
13 -- terms of the GNU General Public License as published by the Free Soft- --
14 -- ware Foundation; either version 2, or (at your option) any later ver- --
15 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
16 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
17 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
18 -- for more details. You should have received a copy of the GNU General --
19 -- Public License distributed with GNAT; see file COPYING. If not, write --
20 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
21 -- MA 02111-1307, USA. --
23 -- GNAT was originally developed by the GNAT team at New York University. --
24 -- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
26 ------------------------------------------------------------------------------
28 with Ada
.Exceptions
; use Ada
.Exceptions
;
29 with Ada
.Command_Line
; use Ada
.Command_Line
;
31 with GNAT
.Directory_Operations
; use GNAT
.Directory_Operations
;
34 with ALI
.Util
; use ALI
.Util
;
37 with Fname
; use Fname
;
38 with Fname
.SF
; use Fname
.SF
;
39 with Fname
.UF
; use Fname
.UF
;
40 with Gnatvsn
; use Gnatvsn
;
41 with Hostparm
; use Hostparm
;
46 with Namet
; use Namet
;
48 with Osint
.M
; use Osint
.M
;
49 with Osint
; use Osint
;
51 with Output
; use Output
;
60 with Snames
; use Snames
;
61 with Stringt
; use Stringt
;
62 with Switch
; use Switch
;
63 with Switch
.M
; use Switch
.M
;
66 with System
.WCh_Con
; use System
.WCh_Con
;
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 -------------------------
78 -- Note on terminology --
79 -------------------------
81 -- In this program, we use the phrase "termination" of a file name to
82 -- refer to the suffix that appears after the unit name portion. Very
83 -- often this is simply the extension, but in some cases, the sequence
84 -- may be more complex, for example in main.1.ada, the termination in
85 -- this name is ".1.ada" and in main_.ada the termination is "_.ada".
87 -------------------------------------
88 -- Queue (Q) Manipulation Routines --
89 -------------------------------------
91 -- The Q is used in Compile_Sources below. Its implementation uses the
92 -- GNAT generic package Table (basically an extensible array). Q_Front
93 -- points to the first valid element in the Q, whereas Q.First is the first
94 -- element ever enqueued, while Q.Last - 1 is the last element in the Q.
96 -- +---+--------------+---+---+---+-----------+---+--------
97 -- Q | | ........ | | | | ....... | |
98 -- +---+--------------+---+---+---+-----------+---+--------
100 -- Q.First Q_Front Q.Last - 1
102 -- The elements comprised between Q.First and Q_Front - 1 are the
103 -- elements that have been enqueued and then dequeued, while the
104 -- elements between Q_Front and Q.Last - 1 are the elements currently
105 -- in the Q. When the Q is initialized Q_Front = Q.First = Q.Last.
106 -- After Compile_Sources has terminated its execution, Q_Front = Q.Last
107 -- and the elements contained between Q.Front and Q.Last-1 are those that
108 -- were explored and thus marked by Compile_Sources. Whenever the Q is
109 -- reinitialized, the elements between Q.First and Q.Last - 1 are unmarked.
112 -- Must be called to (re)initialize the Q.
115 (Source_File
: File_Name_Type
;
116 Source_Unit
: Unit_Name_Type
:= No_Name
);
117 -- Inserts Source_File at the end of Q. Provide Source_Unit when
118 -- possible for external use (gnatdist).
120 function Empty_Q
return Boolean;
121 -- Returns True if Q is empty.
123 procedure Extract_From_Q
124 (Source_File
: out File_Name_Type
;
125 Source_Unit
: out Unit_Name_Type
);
126 -- Extracts the first element from the Q.
128 procedure Insert_Project_Sources
129 (The_Project
: Project_Id
;
131 -- If Into_Q is True, insert all sources of the project file that are not
132 -- already marked into the Q. If Into_Q is False, call Osint.Add_File for
133 -- all sources of the project file.
135 First_Q_Initialization
: Boolean := True;
136 -- Will be set to false after Init_Q has been called once.
139 -- Points to the first valid element in the Q.
141 Unique_Compile
: Boolean := False;
143 type Q_Record
is record
144 File
: File_Name_Type
;
145 Unit
: Unit_Name_Type
;
147 -- File is the name of the file to compile. Unit is for gnatdist
148 -- use in order to easily get the unit name of a file to compile
149 -- when its name is krunched or declared in gnat.adc.
151 package Q
is new Table
.Table
(
152 Table_Component_Type
=> Q_Record
,
153 Table_Index_Type
=> Natural,
154 Table_Low_Bound
=> 0,
155 Table_Initial
=> 4000,
156 Table_Increment
=> 100,
157 Table_Name
=> "Make.Q");
158 -- This is the actual Q.
160 -- The following instantiations and variables are necessary to save what
161 -- is found on the command line, in case there is a project file specified.
163 package Saved_Gcc_Switches
is new Table
.Table
(
164 Table_Component_Type
=> String_Access
,
165 Table_Index_Type
=> Integer,
166 Table_Low_Bound
=> 1,
168 Table_Increment
=> 100,
169 Table_Name
=> "Make.Saved_Gcc_Switches");
171 package Saved_Binder_Switches
is new Table
.Table
(
172 Table_Component_Type
=> String_Access
,
173 Table_Index_Type
=> Integer,
174 Table_Low_Bound
=> 1,
176 Table_Increment
=> 100,
177 Table_Name
=> "Make.Saved_Binder_Switches");
179 package Saved_Linker_Switches
is new Table
.Table
180 (Table_Component_Type
=> String_Access
,
181 Table_Index_Type
=> Integer,
182 Table_Low_Bound
=> 1,
184 Table_Increment
=> 100,
185 Table_Name
=> "Make.Saved_Linker_Switches");
187 package Saved_Make_Switches
is new Table
.Table
188 (Table_Component_Type
=> String_Access
,
189 Table_Index_Type
=> Integer,
190 Table_Low_Bound
=> 1,
192 Table_Increment
=> 100,
193 Table_Name
=> "Make.Saved_Make_Switches");
195 package Switches_To_Check
is new Table
.Table
(
196 Table_Component_Type
=> String_Access
,
197 Table_Index_Type
=> Integer,
198 Table_Low_Bound
=> 1,
200 Table_Increment
=> 100,
201 Table_Name
=> "Make.Switches_To_Check");
203 Normalized_Switches
: Argument_List_Access
:= new Argument_List
(1 .. 10);
204 Last_Norm_Switch
: Natural := 0;
206 Saved_Maximum_Processes
: Natural := 0;
207 Saved_WC_Encoding_Method
: WC_Encoding_Method
:= WC_Encoding_Method
'First;
208 Saved_WC_Encoding_Method_Set
: Boolean := False;
210 type Arg_List_Ref
is access Argument_List
;
211 The_Saved_Gcc_Switches
: Arg_List_Ref
;
213 Project_File_Name
: String_Access
:= null;
214 Current_Verbosity
: Prj
.Verbosity
:= Prj
.Default
;
215 Main_Project
: Prj
.Project_Id
:= No_Project
;
217 procedure Add_Source_Dir
(N
: String);
218 -- Call Add_Src_Search_Dir.
219 -- Output one line when in verbose mode.
221 procedure Add_Source_Directories
is
222 new Prj
.Env
.For_All_Source_Dirs
(Action
=> Add_Source_Dir
);
224 procedure Add_Object_Dir
(N
: String);
225 -- Call Add_Lib_Search_Dir.
226 -- Output one line when in verbose mode.
228 procedure Add_Object_Directories
is
229 new Prj
.Env
.For_All_Object_Dirs
(Action
=> Add_Object_Dir
);
231 type Bad_Compilation_Info
is record
232 File
: File_Name_Type
;
233 Unit
: Unit_Name_Type
;
236 -- File is the name of the file for which a compilation failed.
237 -- Unit is for gnatdist use in order to easily get the unit name
238 -- of a file when its name is krunched or declared in gnat.adc.
239 -- Found is False if the compilation failed because the file could
242 package Bad_Compilation
is new Table
.Table
(
243 Table_Component_Type
=> Bad_Compilation_Info
,
244 Table_Index_Type
=> Natural,
245 Table_Low_Bound
=> 1,
247 Table_Increment
=> 100,
248 Table_Name
=> "Make.Bad_Compilation");
249 -- Full name of all the source files for which compilation fails.
251 Original_Ada_Include_Path
: constant String_Access
:=
252 Getenv
("ADA_INCLUDE_PATH");
253 Original_Ada_Objects_Path
: constant String_Access
:=
254 Getenv
("ADA_OBJECTS_PATH");
255 Current_Ada_Include_Path
: String_Access
:= null;
256 Current_Ada_Objects_Path
: String_Access
:= null;
258 Max_Line_Length
: constant := 127;
259 -- Maximum number of characters per line, when displaying a path
261 Do_Compile_Step
: Boolean := True;
262 Do_Bind_Step
: Boolean := True;
263 Do_Link_Step
: Boolean := True;
264 -- Flags to indicate what step should be executed.
265 -- Can be set to False with the switches -c, -b and -l.
266 -- These flags are reset to True for each invokation of procedure Gnatmake.
268 ----------------------
269 -- Marking Routines --
270 ----------------------
272 procedure Mark
(Source_File
: File_Name_Type
);
273 -- Mark Source_File. Marking is used to signal that Source_File has
274 -- already been inserted in the Q.
276 function Is_Marked
(Source_File
: File_Name_Type
) return Boolean;
277 -- Returns True if Source_File was previously marked.
283 procedure List_Depend
;
284 -- Prints to standard output the list of object dependencies. This list
285 -- can be used directly in a Makefile. A call to Compile_Sources must
286 -- precede the call to List_Depend. Also because this routine uses the
287 -- ALI files that were originally loaded and scanned by Compile_Sources,
288 -- no additional ALI files should be scanned between the two calls (i.e.
289 -- between the call to Compile_Sources and List_Depend.)
291 procedure Inform
(N
: Name_Id
:= No_Name
; Msg
: String);
292 -- Prints out the program name followed by a colon, N and S.
294 procedure List_Bad_Compilations
;
295 -- Prints out the list of all files for which the compilation failed.
297 procedure Verbose_Msg
300 N2
: Name_Id
:= No_Name
;
302 Prefix
: String := " -> ");
303 -- If the verbose flag (Verbose_Mode) is set then print Prefix to standard
304 -- output followed by N1 and S1. If N2 /= No_Name then N2 is then printed
305 -- after S1. S2 is printed last. Both N1 and N2 are printed in quotation
308 Usage_Needed
: Boolean := True;
309 -- Flag used to make sure Makeusg is call at most once
312 -- Call Makeusg, if Usage_Needed is True.
313 -- Set Usage_Needed to False.
315 -----------------------
316 -- Gnatmake Routines --
317 -----------------------
319 subtype Lib_Mark_Type
is Byte
;
320 -- ??? this needs a comment
322 Ada_Lib_Dir
: constant Lib_Mark_Type
:= 1;
323 -- ??? this needs a comment
325 -- Note that the notion of GNAT lib dir is no longer used. The code
326 -- related to it has not been removed to give an idea on how to use
327 -- the directory prefix marking mechanism.
329 -- An Ada library directory is a directory containing ali and object
330 -- files but no source files for the bodies (the specs can be in the
331 -- same or some other directory). These directories are specified
332 -- in the Gnatmake command line with the switch "-Adir" (to specify the
333 -- spec location -Idir cab be used). Gnatmake skips the missing sources
334 -- whose ali are in Ada library directories. For an explanation of why
335 -- Gnatmake behaves that way, see the spec of Make.Compile_Sources.
336 -- The directory lookup penalty is incurred every single time this
337 -- routine is called.
339 function Is_External_Assignment
(Argv
: String) return Boolean;
340 -- Verify that an external assignment switch is syntactically correct.
343 -- -X"name=other value"
344 -- Assumptions: 'First = 1, Argv (1 .. 2) = "-X"
345 -- When this function returns True, the external assignment has
346 -- been entered by a call to Prj.Ext.Add, so that in a project
347 -- file, External ("name") will return "value".
349 function In_Ada_Lib_Dir
(File
: File_Name_Type
) return Boolean;
350 -- Get directory prefix of this file and get lib mark stored in name
351 -- table for this directory. Then check if an Ada lib mark has been set.
353 procedure Mark_Directory
355 Mark
: Lib_Mark_Type
);
356 -- Store Dir in name table and set lib mark as name info to identify
359 function Object_File_Name
(Source
: String) return String;
360 -- Returns the object file name suitable for switch -o.
362 procedure Set_Ada_Paths
363 (For_Project
: Prj
.Project_Id
;
364 Including_Libraries
: Boolean);
365 -- Set, if necessary, env. variables ADA_INCLUDE_PATH and
368 -- Note: this will modify these environment variables only
369 -- for the current gnatmake process and all of its children
370 -- (invocations of the compiler, the binder and the linker).
371 -- The caller process ADA_INCLUDE_PATH and ADA_OBJECTS_PATH are
375 (Source_File
: Name_Id
;
376 Source_File_Name
: String;
377 Naming
: Naming_Data
;
378 In_Package
: Package_Id
;
380 return Variable_Value
;
381 -- Return the switches for the source file in the specified package
382 -- of a project file. If the Source_File ends with a standard GNAT
383 -- extension (".ads" or ".adb"), try first the full name, then the
384 -- name without the extension, then, if Allow_ALI is True, the name with
385 -- the extension ".ali". If there is no switches for either names, try the
386 -- default switches for Ada. If all failed, return No_Variable_Value.
388 procedure Test_If_Relative_Path
389 (Switch
: in out String_Access
;
390 Parent
: String_Access
);
391 -- Test if Switch is a relative search path switch.
392 -- If it is, fail if Parent is null, otherwise prepend the path with
393 -- Parent. This subprogram is only called when using project files.
395 procedure Set_Library_For
396 (Project
: Project_Id
;
397 There_Are_Libraries
: in out Boolean);
398 -- If Project is a library project, add the correct
399 -- -L and -l switches to the linker invocation.
401 procedure Set_Libraries
is
402 new For_Every_Project_Imported
(Boolean, Set_Library_For
);
403 -- Add the -L and -l switches to the linker for all
404 -- of the library projects.
406 ----------------------------------------------------
407 -- Compiler, Binder & Linker Data and Subprograms --
408 ----------------------------------------------------
410 Gcc
: String_Access
:= Program_Name
("gcc");
411 Gnatbind
: String_Access
:= Program_Name
("gnatbind");
412 Gnatlink
: String_Access
:= Program_Name
("gnatlink");
413 -- Default compiler, binder, linker programs
415 Saved_Gcc
: String_Access
:= null;
416 Saved_Gnatbind
: String_Access
:= null;
417 Saved_Gnatlink
: String_Access
:= null;
418 -- Given by the command line. Will be used, if non null.
420 Gcc_Path
: String_Access
:=
421 GNAT
.OS_Lib
.Locate_Exec_On_Path
(Gcc
.all);
422 Gnatbind_Path
: String_Access
:=
423 GNAT
.OS_Lib
.Locate_Exec_On_Path
(Gnatbind
.all);
424 Gnatlink_Path
: String_Access
:=
425 GNAT
.OS_Lib
.Locate_Exec_On_Path
(Gnatlink
.all);
426 -- Path for compiler, binder, linker programs, defaulted now for gnatdist.
427 -- Changed later if overridden on command line.
429 Comp_Flag
: constant String_Access
:= new String'("-c");
430 Output_Flag : constant String_Access := new String'("-o");
431 Ada_Flag_1
: constant String_Access
:= new String'("-x");
432 Ada_Flag_2 : constant String_Access := new String'("ada");
433 No_gnat_adc
: constant String_Access
:= new String'("-gnatA");
434 GNAT_Flag : constant String_Access := new String'("-gnatpg");
435 Do_Not_Check_Flag
: constant String_Access
:= new String'("-x");
437 Object_Suffix : constant String := Get_Object_Suffix.all;
438 Executable_Suffix : constant String := Get_Executable_Suffix.all;
440 Syntax_Only : Boolean := False;
441 -- Set to True when compiling with -gnats
443 Display_Executed_Programs : Boolean := True;
444 -- Set to True if name of commands should be output on stderr.
446 Output_File_Name_Seen : Boolean := False;
447 -- Set to True after having scanned the file_name for
448 -- switch "-o file_name"
450 type Make_Program_Type is (None, Compiler, Binder, Linker);
452 Program_Args : Make_Program_Type := None;
453 -- Used to indicate if we are scanning gnatmake, gcc, gnatbind, or gnatbind
454 -- options within the gnatmake command line.
455 -- Used in Scan_Make_Arg only, but must be a global variable.
457 procedure Add_Switches
458 (The_Package : Package_Id;
460 Program : Make_Program_Type);
463 Program : Make_Program_Type;
464 Append_Switch : Boolean := True;
465 And_Save : Boolean := True);
468 Program : Make_Program_Type;
469 Append_Switch : Boolean := True;
470 And_Save : Boolean := True);
471 -- Make invokes one of three programs (the compiler, the binder or the
472 -- linker). For the sake of convenience, some program specific switches
473 -- can be passed directly on the gnatmake commande line. This procedure
474 -- records these switches so that gnamake can pass them to the right
475 -- program. S is the switch to be added at the end of the command line
476 -- for Program if Append_Switch is True. If Append_Switch is False S is
477 -- added at the beginning of the command line.
480 (Lib_File : File_Name_Type;
482 O_File : out File_Name_Type;
483 O_Stamp : out Time_Stamp_Type);
484 -- Determines whether the library file Lib_File is up-to-date or not. The
485 -- full name (with path information) of the object file corresponding to
486 -- Lib_File is returned in O_File. Its time stamp is saved in O_Stamp.
487 -- ALI is the ALI_Id corresponding to Lib_File. If Lib_File in not
488 -- up-to-date, then the corresponding source file needs to be recompiled.
489 -- In this case ALI = No_ALI_Id.
491 procedure Check_Linker_Options
492 (E_Stamp : Time_Stamp_Type;
493 O_File : out File_Name_Type;
494 O_Stamp : out Time_Stamp_Type);
495 -- Checks all linker options for linker files that are newer
496 -- than E_Stamp. If such objects are found, the youngest object
497 -- is returned in O_File and its stamp in O_Stamp.
499 -- If no obsolete linker files were found, the first missing
500 -- linker file is returned in O_File and O_Stamp is empty.
501 -- Otherwise O_File is No_File.
503 procedure Display (Program : String; Args : Argument_List);
504 -- Displays Program followed by the arguments in Args if variable
505 -- Display_Executed_Programs is set. The lower bound of Args must be 1.
507 type Temp_File_Names is array (Positive range <>) of Temp_File_Name;
509 type Temp_Files_Ptr is access Temp_File_Names;
511 The_Mapping_File_Names : Temp_Files_Ptr;
512 Last_Mapping_File_Name : Natural := 0;
514 procedure Delete_Mapping_Files;
515 -- Delete all temporary mapping files
517 procedure Init_Mapping_File (File_Name : in out Temp_File_Name);
518 -- Create a new temporary mapping file, and fill it with the project file
519 -- mappings, when using project file(s)
525 procedure Add_Object_Dir (N : String) is
527 Add_Lib_Search_Dir (N);
529 if Opt.Verbose_Mode then
530 Write_Str ("Adding object directory """);
541 procedure Add_Source_Dir (N : String) is
543 Add_Src_Search_Dir (N);
545 if Opt.Verbose_Mode then
546 Write_Str ("Adding source directory """);
559 Program : Make_Program_Type;
560 Append_Switch : Boolean := True;
561 And_Save : Boolean := True)
564 with package T is new Table.Table (<>);
565 procedure Generic_Position (New_Position : out Integer);
566 -- Generic procedure that chooses a position for S in T at the
567 -- beginning or the end, depending on the boolean Append_Switch.
570 ----------------------
571 -- Generic_Position --
572 ----------------------
574 procedure Generic_Position (New_Position : out Integer) is
578 if Append_Switch then
579 New_Position := Integer (T.Last);
581 for J in reverse T.Table_Index_Type'Succ (T.First) .. T.Last loop
582 T.Table (J) := T.Table (T.Table_Index_Type'Pred (J));
585 New_Position := Integer (T.First);
587 end Generic_Position;
589 procedure Gcc_Switches_Pos is new Generic_Position (Gcc_Switches);
590 procedure Binder_Switches_Pos is new Generic_Position (Binder_Switches);
591 procedure Linker_Switches_Pos is new Generic_Position (Linker_Switches);
593 procedure Saved_Gcc_Switches_Pos is new
594 Generic_Position (Saved_Gcc_Switches);
596 procedure Saved_Binder_Switches_Pos is new
597 Generic_Position (Saved_Binder_Switches);
599 procedure Saved_Linker_Switches_Pos is new
600 Generic_Position (Saved_Linker_Switches);
602 New_Position : Integer;
604 -- Start of processing for Add_Switch
610 Saved_Gcc_Switches_Pos (New_Position);
611 Saved_Gcc_Switches.Table (New_Position) := S;
614 Saved_Binder_Switches_Pos (New_Position);
615 Saved_Binder_Switches.Table (New_Position) := S;
618 Saved_Linker_Switches_Pos (New_Position);
619 Saved_Linker_Switches.Table (New_Position) := S;
628 Gcc_Switches_Pos (New_Position);
629 Gcc_Switches.Table (New_Position) := S;
632 Binder_Switches_Pos (New_Position);
633 Binder_Switches.Table (New_Position) := S;
636 Linker_Switches_Pos (New_Position);
637 Linker_Switches.Table (New_Position) := S;
647 Program : Make_Program_Type;
648 Append_Switch : Boolean := True;
649 And_Save : Boolean := True)
652 Add_Switch (S => new String'(S
),
654 Append_Switch
=> Append_Switch
,
655 And_Save
=> And_Save
);
662 procedure Add_Switches
663 (The_Package
: Package_Id
;
665 Program
: Make_Program_Type
)
667 Switches
: Variable_Value
;
668 Switch_List
: String_List_Id
;
669 Element
: String_Element
;
672 if File_Name
'Length > 0 then
673 Name_Len
:= File_Name
'Length;
674 Name_Buffer
(1 .. Name_Len
) := File_Name
;
677 (Source_File
=> Name_Find
,
678 Source_File_Name
=> File_Name
,
679 Naming
=> Projects
.Table
(Main_Project
).Naming
,
680 In_Package
=> The_Package
,
682 Program
= Binder
or else Program
= Linker
);
684 case Switches
.Kind
is
689 Program_Args
:= Program
;
691 Switch_List
:= Switches
.Values
;
693 while Switch_List
/= Nil_String
loop
694 Element
:= String_Elements
.Table
(Switch_List
);
695 String_To_Name_Buffer
(Element
.Value
);
698 if Opt
.Verbose_Mode
then
699 Write_Str
(" Adding ");
700 Write_Line
(Name_Buffer
(1 .. Name_Len
));
704 (Name_Buffer
(1 .. Name_Len
),
708 Switch_List
:= Element
.Next
;
712 Program_Args
:= Program
;
713 String_To_Name_Buffer
(Switches
.Value
);
716 if Opt
.Verbose_Mode
then
717 Write_Str
(" Adding ");
718 Write_Line
(Name_Buffer
(1 .. Name_Len
));
722 (Name_Buffer
(1 .. Name_Len
), And_Save
=> False);
732 procedure Bind
(ALI_File
: File_Name_Type
; Args
: Argument_List
) is
733 Bind_Args
: Argument_List
(1 .. Args
'Last + 2);
738 pragma Assert
(Args
'First = 1);
740 -- Optimize the simple case where the gnatbind command line looks like
741 -- gnatbind -aO. -I- file.ali --into-> gnatbind file.adb
744 and then Args
(Args
'First).all = "-aO" & Normalized_CWD
745 and then Args
(Args
'Last).all = "-I-"
746 and then ALI_File
= Strip_Directory
(ALI_File
)
748 Bind_Last
:= Args
'First - 1;
751 Bind_Last
:= Args
'Last;
752 Bind_Args
(Args
'Range) := Args
;
755 -- It is completely pointless to re-check source file time stamps.
756 -- This has been done already by gnatmake
758 Bind_Last
:= Bind_Last
+ 1;
759 Bind_Args
(Bind_Last
) := Do_Not_Check_Flag
;
761 Get_Name_String
(ALI_File
);
763 Bind_Last
:= Bind_Last
+ 1;
764 Bind_Args
(Bind_Last
) := new String'(Name_Buffer (1 .. Name_Len));
766 GNAT.OS_Lib.Normalize_Arguments (Bind_Args (Args'First .. Bind_Last));
768 Display (Gnatbind.all, Bind_Args (Args'First .. Bind_Last));
770 if Gnatbind_Path = null then
771 Osint.Fail ("error, unable to locate " & Gnatbind.all);
775 (Gnatbind_Path.all, Bind_Args (Args'First .. Bind_Last), Success);
787 (Lib_File : File_Name_Type;
789 O_File : out File_Name_Type;
790 O_Stamp : out Time_Stamp_Type)
792 function First_New_Spec (A : ALI_Id) return File_Name_Type;
793 -- Looks in the with table entries of A and returns the spec file name
794 -- of the first withed unit (subprogram) for which no spec existed when
795 -- A was generated but for which there exists one now, implying that A
796 -- is now obsolete. If no such unit is found No_File is returned.
797 -- Otherwise the spec file name of the unit is returned.
799 -- **WARNING** in the event of Uname format modifications, one *MUST*
800 -- make sure this function is also updated.
802 -- Note: This function should really be in ali.adb and use Uname
803 -- services, but this causes the whole compiler to be dragged along
804 -- for gnatbind and gnatmake.
810 function First_New_Spec (A : ALI_Id) return File_Name_Type is
811 Spec_File_Name : File_Name_Type := No_File;
813 function New_Spec (Uname : Unit_Name_Type) return Boolean;
814 -- Uname is the name of the spec or body of some ada unit.
815 -- This function returns True if the Uname is the name of a body
816 -- which has a spec not mentioned inali file A. If True is returned
817 -- Spec_File_Name above is set to the name of this spec file.
823 function New_Spec (Uname : Unit_Name_Type) return Boolean is
824 Spec_Name : Unit_Name_Type;
825 File_Name : File_Name_Type;
828 -- Test whether Uname is the name of a body unit (ie ends with %b)
830 Get_Name_String (Uname);
832 Assert (Name_Len > 2 and then Name_Buffer (Name_Len - 1) = '%');
834 if Name_Buffer (Name_Len) /= 'b
' then
838 -- Convert unit name into spec name
840 -- ??? this code seems dubious in presence of pragma
841 -- Source_File_Name since there is no more direct relationship
842 -- between unit name and file name.
844 -- ??? Further, what about alternative subunit naming
846 Name_Buffer (Name_Len) := 's
';
847 Spec_Name := Name_Find;
848 File_Name := Get_File_Name (Spec_Name, Subunit => False);
850 -- Look if File_Name is mentioned in A's sdep list.
851 -- If not look if the file exists. If it does return True.
854 ALIs.Table (A).First_Sdep .. ALIs.Table (A).Last_Sdep
856 if Sdep.Table (D).Sfile = File_Name then
861 if Full_Source_Name (File_Name) /= No_File then
862 Spec_File_Name := File_Name;
869 -- Start of processing for First_New_Spec
873 ALIs.Table (A).First_Unit .. ALIs.Table (A).Last_Unit
875 exit U_Chk when Units.Table (U).Utype = Is_Body_Only
876 and then New_Spec (Units.Table (U).Uname);
878 for W in Units.Table (U).First_With
880 Units.Table (U).Last_With
883 Withs.Table (W).Afile /= No_File
884 and then New_Spec (Withs.Table (W).Uname);
888 return Spec_File_Name;
891 ---------------------------------
892 -- Data declarations for Check --
893 ---------------------------------
895 Full_Lib_File : File_Name_Type;
896 -- Full name of current library file
898 Full_Obj_File : File_Name_Type;
899 -- Full name of the object file corresponding to Lib_File.
901 Lib_Stamp : Time_Stamp_Type;
902 -- Time stamp of the current ada library file.
904 Obj_Stamp : Time_Stamp_Type;
905 -- Time stamp of the current object file.
907 Modified_Source : File_Name_Type;
908 -- The first source in Lib_File whose current time stamp differs
909 -- from that stored in Lib_File.
911 New_Spec : File_Name_Type;
912 -- If Lib_File contains in its W (with) section a body (for a
913 -- subprogram) for which there exists a spec and the spec did not
914 -- appear in the Sdep section of Lib_File, New_Spec contains the file
915 -- name of this new spec.
917 Source_Name : Name_Id;
918 Text : Text_Buffer_Ptr;
920 Prev_Switch : Character;
921 -- First character of previous switch processed
923 Arg : Arg_Id := Arg_Id'First;
924 -- Current index in Args.Table for a given unit (init to stop warning)
926 Switch_Found : Boolean;
927 -- True if a given switch has been found
930 -- Number of compiler arguments processed
932 -- Start of processing for Check
935 pragma Assert (Lib_File /= No_File);
937 Text := Read_Library_Info (Lib_File);
938 Full_Lib_File := Full_Library_Info_Name;
939 Full_Obj_File := Full_Object_File_Name;
940 Lib_Stamp := Current_Library_File_Stamp;
941 Obj_Stamp := Current_Object_File_Stamp;
943 if Full_Lib_File = No_File then
944 Verbose_Msg (Lib_File, "being checked ...", Prefix => " ");
946 Verbose_Msg (Full_Lib_File, "being checked ...", Prefix => " ");
950 O_File := Full_Obj_File;
951 O_Stamp := Obj_Stamp;
954 if Full_Lib_File = No_File then
955 Verbose_Msg (Lib_File, "missing.");
957 elsif Obj_Stamp (Obj_Stamp'First) = ' ' then
958 Verbose_Msg (Full_Obj_File, "missing.");
962 (Full_Lib_File, "(" & String (Lib_Stamp) & ") newer than",
963 Full_Obj_File, "(" & String (Obj_Stamp) & ")");
967 ALI := Scan_ALI (Lib_File, Text, Ignore_ED => False, Err => True);
970 if ALI = No_ALI_Id then
971 Verbose_Msg (Full_Lib_File, "incorrectly formatted ALI file");
974 elsif ALIs.Table (ALI).Ver (1 .. ALIs.Table (ALI).Ver_Len) /=
977 Verbose_Msg (Full_Lib_File, "compiled with old GNAT version");
982 -- Don't take Ali file into account if it was generated without
985 if Opt.Operating_Mode /= Opt.Check_Semantics
986 and then ALIs.Table (ALI).No_Object
988 Verbose_Msg (Full_Lib_File, "has no corresponding object");
993 -- Check for matching compiler switches if needed
995 if Opt.Check_Switches then
996 Prev_Switch := ASCII.Nul;
999 Get_Name_String (ALIs.Table (ALI).Sfile);
1001 Switches_To_Check.Set_Last (0);
1003 for J in Gcc_Switches.First .. Gcc_Switches.Last loop
1005 -- Skip non switches, -I and -o switches
1007 if Gcc_Switches.Table (J) (1) = '-'
1008 and then Gcc_Switches.Table (J) (2) /= 'o
'
1009 and then Gcc_Switches.Table (J) (2) /= 'I
'
1011 Normalize_Compiler_Switches
1012 (Gcc_Switches.Table (J).all,
1013 Normalized_Switches,
1016 for K in 1 .. Last_Norm_Switch loop
1017 Switches_To_Check.Increment_Last;
1018 Switches_To_Check.Table (Switches_To_Check.Last) :=
1019 Normalized_Switches (K);
1024 for J in 1 .. Switches_To_Check.Last loop
1026 -- Comparing switches is delicate because gcc reorders
1027 -- a number of switches, according to lang-specs.h, but
1028 -- gnatmake doesn't have the sufficient knowledge to
1029 -- perform the same reordering. Instead, we ignore orders
1030 -- between different "first letter" switches, but keep
1031 -- orders between same switches, e.g -O -O2 is different
1032 -- than -O2 -O, but -g -O is equivalent to -O -g.
1034 if Switches_To_Check.Table (J) (2) /= Prev_Switch then
1035 Prev_Switch := Switches_To_Check.Table (J) (2);
1037 Units.Table (ALIs.Table (ALI).First_Unit).First_Arg;
1040 Switch_Found := False;
1043 Units.Table (ALIs.Table (ALI).First_Unit).Last_Arg
1045 Num_Args := Num_Args + 1;
1048 Switches_To_Check.Table (J).all = Args.Table (K).all
1051 Switch_Found := True;
1056 if not Switch_Found then
1057 if Opt.Verbose_Mode then
1058 Verbose_Msg (ALIs.Table (ALI).Sfile,
1068 Integer (Units.Table (ALIs.Table (ALI).First_Unit).Last_Arg -
1069 Units.Table (ALIs.Table (ALI).First_Unit).First_Arg + 1)
1071 if Opt.Verbose_Mode then
1072 Verbose_Msg (ALIs.Table (ALI).Sfile,
1073 "different number of switches");
1081 -- Get the source files and their time stamps. Note that some
1082 -- sources may be missing if ALI is out-of-date.
1084 Set_Source_Table (ALI);
1086 Modified_Source := Time_Stamp_Mismatch (ALI);
1088 if Modified_Source /= No_File then
1091 if Opt.Verbose_Mode then
1092 Source_Name := Full_Source_Name (Modified_Source);
1094 if Source_Name /= No_File then
1095 Verbose_Msg (Source_Name, "time stamp mismatch");
1097 Verbose_Msg (Modified_Source, "missing");
1102 New_Spec := First_New_Spec (ALI);
1104 if New_Spec /= No_File then
1107 if Opt.Verbose_Mode then
1108 Source_Name := Full_Source_Name (New_Spec);
1110 if Source_Name /= No_File then
1111 Verbose_Msg (Source_Name, "new spec");
1113 Verbose_Msg (New_Spec, "old spec missing");
1121 --------------------------
1122 -- Check_Linker_Options --
1123 --------------------------
1125 procedure Check_Linker_Options
1126 (E_Stamp : Time_Stamp_Type;
1127 O_File : out File_Name_Type;
1128 O_Stamp : out Time_Stamp_Type)
1130 procedure Check_File (File : File_Name_Type);
1131 -- Update O_File and O_Stamp if the given file is younger than E_Stamp
1132 -- and O_Stamp, or if O_File is No_File and File does not exist.
1134 function Get_Library_File (Name : String) return File_Name_Type;
1135 -- Return the full file name including path of a library based
1136 -- on the name specified with the -l linker option, using the
1137 -- Ada object path. Return No_File if no such file can be found.
1139 type Char_Array is array (Natural) of Character;
1140 type Char_Array_Access is access constant Char_Array;
1142 Template : Char_Array_Access;
1143 pragma Import (C, Template, "__gnat_library_template");
1149 procedure Check_File (File : File_Name_Type) is
1150 Stamp : Time_Stamp_Type;
1151 Name : File_Name_Type := File;
1154 Get_Name_String (Name);
1156 -- Remove any trailing NUL characters
1158 while Name_Len >= Name_Buffer'First
1159 and then Name_Buffer (Name_Len) = NUL
1161 Name_Len := Name_Len - 1;
1164 if Name_Len <= 0 then
1167 elsif Name_Buffer (1) = '-' then
1169 -- Do not check if File is a switch other than "-l"
1171 if Name_Buffer (2) /= 'l
' then
1175 -- The argument is a library switch, get actual name. It
1176 -- is necessary to make a copy of the relevant part of
1177 -- Name_Buffer as Get_Library_Name uses Name_Buffer as well.
1180 Base_Name : constant String := Name_Buffer (3 .. Name_Len);
1183 Name := Get_Library_File (Base_Name);
1186 if Name = No_File then
1191 Stamp := File_Stamp (Name);
1193 -- Find the youngest object file that is younger than the
1194 -- executable. If no such file exist, record the first object
1195 -- file that is not found.
1197 if (O_Stamp < Stamp and then E_Stamp < Stamp)
1198 or else (O_File = No_File and then Stamp (Stamp'First) = ' ')
1203 -- Strip the trailing NUL if present
1205 Get_Name_String (O_File);
1207 if Name_Buffer (Name_Len) = NUL then
1208 Name_Len := Name_Len - 1;
1209 O_File := Name_Find;
1214 ----------------------
1215 -- Get_Library_Name --
1216 ----------------------
1218 -- See comments in a-adaint.c about template syntax
1220 function Get_Library_File (Name : String) return File_Name_Type is
1221 File : File_Name_Type := No_File;
1226 for Ptr in Template'Range loop
1227 case Template (Ptr) is
1229 Add_Str_To_Name_Buffer (Name);
1232 File := Full_Lib_File_Name (Name_Find);
1233 exit when File /= No_File;
1240 Add_Char_To_Name_Buffer (Template (Ptr));
1244 -- The for loop exited because the end of the template
1245 -- was reached. File contains the last possible file name
1248 if File = No_File and then Name_Len > 0 then
1249 File := Full_Lib_File_Name (Name_Find);
1253 end Get_Library_File;
1255 -- Start of processing for Check_Linker_Options
1259 O_Stamp := (others => ' ');
1261 -- Process linker options from the ALI files.
1263 for Opt in 1 .. Linker_Options.Last loop
1264 Check_File (Linker_Options.Table (Opt).Name);
1267 -- Process options given on the command line.
1269 for Opt in Linker_Switches.First .. Linker_Switches.Last loop
1271 -- Check if the previous Opt has one of the two switches
1272 -- that take an extra parameter. (See GCC manual.)
1274 if Opt = Linker_Switches.First
1275 or else (Linker_Switches.Table (Opt - 1).all /= "-u"
1277 Linker_Switches.Table (Opt - 1).all /= "-Xlinker")
1280 Add_Str_To_Name_Buffer (Linker_Switches.Table (Opt).all);
1281 Check_File (Name_Find);
1285 end Check_Linker_Options;
1287 ---------------------
1288 -- Compile_Sources --
1289 ---------------------
1291 procedure Compile_Sources
1292 (Main_Source : File_Name_Type;
1293 Args : Argument_List;
1294 First_Compiled_File : out Name_Id;
1295 Most_Recent_Obj_File : out Name_Id;
1296 Most_Recent_Obj_Stamp : out Time_Stamp_Type;
1297 Main_Unit : out Boolean;
1298 Compilation_Failures : out Natural;
1299 Check_Readonly_Files : Boolean := False;
1300 Do_Not_Execute : Boolean := False;
1301 Force_Compilations : Boolean := False;
1302 Keep_Going : Boolean := False;
1303 In_Place_Mode : Boolean := False;
1304 Initialize_ALI_Data : Boolean := True;
1305 Max_Process : Positive := 1)
1310 Args : Argument_List)
1312 -- Compiles S using Args. If S is a GNAT predefined source
1313 -- "-gnatpg" is added to Args. Non blocking call. L corresponds to the
1314 -- expected library file name. Process_Id of the process spawned to
1315 -- execute the compile.
1317 No_Mapping_File : constant Temp_File_Name := (others => ' ');
1319 type Compilation_Data is record
1321 Full_Source_File : File_Name_Type;
1322 Lib_File : File_Name_Type;
1323 Source_Unit : Unit_Name_Type;
1324 Mapping_File : Temp_File_Name := No_Mapping_File;
1325 Use_Mapping_File : Boolean := False;
1326 Syntax_Only : Boolean := False;
1329 Running_Compile : array (1 .. Max_Process) of Compilation_Data;
1330 -- Used to save information about outstanding compilations.
1332 Outstanding_Compiles : Natural := 0;
1333 -- Current number of outstanding compiles
1335 Source_Unit : Unit_Name_Type;
1336 -- Current source unit
1338 Source_File : File_Name_Type;
1339 -- Current source file
1341 Full_Source_File : File_Name_Type;
1342 -- Full name of the current source file
1344 Lib_File : File_Name_Type;
1345 -- Current library file
1347 Full_Lib_File : File_Name_Type;
1348 -- Full name of the current library file
1350 Obj_File : File_Name_Type;
1351 -- Full name of the object file corresponding to Lib_File.
1353 Obj_Stamp : Time_Stamp_Type;
1354 -- Time stamp of the current object file.
1356 Sfile : File_Name_Type;
1357 -- Contains the source file of the units withed by Source_File
1360 -- ALI Id of the current ALI file
1362 Compilation_OK : Boolean;
1363 Need_To_Compile : Boolean;
1366 Text : Text_Buffer_Ptr;
1368 Mfile : Temp_File_Name := No_Mapping_File;
1370 Data : Prj.Project_Data;
1372 Arg_Index : Natural;
1373 -- Index in Special_Args.Table of a given compilation file
1375 Need_To_Check_Standard_Library : Boolean := Check_Readonly_Files;
1377 Mapping_File_Arg : constant String_Access := new String'
1378 (1 => '-', 2 => 'g', 3 => 'n', 4 => 'a', 5 => 't', 6 => 'e', 7 => 'm',
1379 8 .. 7 + Mfile
'Length => ' ');
1381 procedure Add_Process
1383 Sfile
: File_Name_Type
;
1384 Afile
: File_Name_Type
;
1385 Uname
: Unit_Name_Type
;
1386 Mfile
: Temp_File_Name
:= No_Mapping_File
;
1387 UMfile
: Boolean := False);
1388 -- Adds process Pid to the current list of outstanding compilation
1389 -- processes and record the full name of the source file Sfile that
1390 -- we are compiling, the name of its library file Afile and the
1391 -- name of its unit Uname.
1393 procedure Await_Compile
1394 (Sfile
: out File_Name_Type
;
1395 Afile
: out File_Name_Type
;
1396 Uname
: out Unit_Name_Type
;
1398 -- Awaits that an outstanding compilation process terminates. When
1399 -- it does set Sfile to the name of the source file that was compiled
1400 -- Afile to the name of its library file and Uname to the name of its
1401 -- unit. Note that this time stamp can be used to check whether the
1402 -- compilation did generate an object file. OK is set to True if the
1403 -- compilation succeeded. Note that Sfile, Afile and Uname could be
1404 -- resp. No_File, No_File and No_Name if there were no compilations
1407 procedure Collect_Arguments_And_Compile
(Source_File
: File_Name_Type
);
1408 -- Collect arguments from project file (if any) and compile
1410 package Good_ALI
is new Table
.Table
(
1411 Table_Component_Type
=> ALI_Id
,
1412 Table_Index_Type
=> Natural,
1413 Table_Low_Bound
=> 1,
1414 Table_Initial
=> 50,
1415 Table_Increment
=> 100,
1416 Table_Name
=> "Make.Good_ALI");
1417 -- Contains the set of valid ALI files that have not yet been scanned.
1419 procedure Record_Good_ALI
(A
: ALI_Id
);
1420 -- Records in the previous set the Id of an ALI file.
1422 function Good_ALI_Present
return Boolean;
1423 -- Returns True if any ALI file was recorded in the previous set.
1425 function Get_Next_Good_ALI
return ALI_Id
;
1426 -- Returns the next good ALI_Id record;
1428 procedure Record_Failure
1429 (File
: File_Name_Type
;
1430 Unit
: Unit_Name_Type
;
1431 Found
: Boolean := True);
1432 -- Records in the previous table that the compilation for File failed.
1433 -- If Found is False then the compilation of File failed because we
1434 -- could not find it. Records also Unit when possible.
1436 function Bad_Compilation_Count
return Natural;
1437 -- Returns the number of compilation failures.
1439 procedure Debug_Msg
(S
: String; N
: Name_Id
);
1440 -- If Debug.Debug_Flag_W is set outputs string S followed by name N.
1442 function Configuration_Pragmas_Switch
1443 (For_Project
: Project_Id
)
1444 return Argument_List
;
1445 -- Return an argument list of one element, if there is a configuration
1446 -- pragmas file to be specified for For_Project,
1447 -- otherwise return an empty argument list.
1449 procedure Get_Mapping_File
;
1450 -- Get a mapping file name. If there is one to be reused, reuse it.
1451 -- Otherwise, create a new mapping file.
1457 procedure Add_Process
1459 Sfile
: File_Name_Type
;
1460 Afile
: File_Name_Type
;
1461 Uname
: Unit_Name_Type
;
1462 Mfile
: Temp_File_Name
:= No_Mapping_File
;
1463 UMfile
: Boolean := False)
1465 OC1
: constant Positive := Outstanding_Compiles
+ 1;
1468 pragma Assert
(OC1
<= Max_Process
);
1469 pragma Assert
(Pid
/= Invalid_Pid
);
1471 Running_Compile
(OC1
).Pid
:= Pid
;
1472 Running_Compile
(OC1
).Full_Source_File
:= Sfile
;
1473 Running_Compile
(OC1
).Lib_File
:= Afile
;
1474 Running_Compile
(OC1
).Source_Unit
:= Uname
;
1475 Running_Compile
(OC1
).Mapping_File
:= Mfile
;
1476 Running_Compile
(OC1
).Use_Mapping_File
:= UMfile
;
1477 Running_Compile
(OC1
).Syntax_Only
:= Syntax_Only
;
1479 Outstanding_Compiles
:= OC1
;
1482 --------------------
1486 procedure Await_Compile
1487 (Sfile
: out File_Name_Type
;
1488 Afile
: out File_Name_Type
;
1489 Uname
: out File_Name_Type
;
1495 pragma Assert
(Outstanding_Compiles
> 0);
1502 Wait_Process
(Pid
, OK
);
1504 if Pid
= Invalid_Pid
then
1508 for J
in Running_Compile
'First .. Outstanding_Compiles
loop
1509 if Pid
= Running_Compile
(J
).Pid
then
1510 Sfile
:= Running_Compile
(J
).Full_Source_File
;
1511 Afile
:= Running_Compile
(J
).Lib_File
;
1512 Uname
:= Running_Compile
(J
).Source_Unit
;
1513 Syntax_Only
:= Running_Compile
(J
).Syntax_Only
;
1515 -- If a mapping file was used by this compilation,
1516 -- get its file name for reuse by a subsequent compilation
1518 if Running_Compile
(J
).Use_Mapping_File
then
1519 Last_Mapping_File_Name
:= Last_Mapping_File_Name
+ 1;
1520 The_Mapping_File_Names
(Last_Mapping_File_Name
) :=
1521 Running_Compile
(J
).Mapping_File
;
1524 -- To actually remove this Pid and related info from
1525 -- Running_Compile replace its entry with the last valid
1526 -- entry in Running_Compile.
1528 if J
= Outstanding_Compiles
then
1532 Running_Compile
(J
) :=
1533 Running_Compile
(Outstanding_Compiles
);
1536 Outstanding_Compiles
:= Outstanding_Compiles
- 1;
1541 raise Program_Error
;
1544 ---------------------------
1545 -- Bad_Compilation_Count --
1546 ---------------------------
1548 function Bad_Compilation_Count
return Natural is
1550 return Bad_Compilation
.Last
- Bad_Compilation
.First
+ 1;
1551 end Bad_Compilation_Count
;
1553 -----------------------------------
1554 -- Collect_Arguments_And_Compile --
1555 -----------------------------------
1557 procedure Collect_Arguments_And_Compile
(Source_File
: File_Name_Type
) is
1560 -- If we use mapping file (-P or -C switches), then get one
1562 if Create_Mapping_File
then
1566 -- If no project file is used, then just call Compile with
1567 -- the specified Args.
1569 if Main_Project
= No_Project
then
1570 Pid
:= Compile
(Full_Source_File
, Lib_File
, Args
);
1572 -- A project file was used
1575 -- First check if the current source is an immediate
1576 -- source of a project file.
1578 if Opt
.Verbose_Mode
then
1580 Write_Line
("Establishing Project context.");
1584 Source_File_Name
: constant String :=
1585 Get_Name_String
(Source_File
);
1586 Current_Project
: Prj
.Project_Id
;
1587 Path_Name
: File_Name_Type
:= Source_File
;
1588 Compiler_Package
: Prj
.Package_Id
;
1589 Switches
: Prj
.Variable_Value
;
1590 Object_File
: String_Access
;
1593 if Opt
.Verbose_Mode
then
1594 Write_Str
("Checking if the Project File exists for """);
1595 Write_Str
(Source_File_Name
);
1601 (Source_File_Name
=> Source_File_Name
,
1602 Project
=> Current_Project
,
1605 if Current_Project
= No_Project
then
1607 -- The current source is not an immediate source of any
1608 -- project file. Call Compile with the specified Args plus
1609 -- the saved gcc switches.
1611 if Opt
.Verbose_Mode
then
1612 Write_Str
("No Project File.");
1619 Args
& The_Saved_Gcc_Switches
.all);
1621 -- We now know the project of the current source
1624 -- Set ADA_INCLUDE_PATH and ADA_OBJECTS_PATH if the project
1627 -- Note: this will modify these environment variables only
1628 -- for the current gnatmake process and all of its children
1629 -- (invocations of the compiler, the binder and the linker).
1631 -- The caller's ADA_INCLUDE_PATH and ADA_OBJECTS_PATH are
1634 Set_Ada_Paths
(Current_Project
, True);
1636 Data
:= Projects
.Table
(Current_Project
);
1638 -- Check if it is a library project that needs to be
1639 -- processed, only if it is not the main project.
1641 if MLib
.Tgt
.Libraries_Are_Supported
1642 and then Current_Project
/= Main_Project
1643 and then Data
.Library
1644 and then not Data
.Flag1
1646 -- Add to the Q all sources of the project that have
1649 Insert_Project_Sources
1650 (The_Project
=> Current_Project
, Into_Q
=> True);
1652 -- Now mark the project as processed
1655 Projects
.Table
(Current_Project
).Flag1
:= True;
1658 Get_Name_String
(Data
.Object_Directory
);
1660 if Name_Buffer
(Name_Len
) = '/'
1661 or else Name_Buffer
(Name_Len
) = Directory_Separator
1665 (Name_Buffer (1 .. Name_Len) &
1666 Object_File_Name (Source_File_Name));
1671 (Name_Buffer
(1 .. Name_Len
) &
1672 Directory_Separator
&
1673 Object_File_Name
(Source_File_Name
));
1676 if Opt
.Verbose_Mode
then
1677 Write_Str
("Project file is """);
1678 Write_Str
(Get_Name_String
(Data
.Name
));
1683 -- We know look for package Compiler
1684 -- and get the switches from this package.
1686 if Opt
.Verbose_Mode
then
1687 Write_Str
("Checking package Compiler.");
1693 (Name
=> Name_Compiler
,
1694 In_Packages
=> Data
.Decl
.Packages
);
1696 if Compiler_Package
/= No_Package
then
1698 if Opt
.Verbose_Mode
then
1699 Write_Str
("Getting the switches.");
1703 -- If package Gnatmake.Compiler exists, we get
1704 -- the specific switches for the current source,
1705 -- or the global switches, if any.
1707 Switches
:= Switches_Of
1708 (Source_File
=> Source_File
,
1709 Source_File_Name
=> Source_File_Name
,
1711 Projects
.Table
(Current_Project
).Naming
,
1712 In_Package
=> Compiler_Package
,
1713 Allow_ALI
=> False);
1717 case Switches
.Kind
is
1719 -- We have a list of switches. We add to Args
1720 -- these switches, plus the saved gcc switches.
1725 Current
: String_List_Id
:= Switches
.Values
;
1726 Element
: String_Element
;
1727 Number
: Natural := 0;
1730 while Current
/= Nil_String
loop
1731 Element
:= String_Elements
.Table
(Current
);
1732 Number
:= Number
+ 1;
1733 Current
:= Element
.Next
;
1737 New_Args
: Argument_List
(1 .. Number
);
1740 Current
:= Switches
.Values
;
1742 for Index
in New_Args
'Range loop
1743 Element
:= String_Elements
.Table
(Current
);
1744 String_To_Name_Buffer
(Element
.Value
);
1746 new String' (Name_Buffer (1 .. Name_Len));
1747 Test_If_Relative_Path
1748 (New_Args (Index), Parent => null);
1749 Current := Element.Next;
1755 Args & Output_Flag & Object_File &
1756 Configuration_Pragmas_Switch
1758 New_Args & The_Saved_Gcc_Switches.all);
1762 -- We have a single switch. We add to Args
1763 -- this switch, plus the saved gcc switches.
1766 String_To_Name_Buffer (Switches.Value);
1769 New_Args : Argument_List :=
1771 (Name_Buffer
(1 .. Name_Len
)));
1774 Test_If_Relative_Path
1775 (New_Args
(1), Parent
=> null);
1783 Configuration_Pragmas_Switch
(Current_Project
) &
1784 The_Saved_Gcc_Switches
.all);
1787 -- We have no switches from Gnatmake.Compiler.
1788 -- We add to Args the saved gcc switches.
1791 if Opt
.Verbose_Mode
then
1792 Write_Str
("There are no switches.");
1799 Args
& Output_Flag
& Object_File
&
1800 Configuration_Pragmas_Switch
(Current_Project
) &
1801 The_Saved_Gcc_Switches
.all);
1806 end Collect_Arguments_And_Compile
;
1812 function Compile
(S
: Name_Id
; L
: Name_Id
; Args
: Argument_List
)
1815 Comp_Args
: Argument_List
(Args
'First .. Args
'Last + 8);
1816 Comp_Next
: Integer := Args
'First;
1817 Comp_Last
: Integer;
1819 function Ada_File_Name
(Name
: Name_Id
) return Boolean;
1820 -- Returns True if Name is the name of an ada source file
1821 -- (i.e. suffix is .ads or .adb)
1827 function Ada_File_Name
(Name
: Name_Id
) return Boolean is
1829 Get_Name_String
(Name
);
1832 and then Name_Buffer
(Name_Len
- 3 .. Name_Len
- 1) = ".ad"
1833 and then (Name_Buffer
(Name_Len
) = 'b'
1835 Name_Buffer
(Name_Len
) = 's');
1838 -- Start of processing for Compile
1841 -- By default, Syntax_Only is False
1843 Syntax_Only
:= False;
1845 for J
in Args
'Range loop
1846 if Args
(J
).all = "-gnats" then
1848 -- If we compile with -gnats, the bind step and the link step
1849 -- are inhibited. Also, we set Syntax_Only to True, so that
1850 -- we don't fail when we don't find the ALI file, after
1853 Do_Bind_Step
:= False;
1854 Do_Link_Step
:= False;
1855 Syntax_Only
:= True;
1857 elsif Args
(J
).all = "-gnatc" then
1859 -- If we compile with -gnatc, the bind step and the link step
1860 -- are inhibited. We set Syntax_Only to True for the case when
1861 -- -gnats was previously specified.
1863 Do_Bind_Step
:= False;
1864 Do_Link_Step
:= False;
1865 Syntax_Only
:= False;
1869 Comp_Args
(Comp_Next
) := Comp_Flag
;
1870 Comp_Next
:= Comp_Next
+ 1;
1872 -- Optimize the simple case where the gcc command line looks like
1873 -- gcc -c -I. ... -I- file.adb --into-> gcc -c ... file.adb
1875 if Args
(Args
'First).all = "-I" & Normalized_CWD
1876 and then Args
(Args
'Last).all = "-I-"
1877 and then S
= Strip_Directory
(S
)
1879 Comp_Last
:= Comp_Next
+ Args
'Length - 3;
1880 Comp_Args
(Comp_Next
.. Comp_Last
) :=
1881 Args
(Args
'First + 1 .. Args
'Last - 1);
1884 Comp_Last
:= Comp_Next
+ Args
'Length - 1;
1885 Comp_Args
(Comp_Next
.. Comp_Last
) := Args
;
1888 -- Set -gnatpg for predefined files (for this purpose the renamings
1889 -- such as Text_IO do not count as predefined). Note that we strip
1890 -- the directory name from the source file name becase the call to
1891 -- Fname.Is_Predefined_File_Name cannot deal with directory prefixes.
1894 Fname
: constant File_Name_Type
:= Strip_Directory
(S
);
1897 if Is_Predefined_File_Name
(Fname
, False) then
1898 if Check_Readonly_Files
then
1899 Comp_Last
:= Comp_Last
+ 1;
1900 Comp_Args
(Comp_Last
) := GNAT_Flag
;
1904 ("not allowed to compile """ &
1905 Get_Name_String
(Fname
) &
1906 """; use -a switch.");
1911 -- Now check if the file name has one of the suffixes familiar to
1912 -- the gcc driver. If this is not the case then add the ada flag
1915 if not Ada_File_Name
(S
) then
1916 Comp_Last
:= Comp_Last
+ 1;
1917 Comp_Args
(Comp_Last
) := Ada_Flag_1
;
1918 Comp_Last
:= Comp_Last
+ 1;
1919 Comp_Args
(Comp_Last
) := Ada_Flag_2
;
1922 if L
/= Strip_Directory
(L
) then
1924 -- Build -o argument.
1926 Get_Name_String
(L
);
1928 for J
in reverse 1 .. Name_Len
loop
1929 if Name_Buffer
(J
) = '.' then
1930 Name_Len
:= J
+ Object_Suffix
'Length - 1;
1931 Name_Buffer
(J
.. Name_Len
) := Object_Suffix
;
1936 Comp_Last
:= Comp_Last
+ 1;
1937 Comp_Args
(Comp_Last
) := Output_Flag
;
1938 Comp_Last
:= Comp_Last
+ 1;
1939 Comp_Args
(Comp_Last
) := new String'(Name_Buffer (1 .. Name_Len));
1942 if Create_Mapping_File then
1943 Comp_Last := Comp_Last + 1;
1944 Comp_Args (Comp_Last) := Mapping_File_Arg;
1947 Get_Name_String (S);
1949 Comp_Last := Comp_Last + 1;
1950 Comp_Args (Comp_Last) := new String'(Name_Buffer
(1 .. Name_Len
));
1952 GNAT
.OS_Lib
.Normalize_Arguments
(Comp_Args
(Args
'First .. Comp_Last
));
1954 Display
(Gcc
.all, Comp_Args
(Args
'First .. Comp_Last
));
1956 if Gcc_Path
= null then
1957 Osint
.Fail
("error, unable to locate " & Gcc
.all);
1961 GNAT
.OS_Lib
.Non_Blocking_Spawn
1962 (Gcc_Path
.all, Comp_Args
(Args
'First .. Comp_Last
));
1965 ----------------------------------
1966 -- Configuration_Pragmas_Switch --
1967 ----------------------------------
1969 function Configuration_Pragmas_Switch
1970 (For_Project
: Project_Id
)
1971 return Argument_List
1974 Prj
.Env
.Create_Config_Pragmas_File
(For_Project
, Main_Project
);
1976 if Projects
.Table
(For_Project
).Config_File_Name
/= No_Name
then
1978 (1 => new String'("-gnatec" &
1980 (Projects.Table (For_Project).Config_File_Name)));
1983 return (1 .. 0 => null);
1985 end Configuration_Pragmas_Switch;
1991 procedure Debug_Msg (S : String; N : Name_Id) is
1993 if Debug.Debug_Flag_W then
1994 Write_Str (" ... ");
2002 ----------------------
2003 -- Get_Mapping_File --
2004 ----------------------
2006 procedure Get_Mapping_File is
2008 -- If there is a mapping file ready to be reused, reuse it
2010 if Last_Mapping_File_Name > 0 then
2011 Mfile := The_Mapping_File_Names (Last_Mapping_File_Name);
2012 Last_Mapping_File_Name := Last_Mapping_File_Name - 1;
2014 -- Otherwise, create and initialize a new one
2017 Init_Mapping_File (File_Name => Mfile);
2020 -- Put the name in the mapping file argument for the invocation
2023 Mapping_File_Arg (8 .. Mapping_File_Arg'Last) := Mfile;
2025 end Get_Mapping_File;
2027 -----------------------
2028 -- Get_Next_Good_ALI --
2029 -----------------------
2031 function Get_Next_Good_ALI return ALI_Id is
2035 pragma Assert (Good_ALI_Present);
2036 ALI := Good_ALI.Table (Good_ALI.Last);
2037 Good_ALI.Decrement_Last;
2039 end Get_Next_Good_ALI;
2041 ----------------------
2042 -- Good_ALI_Present --
2043 ----------------------
2045 function Good_ALI_Present return Boolean is
2047 return Good_ALI.First <= Good_ALI.Last;
2048 end Good_ALI_Present;
2050 --------------------
2051 -- Record_Failure --
2052 --------------------
2054 procedure Record_Failure
2055 (File : File_Name_Type;
2056 Unit : Unit_Name_Type;
2057 Found : Boolean := True)
2060 Bad_Compilation.Increment_Last;
2061 Bad_Compilation.Table (Bad_Compilation.Last) := (File, Unit, Found);
2064 ---------------------
2065 -- Record_Good_ALI --
2066 ---------------------
2068 procedure Record_Good_ALI (A : ALI_Id) is
2070 Good_ALI.Increment_Last;
2071 Good_ALI.Table (Good_ALI.Last) := A;
2072 end Record_Good_ALI;
2074 -- Start of processing for Compile_Sources
2077 pragma Assert (Args'First = 1);
2079 -- Package and Queue initializations.
2082 Output.Set_Standard_Error;
2085 if Initialize_ALI_Data then
2087 Initialize_ALI_Source;
2090 -- The following two flags affect the behavior of ALI.Set_Source_Table.
2091 -- We set Opt.Check_Source_Files to True to ensure that source file
2092 -- time stamps are checked, and we set Opt.All_Sources to False to
2093 -- avoid checking the presence of the source files listed in the
2094 -- source dependency section of an ali file (which would be a mistake
2095 -- since the ali file may be obsolete).
2097 Opt.Check_Source_Files := True;
2098 Opt.All_Sources := False;
2100 -- If the main source is marked, there is nothing to compile.
2101 -- This can happen when we have several main subprograms.
2102 -- For the first main, we always insert in the Q.
2104 if not Is_Marked (Main_Source) then
2105 Insert_Q (Main_Source);
2109 First_Compiled_File := No_File;
2110 Most_Recent_Obj_File := No_File;
2113 -- Keep looping until there is no more work to do (the Q is empty)
2114 -- and all the outstanding compilations have terminated
2116 Make_Loop : while not Empty_Q or else Outstanding_Compiles > 0 loop
2118 -- If the user does not want to keep going in case of errors then
2119 -- wait for the remaining outstanding compiles and then exit.
2121 if Bad_Compilation_Count > 0 and then not Keep_Going then
2122 while Outstanding_Compiles > 0 loop
2124 (Full_Source_File, Lib_File, Source_Unit, Compilation_OK);
2126 if not Compilation_OK then
2127 Record_Failure (Full_Source_File, Source_Unit);
2134 -- PHASE 1: Check if there is more work that we can do (ie the Q
2135 -- is non empty). If there is, do it only if we have not yet used
2136 -- up all the available processes.
2138 if not Empty_Q and then Outstanding_Compiles < Max_Process then
2139 Extract_From_Q (Source_File, Source_Unit);
2140 Full_Source_File := Osint.Full_Source_Name (Source_File);
2141 Lib_File := Osint.Lib_File_Name (Source_File);
2142 Full_Lib_File := Osint.Full_Lib_File_Name (Lib_File);
2144 -- If the library file is an Ada library skip it
2146 if Full_Lib_File /= No_File
2147 and then In_Ada_Lib_Dir (Full_Lib_File)
2149 Verbose_Msg (Lib_File, "is in an Ada library", Prefix => " ");
2151 -- If the library file is a read-only library skip it
2153 elsif Full_Lib_File /= No_File
2154 and then not Check_Readonly_Files
2155 and then Is_Readonly_Library (Full_Lib_File)
2158 (Lib_File, "is a read-only library", Prefix => " ");
2160 -- The source file that we are checking cannot be located
2162 elsif Full_Source_File = No_File then
2163 Record_Failure (Source_File, Source_Unit, False);
2165 -- Source and library files can be located but are internal
2168 elsif not Check_Readonly_Files
2169 and then Full_Lib_File /= No_File
2170 and then Is_Internal_File_Name (Source_File)
2173 if Force_Compilations then
2175 ("not allowed to compile """ &
2176 Get_Name_String (Source_File) &
2177 """; use -a switch.");
2181 (Lib_File, "is an internal library", Prefix => " ");
2183 -- The source file that we are checking can be located
2186 -- Don't waste any time if we have to recompile anyway
2188 Obj_Stamp := Empty_Time_Stamp;
2189 Need_To_Compile := Force_Compilations;
2191 if not Force_Compilations then
2192 Check (Lib_File, ALI, Obj_File, Obj_Stamp);
2193 Need_To_Compile := (ALI = No_ALI_Id);
2196 if not Need_To_Compile then
2198 -- The ALI file is up-to-date. Record its Id.
2200 Record_Good_ALI (ALI);
2202 -- Record the time stamp of the most recent object file
2203 -- as long as no (re)compilations are needed.
2205 if First_Compiled_File = No_File
2206 and then (Most_Recent_Obj_File = No_File
2207 or else Obj_Stamp > Most_Recent_Obj_Stamp)
2209 Most_Recent_Obj_File := Obj_File;
2210 Most_Recent_Obj_Stamp := Obj_Stamp;
2214 -- Is this the first file we have to compile?
2216 if First_Compiled_File = No_File then
2217 First_Compiled_File := Full_Source_File;
2218 Most_Recent_Obj_File := No_File;
2220 if Do_Not_Execute then
2225 if In_Place_Mode then
2227 -- If the library file was not found, then save the
2228 -- library file near the source file.
2230 if Full_Lib_File = No_File then
2231 Get_Name_String (Full_Source_File);
2233 for J in reverse 1 .. Name_Len loop
2234 if Name_Buffer (J) = '.' then
2235 Name_Buffer (J + 1 .. J + 3) := "ali";
2241 Lib_File := Name_Find;
2243 -- If the library file was found, then save the
2244 -- library file in the same place.
2247 Lib_File := Full_Lib_File;
2252 -- Check for special compilation flags
2256 -- Start the compilation and record it. We can do this
2257 -- because there is at least one free process.
2259 Collect_Arguments_And_Compile (Source_File);
2261 -- Make sure we could successfully start the compilation
2263 if Pid = Invalid_Pid then
2264 Record_Failure (Full_Source_File, Source_Unit);
2272 Create_Mapping_File);
2278 -- PHASE 2: Now check if we should wait for a compilation to
2279 -- finish. This is the case if all the available processes are
2280 -- busy compiling sources or there is nothing else to do
2281 -- (that is the Q is empty and there are no good ALIs to process).
2283 if Outstanding_Compiles = Max_Process
2285 and then not Good_ALI_Present
2286 and then Outstanding_Compiles > 0)
2289 (Full_Source_File, Lib_File, Source_Unit, Compilation_OK);
2291 if not Compilation_OK then
2292 Record_Failure (Full_Source_File, Source_Unit);
2295 if Compilation_OK or else Keep_Going then
2297 -- Re-read the updated library file
2300 Saved_Object_Consistency : constant Boolean :=
2301 Opt.Check_Object_Consistency;
2304 -- If compilation was not OK, don't check object
2307 Opt.Check_Object_Consistency :=
2308 Opt.Check_Object_Consistency and Compilation_OK;
2309 Text := Read_Library_Info (Lib_File);
2311 -- Restore Check_Object_Consistency to its initial value
2313 Opt.Check_Object_Consistency := Saved_Object_Consistency;
2316 -- If no ALI file was generated by this compilation nothing
2317 -- more to do, otherwise scan the ali file and record it.
2318 -- If the scan fails, a previous ali file is inconsistent with
2319 -- the unit just compiled.
2321 if Text /= null then
2323 Scan_ALI (Lib_File, Text, Ignore_ED => False, Err => True);
2325 if ALI = No_ALI_Id then
2327 -- Record a failure only if not already done
2329 if Compilation_OK then
2332 "incompatible ALI file, please recompile");
2333 Record_Failure (Full_Source_File, Source_Unit);
2337 Record_Good_ALI (ALI);
2340 -- If we could not read the ALI file that was just generated
2341 -- then there could be a problem reading either the ALI or the
2342 -- corresponding object file (if Opt.Check_Object_Consistency
2343 -- is set Read_Library_Info checks that the time stamp of the
2344 -- object file is more recent than that of the ALI). For an
2345 -- example of problems caught by this test see [6625-009].
2346 -- However, we record a failure only if not already done.
2349 if Compilation_OK and not Syntax_Only then
2352 "WARNING: ALI or object file not found after compile");
2353 Record_Failure (Full_Source_File, Source_Unit);
2359 exit Make_Loop when Unique_Compile;
2361 -- PHASE 3: Check if we recorded good ALI files. If yes process
2362 -- them now in the order in which they have been recorded. There
2363 -- are two occasions in which we record good ali files. The first is
2364 -- in phase 1 when, after scanning an existing ALI file we realise
2365 -- it is up-to-date, the second instance is after a successful
2368 while Good_ALI_Present loop
2369 ALI := Get_Next_Good_ALI;
2371 -- If we are processing the library file corresponding to the
2372 -- main source file check if this source can be a main unit.
2374 if ALIs.Table (ALI).Sfile = Main_Source then
2375 Main_Unit := ALIs.Table (ALI).Main_Program /= None;
2378 -- The following adds the standard library (s-stalib) to the
2379 -- list of files to be handled by gnatmake: this file and any
2380 -- files it depends on are always included in every bind,
2381 -- except in No_Run_Time mode, even if they are not
2382 -- in the explicit dependency list.
2384 -- However, to avoid annoying output about s-stalib.ali being
2385 -- read only, when "-v" is used, we add the standard library
2386 -- only when "-a" is used.
2388 if Need_To_Check_Standard_Library then
2389 Need_To_Check_Standard_Library := False;
2391 if not ALIs.Table (ALI).No_Run_Time then
2394 Add_It : Boolean := True;
2397 Name_Len := Standard_Library_Package_Body_Name'Length;
2398 Name_Buffer (1 .. Name_Len) :=
2399 Standard_Library_Package_Body_Name;
2400 Sfile := Name_Enter;
2402 -- If we have a special runtime, we add the standard
2403 -- library only if we can find it.
2405 if Opt.RTS_Switch then
2406 Add_It := Find_File (Sfile, Osint.Source) /= No_File;
2409 if Add_It and then not Is_Marked (Sfile) then
2417 -- Now insert in the Q the unmarked source files (i.e. those
2418 -- which have neever been inserted in the Q and hence never
2422 ALIs.Table (ALI).First_Unit .. ALIs.Table (ALI).Last_Unit
2425 Units.Table (J).First_With .. Units.Table (J).Last_With
2427 Sfile := Withs.Table (K).Sfile;
2429 if Sfile = No_File then
2430 Debug_Msg ("Skipping generic:", Withs.Table (K).Uname);
2432 elsif Is_Marked (Sfile) then
2433 Debug_Msg ("Skipping marked file:", Sfile);
2435 elsif not Check_Readonly_Files
2436 and then Is_Internal_File_Name (Sfile)
2438 Debug_Msg ("Skipping internal file:", Sfile);
2441 Insert_Q (Sfile, Withs.Table (K).Uname);
2448 if Opt.Display_Compilation_Progress then
2449 Write_Str ("completed ");
2450 Write_Int (Int (Q_Front));
2451 Write_Str (" out of ");
2452 Write_Int (Int (Q.Last));
2454 Write_Int (Int ((Q_Front * 100) / (Q.Last - Q.First)));
2455 Write_Str ("%)...");
2460 Compilation_Failures := Bad_Compilation_Count;
2462 -- Compilation is finished
2464 -- Delete any temporary configuration pragma file
2466 if Main_Project /= No_Project then
2471 for Project in 1 .. Projects.Last loop
2472 if Projects.Table (Project).Config_File_Temp then
2473 if Opt.Verbose_Mode then
2474 Write_Str ("Deleting temp configuration file """);
2475 Write_Str (Get_Name_String
2476 (Projects.Table (Project).Config_File_Name));
2481 (Name => Get_Name_String
2482 (Projects.Table (Project).Config_File_Name),
2483 Success => Success);
2485 -- Make sure that we don't have a config file for this
2486 -- project, in case when there are several mains.
2487 -- In this case, we will recreate another config file:
2488 -- we cannot reuse the one that we just deleted!
2490 Projects.Table (Project).Config_Checked := False;
2491 Projects.Table (Project).Config_File_Name := No_Name;
2492 Projects.Table (Project).Config_File_Temp := False;
2497 end Compile_Sources;
2499 --------------------------
2500 -- Delete_Mapping_Files --
2501 --------------------------
2503 procedure Delete_Mapping_Files is
2507 for Index in 1 .. Last_Mapping_File_Name loop
2509 (Name => The_Mapping_File_Names (Index), Success => Success);
2511 end Delete_Mapping_Files;
2517 procedure Display (Program : String; Args : Argument_List) is
2519 pragma Assert (Args'First = 1);
2521 if Display_Executed_Programs then
2522 Write_Str (Program);
2524 for J in Args'Range loop
2526 -- Do not display the mapping file argument automatically
2527 -- created when using a project file.
2529 if Main_Project = No_Project
2530 or else Args (J)'Length /= 7 + Temp_File_Name'Length
2531 or else Args (J)'First /= 1
2532 or else Args (J)(1 .. 7) /= "-gnatem"
2535 Write_Str (Args (J).all);
2543 ----------------------
2544 -- Display_Commands --
2545 ----------------------
2547 procedure Display_Commands (Display : Boolean := True) is
2549 Display_Executed_Programs := Display;
2550 end Display_Commands;
2556 function Empty_Q return Boolean is
2558 if Debug.Debug_Flag_P then
2559 Write_Str (" Q := [");
2561 for J in Q_Front .. Q.Last - 1 loop
2563 Write_Name (Q.Table (J).File);
2572 return Q_Front >= Q.Last;
2575 ---------------------
2576 -- Extract_Failure --
2577 ---------------------
2579 procedure Extract_Failure
2580 (File : out File_Name_Type;
2581 Unit : out Unit_Name_Type;
2582 Found : out Boolean)
2585 File := Bad_Compilation.Table (Bad_Compilation.Last).File;
2586 Unit := Bad_Compilation.Table (Bad_Compilation.Last).Unit;
2587 Found := Bad_Compilation.Table (Bad_Compilation.Last).Found;
2588 Bad_Compilation.Decrement_Last;
2589 end Extract_Failure;
2591 --------------------
2592 -- Extract_From_Q --
2593 --------------------
2595 procedure Extract_From_Q
2596 (Source_File : out File_Name_Type;
2597 Source_Unit : out Unit_Name_Type)
2599 File : constant File_Name_Type := Q.Table (Q_Front).File;
2600 Unit : constant Unit_Name_Type := Q.Table (Q_Front).Unit;
2603 if Debug.Debug_Flag_Q then
2604 Write_Str (" Q := Q - [ ");
2610 Q_Front := Q_Front + 1;
2611 Source_File := File;
2612 Source_Unit := Unit;
2619 procedure Gnatmake is
2620 Main_Source_File : File_Name_Type;
2621 -- The source file containing the main compilation unit
2623 Compilation_Failures : Natural;
2625 Total_Compilation_Failures : Natural := 0;
2627 Is_Main_Unit : Boolean;
2628 -- Set to True by Compile_Sources if the Main_Source_File can be a
2631 Main_ALI_File : File_Name_Type;
2632 -- The ali file corresponding to Main_Source_File
2634 Executable : File_Name_Type := No_File;
2635 -- The file name of an executable
2637 Non_Std_Executable : Boolean := False;
2638 -- Non_Std_Executable is set to True when there is a possibility
2639 -- that the linker will not choose the correct executable file name.
2641 Executable_Obsolete : Boolean := False;
2642 -- Executable_Obsolete is set to True for the first obsolete main
2643 -- and is never reset to False. Any subsequent main will always
2644 -- be rebuild (if we rebuild mains), even in the case when it is not
2645 -- really necessary, because it is too hard to decide.
2647 Current_Work_Dir : constant String_Access :=
2648 new String'(Get_Current_Dir
);
2649 -- The current working directory, used to modify some relative path
2650 -- switches on the command line when a project file is used.
2653 Do_Compile_Step
:= True;
2654 Do_Bind_Step
:= True;
2655 Do_Link_Step
:= True;
2659 if Hostparm
.Java_VM
then
2660 Gcc
:= new String'("jgnat");
2661 Gnatbind := new String'("jgnatbind");
2662 Gnatlink
:= new String '("jgnatlink");
2664 -- Do not check for an object file (".o") when compiling to
2665 -- Java bytecode since ".class" files are generated instead.
2667 Opt.Check_Object_Consistency := False;
2670 if Opt.Verbose_Mode then
2671 Targparm.Get_Target_Parameters;
2674 Write_Str ("GNATMAKE ");
2676 if Targparm.High_Integrity_Mode_On_Target then
2677 Write_Str ("Pro High Integrity ");
2680 Write_Str (Gnatvsn.Gnat_Version_String);
2681 Write_Str (" Copyright 1995-2002 Free Software Foundation, Inc.");
2685 -- If no mains have been specified on the command line,
2686 -- and we are using a project file, we either find the main(s)
2687 -- in the attribute Main of the main project, or we put all
2688 -- the sources of the project file as mains.
2690 if Main_Project /= No_Project and then Osint.Number_Of_Files = 0 then
2692 Name_Buffer (1 .. 4) := "main";
2695 Main_Id : constant Name_Id := Name_Find;
2697 Mains : constant Prj.Variable_Value :=
2699 (Variable_Name => Main_Id,
2701 Projects.Table (Main_Project).Decl.Attributes);
2703 Value : String_List_Id := Mains.Values;
2706 -- The attribute Main is an empty list or not specified,
2707 -- or else gnatmake was invoked with the switch "-u".
2709 if Value = Prj.Nil_String or else Unique_Compile then
2711 -- First make sure that the binder and the linker
2712 -- will not be invoked.
2714 Do_Bind_Step := False;
2715 Do_Link_Step := False;
2717 -- Set Unique_Compile if it was not already set
2719 Unique_Compile := True;
2721 -- Put all the sources in the queue
2723 Insert_Project_Sources
2724 (The_Project => Main_Project, Into_Q => False);
2727 -- The attribute Main is not an empty list.
2728 -- Put all the main subprograms in the list as if there were
2729 -- specified on the command line.
2731 while Value /= Prj.Nil_String loop
2732 String_To_Name_Buffer (String_Elements.Table (Value).Value);
2733 Osint.Add_File (Name_Buffer (1 .. Name_Len));
2734 Value := String_Elements.Table (Value).Next;
2742 -- Output usage information if no files. Note that this can happen
2743 -- in the case of a project file that contains only subunits.
2745 if Osint.Number_Of_Files = 0 then
2747 Exit_Program (E_Fatal);
2751 -- If -M was specified, behave as if -n was specified
2753 if Opt.List_Dependencies then
2754 Opt.Do_Not_Execute := True;
2757 -- Note that Osint.Next_Main_Source will always return the (possibly
2758 -- abbreviated file) without any directory information.
2760 Main_Source_File := Next_Main_Source;
2762 if Project_File_Name = null then
2763 Add_Switch ("-I-", Compiler, And_Save => True);
2764 Add_Switch ("-I-", Binder, And_Save => True);
2766 if Opt.Look_In_Primary_Dir then
2770 Normalize_Directory_Name
2771 (Get_Primary_Src_Search_Directory.all).all,
2772 Compiler, Append_Switch => False,
2775 Add_Switch ("-aO" & Normalized_CWD,
2777 Append_Switch => False,
2783 -- If the user wants a program without a main subprogram, add the
2784 -- appropriate switch to the binder.
2786 if Opt.No_Main_Subprogram then
2787 Add_Switch ("-z", Binder, And_Save => True);
2790 if Main_Project /= No_Project then
2793 (Get_Name_String (Projects.Table (Main_Project).Object_Directory));
2795 -- Find the file name of the main unit
2798 Main_Source_File_Name : constant String :=
2799 Get_Name_String (Main_Source_File);
2800 Main_Unit_File_Name : constant String :=
2801 Prj.Env.File_Name_Of_Library_Unit_Body
2802 (Name => Main_Source_File_Name,
2803 Project => Main_Project);
2805 The_Packages : constant Package_Id :=
2806 Projects.Table (Main_Project).Decl.Packages;
2808 Gnatmake : constant Prj.Package_Id :=
2810 (Name => Name_Builder,
2811 In_Packages => The_Packages);
2813 Binder_Package : constant Prj.Package_Id :=
2815 (Name => Name_Binder,
2816 In_Packages => The_Packages);
2818 Linker_Package : constant Prj.Package_Id :=
2820 (Name => Name_Linker,
2821 In_Packages => The_Packages);
2824 -- We fail if we cannot find the main source file
2825 -- as an immediate source of the main project file.
2827 if Main_Unit_File_Name = "" then
2828 Fail ('"' & Main_Source_File_Name &
2829 """ is not a unit
of project
" &
2830 Project_File_Name.all & ".");
2832 -- Remove any directory information from the main
2833 -- source file name.
2836 Pos : Natural := Main_Unit_File_Name'Last;
2840 exit when Pos < Main_Unit_File_Name'First or else
2841 Main_Unit_File_Name (Pos) = Directory_Separator;
2845 Name_Len := Main_Unit_File_Name'Last - Pos;
2847 Name_Buffer (1 .. Name_Len) :=
2849 (Pos + 1 .. Main_Unit_File_Name'Last);
2851 Main_Source_File := Name_Find;
2853 -- We only output the main source file if there is only one
2855 if Opt.Verbose_Mode and then Osint.Number_Of_Files = 1 then
2856 Write_Str ("Main source file
: """);
2857 Write_Str (Main_Unit_File_Name
2858 (Pos + 1 .. Main_Unit_File_Name'Last));
2864 -- If there is a package gnatmake in the main project file, add
2865 -- the switches from it. We also add the switches from packages
2866 -- gnatbind and gnatlink, if any.
2868 if Gnatmake /= No_Package then
2870 -- If there is only one main, we attempt to get the gnatmake
2871 -- switches for this main (if any). If there are no specific
2872 -- switch for this particular main, get the general gnatmake
2873 -- switches (if any).
2875 if Osint.Number_Of_Files = 1 then
2876 if Opt.Verbose_Mode then
2877 Write_Str ("Adding gnatmake switches
for """);
2878 Write_Str (Main_Unit_File_Name);
2883 (File_Name => Main_Unit_File_Name,
2884 The_Package => Gnatmake,
2888 -- If there are several mains, we always get the general
2889 -- gnatmake switches (if any).
2891 -- Note: As there is never a source with name " ",
2892 -- we are guaranteed to always get the gneneral switches.
2896 The_Package => Gnatmake,
2902 if Binder_Package /= No_Package then
2904 -- If there is only one main, we attempt to get the gnatbind
2905 -- switches for this main (if any). If there are no specific
2906 -- switch for this particular main, get the general gnatbind
2907 -- switches (if any).
2909 if Osint.Number_Of_Files = 1 then
2910 if Opt.Verbose_Mode then
2911 Write_Str ("Adding binder switches
for """);
2912 Write_Str (Main_Unit_File_Name);
2917 (File_Name => Main_Unit_File_Name,
2918 The_Package => Binder_Package,
2922 -- If there are several mains, we always get the general
2923 -- gnatbind switches (if any).
2925 -- Note: As there is never a source with name " ",
2926 -- we are guaranteed to always get the gneneral switches.
2930 The_Package => Binder_Package,
2936 if Linker_Package /= No_Package then
2938 -- If there is only one main, we attempt to get the
2939 -- gnatlink switches for this main (if any). If there are
2940 -- no specific switch for this particular main, we get the
2941 -- general gnatlink switches (if any).
2943 if Osint.Number_Of_Files = 1 then
2944 if Opt.Verbose_Mode then
2945 Write_Str ("Adding linker switches
for""");
2946 Write_Str (Main_Unit_File_Name);
2951 (File_Name => Main_Unit_File_Name,
2952 The_Package => Linker_Package,
2956 -- If there are several mains, we always get the general
2957 -- gnatlink switches (if any).
2959 -- Note: As there is never a source with name " ",
2960 -- we are guaranteed to always get the general switches.
2964 The_Package => Linker_Package,
2971 Display_Commands (not Opt.Quiet_Output);
2973 -- If we are using a project file, relative paths are forbidden in the
2974 -- project file, but we add the current working directory for any
2975 -- relative path on the command line.
2977 if Main_Project /= No_Project then
2979 for J in 1 .. Binder_Switches.Last loop
2980 Test_If_Relative_Path
2981 (Binder_Switches.Table (J), Parent => null);
2984 for J in 1 .. Saved_Binder_Switches.Last loop
2985 Test_If_Relative_Path
2986 (Saved_Binder_Switches.Table (J), Parent => Current_Work_Dir);
2989 for J in 1 .. Linker_Switches.Last loop
2990 Test_If_Relative_Path
2991 (Linker_Switches.Table (J), Parent => null);
2994 for J in 1 .. Saved_Linker_Switches.Last loop
2995 Test_If_Relative_Path
2996 (Saved_Linker_Switches.Table (J), Parent => Current_Work_Dir);
2999 for J in 1 .. Gcc_Switches.Last loop
3000 Test_If_Relative_Path
3001 (Gcc_Switches.Table (J), Parent => null);
3004 for J in 1 .. Saved_Gcc_Switches.Last loop
3005 Test_If_Relative_Path
3006 (Saved_Gcc_Switches.Table (J), Parent => Current_Work_Dir);
3010 -- We now put in the Binder_Switches and Linker_Switches tables,
3011 -- the binder and linker switches of the command line that have been
3012 -- put in the Saved_ tables. If a project file was used, then the
3013 -- command line switches will follow the project file switches.
3015 for J in 1 .. Saved_Binder_Switches.Last loop
3017 (Saved_Binder_Switches.Table (J),
3022 for J in 1 .. Saved_Linker_Switches.Last loop
3024 (Saved_Linker_Switches.Table (J),
3029 -- If no project file is used, we just put the gcc switches
3030 -- from the command line in the Gcc_Switches table.
3032 if Main_Project = No_Project then
3033 for J in 1 .. Saved_Gcc_Switches.Last loop
3035 (Saved_Gcc_Switches.Table (J),
3041 -- And we put the command line gcc switches in the variable
3042 -- The_Saved_Gcc_Switches. They are going to be used later
3043 -- in procedure Compile_Sources.
3045 The_Saved_Gcc_Switches :=
3046 new Argument_List (1 .. Saved_Gcc_Switches.Last + 1);
3048 for J in 1 .. Saved_Gcc_Switches.Last loop
3049 The_Saved_Gcc_Switches (J) := Saved_Gcc_Switches.Table (J);
3052 -- We never use gnat.adc when a project file is used
3054 The_Saved_Gcc_Switches (The_Saved_Gcc_Switches'Last) :=
3059 -- If there was a --GCC, --GNATBIND or --GNATLINK switch on
3060 -- the command line, then we have to use it, even if there was
3061 -- another switch in the project file.
3063 if Saved_Gcc /= null then
3067 if Saved_Gnatbind /= null then
3068 Gnatbind := Saved_Gnatbind;
3071 if Saved_Gnatlink /= null then
3072 Gnatlink := Saved_Gnatlink;
3075 Gcc_Path := GNAT.OS_Lib.Locate_Exec_On_Path (Gcc.all);
3076 Gnatbind_Path := GNAT.OS_Lib.Locate_Exec_On_Path (Gnatbind.all);
3077 Gnatlink_Path := GNAT.OS_Lib.Locate_Exec_On_Path (Gnatlink.all);
3079 -- If we have specified -j switch both from the project file
3080 -- and on the command line, the one from the command line takes
3083 if Saved_Maximum_Processes = 0 then
3084 Saved_Maximum_Processes := Opt.Maximum_Processes;
3087 -- Allocate as many temporary mapping file names as the maximum
3088 -- number of compilation processed.
3090 The_Mapping_File_Names :=
3091 new Temp_File_Names (1 .. Saved_Maximum_Processes);
3093 -- If either -c, -b or -l has been specified, we will not necessarily
3094 -- execute all steps.
3096 if Compile_Only or else Bind_Only or else Link_Only then
3097 Do_Compile_Step := Do_Compile_Step and Compile_Only;
3098 Do_Bind_Step := Do_Bind_Step and Bind_Only;
3099 Do_Link_Step := Do_Link_Step and Link_Only;
3101 -- If -c has been specified, but not -b, ignore any potential -l
3103 if Do_Compile_Step and then not Do_Bind_Step then
3104 Do_Link_Step := False;
3108 Bad_Compilation.Init;
3110 -- Here is where the make process is started
3112 -- We do the same process for each main
3114 Multiple_Main_Loop : for N_File in 1 .. Osint.Number_Of_Files loop
3116 if Do_Compile_Step then
3117 Recursive_Compilation_Step : declare
3118 Args : Argument_List (1 .. Gcc_Switches.Last);
3120 First_Compiled_File : Name_Id;
3122 Youngest_Obj_File : Name_Id;
3123 Youngest_Obj_Stamp : Time_Stamp_Type;
3125 Executable_Stamp : Time_Stamp_Type;
3126 -- Executable is the final executable program.
3129 Executable := No_File;
3130 Non_Std_Executable := False;
3132 for J in 1 .. Gcc_Switches.Last loop
3133 Args (J) := Gcc_Switches.Table (J);
3136 -- Look inside the linker switches to see if the name
3137 -- of the final executable program was specified.
3140 J in reverse Linker_Switches.First .. Linker_Switches.Last
3142 if Linker_Switches.Table (J).all = Output_Flag.all then
3143 pragma Assert (J < Linker_Switches.Last);
3145 -- We cannot specify a single executable for several
3146 -- main subprograms!
3148 if Osint.Number_Of_Files > 1 then
3150 ("cannot specify a single executable
" &
3151 "for several mains
");
3154 Name_Len := Linker_Switches.Table (J + 1)'Length;
3155 Name_Buffer (1 .. Name_Len) :=
3156 Linker_Switches.Table (J + 1).all;
3158 -- If target has an executable suffix and it has not been
3159 -- specified then it is added here.
3161 if Executable_Suffix'Length /= 0
3162 and then Linker_Switches.Table (J + 1)
3163 (Name_Len - Executable_Suffix'Length + 1
3164 .. Name_Len) /= Executable_Suffix
3166 Name_Buffer (Name_Len + 1 ..
3167 Name_Len + Executable_Suffix'Length) :=
3169 Name_Len := Name_Len + Executable_Suffix'Length;
3172 Executable := Name_Enter;
3174 Verbose_Msg (Executable, "final executable
");
3178 -- If the name of the final executable program was not
3179 -- specified then construct it from the main input file.
3181 if Executable = No_File then
3182 if Main_Project = No_Project then
3184 Executable_Name (Strip_Suffix (Main_Source_File));
3187 -- If we are using a project file, we attempt to
3188 -- remove the body (or spec) termination of the main
3189 -- subprogram. We find it the the naming scheme of the
3190 -- project file. This will avoid to generate an
3191 -- executable "main
.2" for a main subprogram
3192 -- "main
.2.ada
", when the body termination is ".2.ada
".
3195 Body_Append : constant String :=
3199 Naming.Current_Impl_Suffix);
3201 Spec_Append : constant String :=
3205 Naming.Current_Spec_Suffix);
3208 Get_Name_String (Main_Source_File);
3210 if Name_Len > Body_Append'Length
3211 and then Name_Buffer
3212 (Name_Len - Body_Append'Length + 1 .. Name_Len) =
3215 -- We have found the body termination. We remove it
3216 -- add the executable termination, if any.
3218 Name_Len := Name_Len - Body_Append'Length;
3219 Executable := Executable_Name (Name_Find);
3221 elsif Name_Len > Spec_Append'Length
3224 (Name_Len - Spec_Append'Length + 1 .. Name_Len) =
3227 -- We have found the spec termination. We remove
3228 -- it, add the executable termination, if any.
3230 Name_Len := Name_Len - Spec_Append'Length;
3231 Executable := Executable_Name (Name_Find);
3235 Executable_Name (Strip_Suffix (Main_Source_File));
3242 if Main_Project /= No_Project then
3244 Exec_File_Name : constant String :=
3245 Get_Name_String (Executable);
3248 if not Is_Absolute_Path (Exec_File_Name) then
3249 for Index in Exec_File_Name'Range loop
3250 if Exec_File_Name (Index) = Directory_Separator then
3251 Fail ("relative executable
(""" &
3253 """) with directory part
not allowed
" &
3254 "when using project files
");
3258 Get_Name_String (Projects.Table
3259 (Main_Project).Exec_Directory);
3262 Name_Buffer (Name_Len) /= Directory_Separator
3264 Name_Len := Name_Len + 1;
3265 Name_Buffer (Name_Len) := Directory_Separator;
3268 Name_Buffer (Name_Len + 1 ..
3269 Name_Len + Exec_File_Name'Length) :=
3271 Name_Len := Name_Len + Exec_File_Name'Length;
3272 Executable := Name_Find;
3273 Non_Std_Executable := True;
3279 -- Now we invoke Compile_Sources for the current main
3282 (Main_Source => Main_Source_File,
3284 First_Compiled_File => First_Compiled_File,
3285 Most_Recent_Obj_File => Youngest_Obj_File,
3286 Most_Recent_Obj_Stamp => Youngest_Obj_Stamp,
3287 Main_Unit => Is_Main_Unit,
3288 Compilation_Failures => Compilation_Failures,
3289 Check_Readonly_Files => Opt.Check_Readonly_Files,
3290 Do_Not_Execute => Opt.Do_Not_Execute,
3291 Force_Compilations => Opt.Force_Compilations,
3292 In_Place_Mode => Opt.In_Place_Mode,
3293 Keep_Going => Opt.Keep_Going,
3294 Initialize_ALI_Data => True,
3295 Max_Process => Saved_Maximum_Processes);
3297 if Opt.Verbose_Mode then
3298 Write_Str ("End of compilation
");
3302 Total_Compilation_Failures :=
3303 Total_Compilation_Failures + Compilation_Failures;
3305 if Total_Compilation_Failures /= 0 then
3306 if Opt.Keep_Going then
3310 List_Bad_Compilations;
3311 raise Compilation_Failed;
3315 -- Regenerate libraries, if any and if object files
3316 -- have been regenerated
3318 if Main_Project /= No_Project
3319 and then MLib.Tgt.Libraries_Are_Supported
3322 for Proj in Projects.First .. Projects.Last loop
3324 if Proj /= Main_Project
3325 and then Projects.Table (Proj).Flag1
3327 MLib.Prj.Build_Library (For_Project => Proj);
3334 if Opt.List_Dependencies then
3335 if First_Compiled_File /= No_File then
3337 (First_Compiled_File,
3338 "must be recompiled
. Can
't generate dependence list
.");
3343 elsif First_Compiled_File = No_File
3344 and then not Do_Bind_Step
3345 and then not Opt.Quiet_Output
3346 and then Osint.Number_Of_Files = 1
3348 if Unique_Compile then
3349 Inform (Msg => "object up to date
.");
3351 Inform (Msg => "objects up to date
.");
3354 elsif Opt.Do_Not_Execute
3355 and then First_Compiled_File /= No_File
3357 Write_Name (First_Compiled_File);
3361 -- Stop after compile step if any of:
3363 -- 1) -n (Do_Not_Execute) specified
3365 -- 2) -M (List_Dependencies) specified (also sets
3366 -- Do_Not_Execute above, so this is probably superfluous).
3368 -- 3) -c (Compile_Only) specified, but not -b (Bind_Only)
3370 -- 4) Made unit cannot be a main unit
3372 if (Opt.Do_Not_Execute
3373 or Opt.List_Dependencies
3375 or not Is_Main_Unit)
3376 and then not No_Main_Subprogram
3378 if Osint.Number_Of_Files = 1 then
3379 exit Multiple_Main_Loop;
3386 -- If the objects were up-to-date check if the executable file
3387 -- is also up-to-date. For now always bind and link on the JVM
3388 -- since there is currently no simple way to check the
3389 -- up-to-date status of objects
3391 if not Hostparm.Java_VM
3392 and then First_Compiled_File = No_File
3394 Executable_Stamp := File_Stamp (Executable);
3396 -- Once Executable_Obsolete is set to True, it is never
3397 -- reset to False, because it is too hard to accurately
3398 -- decide if a subsequent main need to be rebuilt or not.
3400 Executable_Obsolete :=
3402 or else Youngest_Obj_Stamp > Executable_Stamp;
3404 if not Executable_Obsolete then
3406 -- If no Ada object files obsolete the executable, check
3407 -- for younger or missing linker files.
3409 Check_Linker_Options
3412 Youngest_Obj_Stamp);
3414 Executable_Obsolete := Youngest_Obj_File /= No_File;
3417 -- Return if the executable is up to date
3418 -- and otherwise motivate the relink/rebind.
3420 if not Executable_Obsolete then
3421 if not Opt.Quiet_Output then
3422 Inform (Executable, "up to date
.");
3425 if Osint.Number_Of_Files = 1 then
3426 exit Multiple_Main_Loop;
3433 if Executable_Stamp (1) = ' ' then
3434 Verbose_Msg (Executable, "missing
.", Prefix => " ");
3436 elsif Youngest_Obj_Stamp (1) = ' ' then
3442 elsif Youngest_Obj_Stamp > Executable_Stamp then
3445 "(" & String (Youngest_Obj_Stamp) & ") newer than
",
3447 "(" & String (Executable_Stamp) & ")");
3451 (Executable, "needs to be rebuild
.",
3456 end Recursive_Compilation_Step;
3459 -- If we are here, it means that we need to rebuilt the current
3460 -- main. So we set Executable_Obsolete to True to make sure that
3461 -- the subsequent mains will be rebuilt.
3463 Executable_Obsolete := True;
3465 Main_ALI_In_Place_Mode_Step :
3467 ALI_File : File_Name_Type;
3468 Src_File : File_Name_Type;
3471 Src_File := Strip_Directory (Main_Source_File);
3472 ALI_File := Lib_File_Name (Src_File);
3473 Main_ALI_File := Full_Lib_File_Name (ALI_File);
3475 -- When In_Place_Mode, the library file can be located in the
3476 -- Main_Source_File directory which may not be present in the
3477 -- library path. In this case, use the corresponding library file
3480 if Main_ALI_File = No_File and then Opt.In_Place_Mode then
3481 Get_Name_String (Get_Directory (Full_Source_Name (Src_File)));
3482 Get_Name_String_And_Append (ALI_File);
3483 Main_ALI_File := Name_Find;
3484 Main_ALI_File := Full_Lib_File_Name (Main_ALI_File);
3487 if Main_ALI_File = No_File then
3488 Fail ("could
not find the main ALI file
");
3491 end Main_ALI_In_Place_Mode_Step;
3493 if Do_Bind_Step then
3495 Args : Argument_List
3496 (Binder_Switches.First .. Binder_Switches.Last);
3499 -- Get all the binder switches
3501 for J in Binder_Switches.First .. Binder_Switches.Last loop
3502 Args (J) := Binder_Switches.Table (J);
3505 if Main_Project /= No_Project then
3507 -- Put all the source directories in ADA_INCLUDE_PATH,
3508 -- and all the object directories in ADA_OBJECTS_PATH
3510 Set_Ada_Paths (Main_Project, False);
3513 Bind (Main_ALI_File, Args);
3517 if Do_Link_Step then
3520 There_Are_Libraries : Boolean := False;
3521 Linker_Switches_Last : constant Integer := Linker_Switches.Last;
3524 if Main_Project /= No_Project then
3526 if MLib.Tgt.Libraries_Are_Supported then
3527 Set_Libraries (Main_Project, There_Are_Libraries);
3530 if There_Are_Libraries then
3532 -- Add -L<lib_dir> -lgnarl -lgnat -Wl,-rpath,<lib_dir>
3534 Linker_Switches.Increment_Last;
3535 Linker_Switches.Table (Linker_Switches.Last) :=
3536 new String'("-L
" & MLib.Utl.Lib_Directory);
3537 Linker_Switches.Increment_Last;
3538 Linker_Switches.Table (Linker_Switches.Last) :=
3539 new String'("-lgnarl
");
3540 Linker_Switches.Increment_Last;
3541 Linker_Switches.Table (Linker_Switches.Last) :=
3542 new String'("-lgnat
");
3545 Option : constant String_Access :=
3546 MLib.Tgt.Linker_Library_Path_Option
3547 (MLib.Utl.Lib_Directory);
3550 if Option /= null then
3551 Linker_Switches.Increment_Last;
3552 Linker_Switches.Table (Linker_Switches.Last) :=
3558 -- Put the object directories in ADA_OBJECTS_PATH
3560 Set_Ada_Paths (Main_Project, False);
3564 Args : Argument_List
3565 (Linker_Switches.First .. Linker_Switches.Last + 2);
3567 Last_Arg : Integer := Linker_Switches.First - 1;
3568 Skip : Boolean := False;
3571 -- Get all the linker switches
3573 for J in Linker_Switches.First .. Linker_Switches.Last loop
3577 elsif Non_Std_Executable
3578 and then Linker_Switches.Table (J).all = "-o
"
3583 Last_Arg := Last_Arg + 1;
3584 Args (Last_Arg) := Linker_Switches.Table (J);
3589 -- And invoke the linker
3591 if Non_Std_Executable then
3592 Last_Arg := Last_Arg + 1;
3593 Args (Last_Arg) := new String'("-o
");
3594 Last_Arg := Last_Arg + 1;
3596 new String'(Get_Name_String (Executable));
3597 Link (Main_ALI_File, Args (Args'First .. Last_Arg));
3602 Args (Args'First .. Last_Arg));
3607 Linker_Switches.Set_Last (Linker_Switches_Last);
3611 -- We go to here when we skip the bind and link steps.
3615 -- We go to the next main, if we did not process the last one
3617 if N_File < Osint.Number_Of_Files then
3618 Main_Source_File := Next_Main_Source;
3620 if Main_Project /= No_Project then
3622 -- Find the file name of the main unit
3625 Main_Source_File_Name : constant String :=
3626 Get_Name_String (Main_Source_File);
3628 Main_Unit_File_Name : constant String :=
3630 File_Name_Of_Library_Unit_Body
3631 (Name => Main_Source_File_Name,
3632 Project => Main_Project);
3635 -- We fail if we cannot find the main source file
3636 -- as an immediate source of the main project file.
3638 if Main_Unit_File_Name = "" then
3639 Fail ('"' & Main_Source_File_Name &
3640 """ is not a unit of project " &
3641 Project_File_Name.all & ".");
3644 -- Remove any directory information from the main
3645 -- source file name.
3648 Pos : Natural := Main_Unit_File_Name'Last;
3652 exit when Pos < Main_Unit_File_Name'First
3654 Main_Unit_File_Name (Pos) = Directory_Separator;
3658 Name_Len := Main_Unit_File_Name'Last - Pos;
3660 Name_Buffer (1 .. Name_Len) :=
3662 (Pos + 1 .. Main_Unit_File_Name'Last);
3664 Main_Source_File := Name_Find;
3670 end loop Multiple_Main_Loop;
3672 if Total_Compilation_Failures /= 0 then
3673 List_Bad_Compilations;
3674 raise Compilation_Failed;
3677 -- Delete the temporary mapping file that was created if we are
3678 -- using project files.
3680 Delete_Mapping_Files;
3682 Exit_Program (E_Success);
3686 Delete_Mapping_Files;
3687 Osint.Fail ("*** bind failed.");
3689 when Compilation_Failed =>
3690 Delete_Mapping_Files;
3691 Exit_Program (E_Fatal);
3694 Delete_Mapping_Files;
3695 Osint.Fail ("*** link failed.");
3698 Delete_Mapping_Files;
3699 Write_Line (Exception_Information (X));
3700 Osint.Fail ("INTERNAL ERROR. Please report.");
3704 --------------------
3705 -- In_Ada_Lib_Dir --
3706 --------------------
3708 function In_Ada_Lib_Dir (File : File_Name_Type) return Boolean is
3709 D : constant Name_Id := Get_Directory (File);
3710 B : constant Byte := Get_Name_Table_Byte (D);
3713 return (B and Ada_Lib_Dir) /= 0;
3720 procedure Inform (N : Name_Id := No_Name; Msg : String) is
3722 Osint.Write_Program_Name;
3726 if N /= No_Name then
3736 -----------------------
3737 -- Init_Mapping_File --
3738 -----------------------
3740 procedure Init_Mapping_File (File_Name : in out Temp_File_Name) is
3741 FD : File_Descriptor;
3743 if Main_Project /= No_Project then
3744 Prj.Env.Create_Mapping_File (File_Name);
3747 Create_Temp_File (FD, File_Name);
3749 if FD = Invalid_FD then
3755 end Init_Mapping_File;
3763 First_Q_Initialization := False;
3765 Q.Set_Last (Q.First);
3772 procedure Initialize is
3773 Next_Arg : Positive;
3776 -- Override default initialization of Check_Object_Consistency
3777 -- since this is normally False for GNATBIND, but is True for
3778 -- GNATMAKE since we do not need to check source consistency
3779 -- again once GNATMAKE has looked at the sources to check.
3781 Opt.Check_Object_Consistency := True;
3783 -- Package initializations. The order of calls is important here.
3785 Output.Set_Standard_Error;
3788 Binder_Switches.Init;
3789 Linker_Switches.Init;
3799 Scan_Args : while Next_Arg <= Argument_Count loop
3800 Scan_Make_Arg (Argument (Next_Arg), And_Save => True);
3801 Next_Arg := Next_Arg + 1;
3804 if Usage_Requested then
3808 -- Test for trailing -o switch
3810 if Opt.Output_File_Name_Present
3811 and then not Output_File_Name_Seen
3813 Fail ("output file name missing after -o");
3816 if Project_File_Name /= null then
3818 -- A project file was specified by a -P switch
3820 if Opt.Verbose_Mode then
3822 Write_Str ("Parsing Project File """);
3823 Write_Str (Project_File_Name.all);
3828 -- Avoid looking in the current directory for ALI files
3830 -- Opt.Look_In_Primary_Dir := False;
3832 -- Set the project parsing verbosity to whatever was specified
3833 -- by a possible -vP switch.
3835 Prj.Pars.Set_Verbosity (To => Current_Verbosity);
3837 -- Parse the project file.
3838 -- If there is an error, Main_Project will still be No_Project.
3841 (Project => Main_Project,
3842 Project_File_Name => Project_File_Name.all);
3844 if Main_Project = No_Project then
3845 Fail ("""" & Project_File_Name.all &
3846 """ processing failed");
3849 if Opt.Verbose_Mode then
3851 Write_Str ("Parsing of Project File """);
3852 Write_Str (Project_File_Name.all);
3853 Write_Str (""" is finished.");
3857 -- We add the source directories and the object directories
3858 -- to the search paths.
3860 Add_Source_Directories (Main_Project);
3861 Add_Object_Directories (Main_Project);
3865 Osint.Add_Default_Search_Dirs;
3867 -- Mark the GNAT libraries if needed.
3869 -- Source file lookups should be cached for efficiency.
3870 -- Source files are not supposed to change.
3872 Osint.Source_File_Data (Cache => True);
3874 -- Read gnat.adc file to initialize Fname.UF
3876 Fname.UF.Initialize;
3879 Fname.SF.Read_Source_File_Name_Pragmas;
3882 when Err : SFN_Scan.Syntax_Error_In_GNAT_ADC =>
3883 Osint.Fail (Exception_Message (Err));
3887 -----------------------------------
3888 -- Insert_Project_Sources_Into_Q --
3889 -----------------------------------
3891 procedure Insert_Project_Sources
3892 (The_Project : Project_Id;
3895 Unit : Com.Unit_Data;
3899 -- For all the sources in the project files,
3901 for Id in Com.Units.First .. Com.Units.Last loop
3902 Unit := Com.Units.Table (Id);
3905 -- If there is a source for the body,
3907 if Unit.File_Names (Com.Body_Part).Name /= No_Name then
3909 -- And it is a source of the specified project
3911 if Unit.File_Names (Com.Body_Part).Project = The_Project then
3913 -- If we don't have a spec, we cannot consider the source
3914 -- if it is a subunit
3916 if Unit.File_Names (Com.Specification).Name = No_Name then
3918 Src_Ind : Source_File_Index;
3921 Src_Ind := Sinput.L.Load_Source_File
3922 (Unit.File_Names (Com.Body_Part).Name);
3924 -- If it is a subunit, discard it
3926 if Sinput.L.Source_File_Is_Subunit (Src_Ind) then
3930 Sfile := Unit.File_Names (Com.Body_Part).Name;
3935 Sfile := Unit.File_Names (Com.Body_Part).Name;
3939 elsif Unit.File_Names (Com.Specification).Name /= No_Name
3940 and then Unit.File_Names (Com.Specification).Project = The_Project
3942 -- If there is no source for the body, but there is a source
3943 -- for the spec, then we take this one.
3945 Sfile := Unit.File_Names (Com.Specification).Name;
3948 -- If Into_Q is True, we insert into the Q
3952 -- For the first source inserted into the Q, we need
3953 -- to initialize the Q, but not for the subsequent sources.
3955 if First_Q_Initialization then
3959 -- And of course, we only insert in the Q if the source
3962 if Sfile /= No_Name and then not Is_Marked (Sfile) then
3967 elsif Sfile /= No_Name then
3969 -- If Into_Q is False, we add the source as it it were
3970 -- specified on the command line.
3972 Osint.Add_File (Get_Name_String (Sfile));
3975 end Insert_Project_Sources;
3982 (Source_File : File_Name_Type;
3983 Source_Unit : Unit_Name_Type := No_Name)
3986 if Debug.Debug_Flag_Q then
3987 Write_Str (" Q := Q + [ ");
3988 Write_Name (Source_File);
3993 Q.Table (Q.Last).File := Source_File;
3994 Q.Table (Q.Last).Unit := Source_Unit;
3998 ----------------------------
3999 -- Is_External_Assignment --
4000 ----------------------------
4002 function Is_External_Assignment (Argv : String) return Boolean is
4003 Start : Positive := 3;
4004 Finish : Natural := Argv'Last;
4005 Equal_Pos : Natural;
4008 if Argv'Last < 5 then
4011 elsif Argv (3) = '"' then
4012 if Argv (Argv'Last) /= '"' or else Argv'Last < 7 then
4016 Finish := Argv'Last - 1;
4022 while Equal_Pos <= Finish and then Argv (Equal_Pos) /= '=' loop
4023 Equal_Pos := Equal_Pos + 1;
4026 if Equal_Pos = Start
4027 or else Equal_Pos >= Finish
4033 (External_Name => Argv (Start .. Equal_Pos - 1),
4034 Value => Argv (Equal_Pos + 1 .. Finish));
4037 end Is_External_Assignment;
4043 function Is_Marked (Source_File : File_Name_Type) return Boolean is
4045 return Get_Name_Table_Byte (Source_File) /= 0;
4052 procedure Link (ALI_File : File_Name_Type; Args : Argument_List) is
4053 Link_Args : Argument_List (Args'First .. Args'Last + 1);
4057 Link_Args (Args'Range) := Args;
4059 Get_Name_String (ALI_File);
4060 Link_Args (Args'Last + 1) := new String'(Name_Buffer
(1 .. Name_Len
));
4062 GNAT
.OS_Lib
.Normalize_Arguments
(Link_Args
);
4064 Display
(Gnatlink
.all, Link_Args
);
4066 if Gnatlink_Path
= null then
4067 Osint
.Fail
("error, unable to locate " & Gnatlink
.all);
4070 GNAT
.OS_Lib
.Spawn
(Gnatlink_Path
.all, Link_Args
, Success
);
4077 ---------------------------
4078 -- List_Bad_Compilations --
4079 ---------------------------
4081 procedure List_Bad_Compilations
is
4083 for J
in Bad_Compilation
.First
.. Bad_Compilation
.Last
loop
4084 if Bad_Compilation
.Table
(J
).File
= No_File
then
4086 elsif not Bad_Compilation
.Table
(J
).Found
then
4087 Inform
(Bad_Compilation
.Table
(J
).File
, "not found");
4089 Inform
(Bad_Compilation
.Table
(J
).File
, "compilation error");
4092 end List_Bad_Compilations
;
4098 procedure List_Depend
is
4105 Line_Size
: constant := 77;
4108 Set_Standard_Output
;
4110 for A
in ALIs
.First
.. ALIs
.Last
loop
4111 Lib_Name
:= ALIs
.Table
(A
).Afile
;
4113 -- We have to provide the full library file name in In_Place_Mode
4115 if Opt
.In_Place_Mode
then
4116 Lib_Name
:= Full_Lib_File_Name
(Lib_Name
);
4119 Obj_Name
:= Object_File_Name
(Lib_Name
);
4120 Write_Name
(Obj_Name
);
4123 Get_Name_String
(Obj_Name
);
4125 Line_Pos
:= Len
+ 2;
4127 for D
in ALIs
.Table
(A
).First_Sdep
.. ALIs
.Table
(A
).Last_Sdep
loop
4128 Src_Name
:= Sdep
.Table
(D
).Sfile
;
4130 if Is_Internal_File_Name
(Src_Name
)
4131 and then not Check_Readonly_Files
4135 if not Opt
.Quiet_Output
then
4136 Src_Name
:= Full_Source_Name
(Src_Name
);
4139 Get_Name_String
(Src_Name
);
4142 if Line_Pos
+ Len
+ 1 > Line_Size
then
4148 Line_Pos := Line_Pos + Len + 1;
4151 Write_Name (Src_Name);
4165 procedure Mark (Source_File : File_Name_Type) is
4167 Set_Name_Table_Byte (Source_File, 1);
4170 --------------------
4171 -- Mark_Directory --
4172 --------------------
4174 procedure Mark_Directory
4176 Mark : Lib_Mark_Type)
4182 -- Dir last character is supposed to be a directory separator.
4184 Name_Len := Dir'Length;
4185 Name_Buffer (1 .. Name_Len) := Dir;
4187 if not Is_Directory_Separator (Name_Buffer (Name_Len)) then
4188 Name_Len := Name_Len + 1;
4189 Name_Buffer (Name_Len) := Directory_Separator;
4192 -- Add flags to the already existing flags
4195 B := Get_Name_Table_Byte (N);
4196 Set_Name_Table_Byte (N, B or Mark);
4199 ----------------------
4200 -- Object_File_Name --
4201 ----------------------
4203 function Object_File_Name (Source : String) return String is
4205 -- If the source name has an extension, then replace it with
4206 -- the object suffix.
4208 for Index in reverse Source'First + 1 .. Source'Last loop
4209 if Source (Index) = '.' then
4210 return Source (Source'First .. Index - 1) & Object_Suffix;
4214 -- If there is no dot, or if it is the first character, just add the
4217 return Source & Object_Suffix;
4218 end Object_File_Name;
4224 procedure Scan_Make_Arg (Argv : String; And_Save : Boolean) is
4226 pragma Assert (Argv'First = 1);
4228 if Argv'Length = 0 then
4232 -- If the previous switch has set the Output_File_Name_Present
4233 -- flag (that is we have seen a -o), then the next argument is
4234 -- the name of the output executable.
4236 if Opt.Output_File_Name_Present and then not Output_File_Name_Seen then
4237 Output_File_Name_Seen := True;
4239 if Argv (1) = '-' then
4240 Fail ("output file name missing after
-o
");
4243 Add_Switch ("-o
", Linker, And_Save => And_Save);
4245 -- Automatically add the executable suffix if it has not been
4246 -- specified explicitly.
4248 if Executable_Suffix'Length /= 0
4249 and then Argv (Argv'Last - Executable_Suffix'Length + 1
4250 .. Argv'Last) /= Executable_Suffix
4253 (Argv & Executable_Suffix,
4255 And_Save => And_Save);
4257 Add_Switch (Argv, Linker, And_Save => And_Save);
4261 -- Then check if we are dealing with -cargs/-bargs/-largs
4263 elsif Argv = "-bargs
"
4272 when 'c' => Program_Args := Compiler;
4273 when 'b' => Program_Args := Binder;
4274 when 'l' => Program_Args := Linker;
4275 when 'm' => Program_Args := None;
4278 raise Program_Error;
4281 -- A special test is needed for the -o switch within a -largs
4282 -- since that is another way to specify the name of the final
4285 elsif Program_Args = Linker
4286 and then Argv = "-o
"
4288 Fail ("switch
-o
not allowed within a
-largs
. Use -o directly
.");
4290 -- Check to see if we are reading switches after a -cargs,
4291 -- -bargs or -largs switch. If yes save it.
4293 elsif Program_Args /= None then
4295 -- Check to see if we are reading -I switches in order
4296 -- to take into account in the src & lib search directories.
4298 if Argv'Length > 2 and then Argv (1 .. 2) = "-I
" then
4299 if Argv (3 .. Argv'Last) = "-" then
4300 Opt.Look_In_Primary_Dir := False;
4302 elsif Program_Args = Compiler then
4303 if Argv (3 .. Argv'Last) /= "-" then
4304 Add_Src_Search_Dir (Argv (3 .. Argv'Last));
4308 elsif Program_Args = Binder then
4309 Add_Lib_Search_Dir (Argv (3 .. Argv'Last));
4314 Add_Switch (Argv, Program_Args, And_Save => And_Save);
4316 -- Handle non-default compiler, binder, linker, and handle --RTS switch
4318 elsif Argv'Length > 2 and then Argv (1 .. 2) = "--" then
4320 and then Argv
(1 .. 6) = "--GCC="
4323 Program_Args
: Argument_List_Access
:=
4324 Argument_String_To_List
4325 (Argv
(7 .. Argv
'Last));
4329 Saved_Gcc
:= new String'(Program_Args.all (1).all);
4331 Gcc := new String'(Program_Args
.all (1).all);
4334 for J
in 2 .. Program_Args
.all'Last loop
4336 (Program_Args
.all (J
).all,
4338 And_Save
=> And_Save
);
4342 elsif Argv
'Length > 11
4343 and then Argv
(1 .. 11) = "--GNATBIND="
4346 Program_Args
: Argument_List_Access
:=
4347 Argument_String_To_List
4348 (Argv
(12 .. Argv
'Last));
4352 Saved_Gnatbind
:= new String'(Program_Args.all (1).all);
4354 Gnatbind := new String'(Program_Args
.all (1).all);
4357 for J
in 2 .. Program_Args
.all'Last loop
4359 (Program_Args
.all (J
).all, Binder
, And_Save
=> And_Save
);
4363 elsif Argv
'Length > 11
4364 and then Argv
(1 .. 11) = "--GNATLINK="
4367 Program_Args
: Argument_List_Access
:=
4368 Argument_String_To_List
4369 (Argv
(12 .. Argv
'Last));
4372 Saved_Gnatlink
:= new String'(Program_Args.all (1).all);
4374 Gnatlink := new String'(Program_Args
.all (1).all);
4377 for J
in 2 .. Program_Args
.all'Last loop
4378 Add_Switch
(Program_Args
.all (J
).all, Linker
);
4382 elsif Argv
'Length >= 5 and then
4383 Argv
(1 .. 5) = "--RTS"
4385 Add_Switch
(Argv
, Compiler
, And_Save
=> And_Save
);
4386 Add_Switch
(Argv
, Binder
, And_Save
=> And_Save
);
4388 if Argv
'Length <= 6 or else Argv
(6) /= '=' then
4389 Osint
.Fail
("missing path for --RTS");
4392 -- Valid --RTS switch
4394 Opt
.No_Stdinc
:= True;
4395 Opt
.No_Stdlib
:= True;
4396 Opt
.RTS_Switch
:= True;
4399 Src_Path_Name
: String_Ptr
:=
4401 (Argv
(7 .. Argv
'Last), Include
);
4402 Lib_Path_Name
: String_Ptr
:=
4404 (Argv
(7 .. Argv
'Last), Objects
);
4407 if Src_Path_Name
/= null and then
4408 Lib_Path_Name
/= null
4410 Add_Search_Dirs
(Src_Path_Name
, Include
);
4411 Add_Search_Dirs
(Lib_Path_Name
, Objects
);
4413 elsif Src_Path_Name
= null
4414 and Lib_Path_Name
= null then
4415 Osint
.Fail
("RTS path not valid: missing " &
4416 "adainclude and adalib directories");
4418 elsif Src_Path_Name
= null then
4419 Osint
.Fail
("RTS path not valid: missing " &
4420 "adainclude directory");
4422 elsif Lib_Path_Name
= null then
4423 Osint
.Fail
("RTS path not valid: missing " &
4424 "adalib directory");
4430 Fail
("unknown switch: ", Argv
);
4433 -- If we have seen a regular switch process it
4435 elsif Argv
(1) = '-' then
4437 if Argv
'Length = 1 then
4438 Fail
("switch character cannot be followed by a blank");
4442 elsif Argv
(2 .. Argv
'Last) = "I-" then
4443 Opt
.Look_In_Primary_Dir
:= False;
4445 -- Forbid -?- or -??- where ? is any character
4447 elsif (Argv
'Length = 3 and then Argv
(3) = '-')
4448 or else (Argv
'Length = 4 and then Argv
(4) = '-')
4450 Fail
("trailing ""-"" at the end of ", Argv
, " forbidden.");
4454 elsif Argv
(2) = 'I' then
4455 Add_Src_Search_Dir
(Argv
(3 .. Argv
'Last));
4456 Add_Lib_Search_Dir
(Argv
(3 .. Argv
'Last));
4457 Add_Switch
(Argv
, Compiler
, And_Save
=> And_Save
);
4458 Add_Switch
("-aO" & Argv
(3 .. Argv
'Last),
4460 And_Save
=> And_Save
);
4462 -- No need to pass any source dir to the binder
4463 -- since gnatmake call it with the -x flag
4464 -- (ie do not check source time stamp)
4466 -- -aIdir (to gcc this is like a -I switch)
4468 elsif Argv
'Length >= 3 and then Argv
(2 .. 3) = "aI" then
4469 Add_Src_Search_Dir
(Argv
(4 .. Argv
'Last));
4470 Add_Switch
("-I" & Argv
(4 .. Argv
'Last),
4472 And_Save
=> And_Save
);
4476 elsif Argv
'Length >= 3 and then Argv
(2 .. 3) = "aO" then
4477 Add_Lib_Search_Dir
(Argv
(4 .. Argv
'Last));
4478 Add_Switch
(Argv
, Binder
, And_Save
=> And_Save
);
4480 -- -aLdir (to gnatbind this is like a -aO switch)
4482 elsif Argv
'Length >= 3 and then Argv
(2 .. 3) = "aL" then
4483 Mark_Directory
(Argv
(4 .. Argv
'Last), Ada_Lib_Dir
);
4484 Add_Lib_Search_Dir
(Argv
(4 .. Argv
'Last));
4485 Add_Switch
("-aO" & Argv
(4 .. Argv
'Last),
4487 And_Save
=> And_Save
);
4489 -- -Adir (to gnatbind this is like a -aO switch, to gcc like a -I)
4491 elsif Argv
(2) = 'A' then
4492 Mark_Directory
(Argv
(3 .. Argv
'Last), Ada_Lib_Dir
);
4493 Add_Src_Search_Dir
(Argv
(3 .. Argv
'Last));
4494 Add_Lib_Search_Dir
(Argv
(3 .. Argv
'Last));
4495 Add_Switch
("-I" & Argv
(3 .. Argv
'Last),
4497 And_Save
=> And_Save
);
4498 Add_Switch
("-aO" & Argv
(3 .. Argv
'Last),
4500 And_Save
=> And_Save
);
4504 elsif Argv
(2) = 'L' then
4505 Add_Switch
(Argv
, Linker
, And_Save
=> And_Save
);
4507 -- For -gxxxxx,-pg : give the switch to both the compiler and the
4508 -- linker (except for -gnatxxx which is only for the compiler)
4511 (Argv
(2) = 'g' and then (Argv
'Last < 5
4512 or else Argv
(2 .. 5) /= "gnat"))
4513 or else Argv
(2 .. Argv
'Last) = "pg"
4515 Add_Switch
(Argv
, Compiler
, And_Save
=> And_Save
);
4516 Add_Switch
(Argv
, Linker
, And_Save
=> And_Save
);
4520 elsif Argv
(2) = 'd'
4521 and then Argv
'Last = 2
4523 Opt
.Display_Compilation_Progress
:= True;
4525 -- -j (need to save the result)
4527 elsif Argv
(2) = 'j' then
4528 Scan_Make_Switches
(Argv
);
4531 Saved_Maximum_Processes
:= Maximum_Processes
;
4536 elsif Argv
(2) = 'm'
4537 and then Argv
'Last = 2
4539 Opt
.Minimal_Recompilation
:= True;
4543 elsif Argv
(2) = 'u'
4544 and then Argv
'Last = 2
4546 Unique_Compile
:= True;
4547 Opt
.Compile_Only
:= True;
4548 Do_Bind_Step
:= False;
4549 Do_Link_Step
:= False;
4551 -- -Pprj (only once, and only on the command line)
4554 and then Argv
(2) = 'P'
4556 if Project_File_Name
/= null then
4557 Fail
("cannot have several project files specified");
4559 elsif not And_Save
then
4561 -- It could be a tool other than gnatmake (i.e, gnatdist)
4562 -- or a -P switch inside a project file.
4565 ("either the tool is not ""project-aware"" or " &
4566 "a project file is specified inside a project file");
4569 Project_File_Name
:= new String' (Argv (3 .. Argv'Last));
4574 -- Since no object file is created, don't check object
4577 elsif Argv (2) = 'S
'
4578 and then Argv'Last = 2
4580 Opt.Check_Object_Consistency := False;
4581 Add_Switch (Argv, Compiler, And_Save => And_Save);
4583 -- -vPx (verbosity of the parsing of the project files)
4586 and then Argv (2 .. 3) = "vP"
4587 and then Argv (4) in '0' .. '2'
4592 Current_Verbosity := Prj.Default;
4594 Current_Verbosity := Prj.Medium;
4596 Current_Verbosity := Prj.High;
4602 -- -Wx (need to save the result)
4604 elsif Argv (2) = 'W
' then
4605 Scan_Make_Switches (Argv);
4608 Saved_WC_Encoding_Method := Wide_Character_Encoding_Method;
4609 Saved_WC_Encoding_Method_Set := True;
4612 -- -Xext=val (External assignment)
4614 elsif Argv (2) = 'X
'
4615 and then Is_External_Assignment (Argv)
4617 -- Is_External_Assignment has side effects
4618 -- when it returns True;
4622 -- If -gnath is present, then generate the usage information
4623 -- right now and do not pass this option on to the compiler calls.
4625 elsif Argv = "-gnath" then
4628 -- If -gnatc is specified, make sure the bind step and the link
4629 -- step are not executed.
4631 elsif Argv'Length >= 6 and then Argv (2 .. 6) = "gnatc" then
4633 -- If -gnatc is specified, make sure the bind step and the link
4634 -- step are not executed.
4636 Add_Switch (Argv, Compiler, And_Save => And_Save);
4637 Opt.Operating_Mode := Opt.Check_Semantics;
4638 Opt.Check_Object_Consistency := False;
4639 Opt.Compile_Only := True;
4640 Do_Bind_Step := False;
4641 Do_Link_Step := False;
4643 elsif Argv (2 .. Argv'Last) = "nostdlib" then
4645 -- Don't pass -nostdlib to gnatlink, it will disable
4646 -- linking with all standard library files.
4648 Opt.No_Stdlib := True;
4649 Add_Switch (Argv, Binder, And_Save => And_Save);
4651 elsif Argv (2 .. Argv'Last) = "nostdinc" then
4653 -- Pass -nostdinv to the Compiler and to gnatbind
4655 Opt.No_Stdinc := True;
4656 Add_Switch (Argv, Compiler, And_Save => And_Save);
4657 Add_Switch (Argv, Binder, And_Save => And_Save);
4659 -- By default all switches with more than one character
4660 -- or one character switches which are not in 'a
' .. 'z
'
4661 -- (except 'C
' and 'M
') are passed to the compiler, unless we are
4662 -- dealing with a debug switch (starts with 'd
')
4664 elsif Argv (2) /= 'd
'
4665 and then Argv (2 .. Argv'Last) /= "M"
4666 and then Argv (2 .. Argv'Last) /= "C"
4667 and then (Argv'Length > 2 or else Argv (2) not in 'a
' .. 'z
')
4669 Add_Switch (Argv, Compiler, And_Save => And_Save);
4671 -- All other options are handled by Scan_Make_Switches
4674 Scan_Make_Switches (Argv);
4677 -- If not a switch it must be a file name
4688 procedure Set_Ada_Paths
4689 (For_Project : Prj.Project_Id;
4690 Including_Libraries : Boolean)
4692 New_Ada_Include_Path : constant String_Access :=
4693 Prj.Env.Ada_Include_Path (For_Project);
4695 New_Ada_Objects_Path : constant String_Access :=
4696 Prj.Env.Ada_Objects_Path
4697 (For_Project, Including_Libraries);
4700 -- If ADA_INCLUDE_PATH needs to be changed (we are not using the same
4701 -- project file), set the new ADA_INCLUDE_PATH
4703 if New_Ada_Include_Path /= Current_Ada_Include_Path then
4704 Current_Ada_Include_Path := New_Ada_Include_Path;
4706 if Original_Ada_Include_Path'Length = 0 then
4707 Setenv ("ADA_INCLUDE_PATH",
4708 New_Ada_Include_Path.all);
4711 -- If there existed an ADA_INCLUDE_PATH at the invocation of
4712 -- gnatmake, concatenate new ADA_INCLUDE_PATH with the original.
4714 Setenv ("ADA_INCLUDE_PATH",
4715 Original_Ada_Include_Path.all &
4717 New_Ada_Include_Path.all);
4720 if Opt.Verbose_Mode then
4722 Include_Path : constant String_Access :=
4723 Getenv ("ADA_INCLUDE_PATH");
4726 -- Display the new ADA_INCLUDE_PATH
4728 Write_Str ("ADA_INCLUDE_PATH = """);
4730 (S => Include_Path.all,
4731 Max_Length => Max_Line_Length,
4732 Separator => Path_Separator);
4739 -- If ADA_OBJECTS_PATH needs to be changed (we are not using the same
4740 -- project file), set the new ADA_OBJECTS_PATH
4742 if New_Ada_Objects_Path /= Current_Ada_Objects_Path then
4743 Current_Ada_Objects_Path := New_Ada_Objects_Path;
4745 if Original_Ada_Objects_Path'Length = 0 then
4746 Setenv ("ADA_OBJECTS_PATH",
4747 New_Ada_Objects_Path.all);
4750 -- If there existed an ADA_OBJECTS_PATH at the invocation of
4751 -- gnatmake, concatenate new ADA_OBJECTS_PATH with the original.
4753 Setenv ("ADA_OBJECTS_PATH",
4754 Original_Ada_Objects_Path.all &
4756 New_Ada_Objects_Path.all);
4759 if Opt.Verbose_Mode then
4761 Objects_Path : constant String_Access :=
4762 Getenv ("ADA_OBJECTS_PATH");
4765 -- Display the new ADA_OBJECTS_PATH
4767 Write_Str ("ADA_OBJECTS_PATH = """);
4769 (S => Objects_Path.all,
4770 Max_Length => Max_Line_Length,
4771 Separator => Path_Separator);
4780 ---------------------
4781 -- Set_Library_For --
4782 ---------------------
4784 procedure Set_Library_For
4785 (Project : Project_Id;
4786 There_Are_Libraries : in out Boolean)
4789 -- Case of library project
4791 if Projects.Table (Project).Library then
4792 There_Are_Libraries := True;
4794 -- Add the -L switch
4796 Linker_Switches.Increment_Last;
4797 Linker_Switches.Table (Linker_Switches.Last) :=
4800 (Projects
.Table
(Project
).Library_Dir
));
4802 -- Add the -l switch
4804 Linker_Switches
.Increment_Last
;
4805 Linker_Switches
.Table
(Linker_Switches
.Last
) :=
4808 (Projects.Table (Project).Library_Name));
4810 -- Add the Wl,-rpath switch if library non static
4812 if Projects.Table (Project).Library_Kind /= Static then
4814 Option : constant String_Access :=
4815 MLib.Tgt.Linker_Library_Path_Option
4817 (Projects.Table (Project).Library_Dir));
4820 if Option /= null then
4821 Linker_Switches.Increment_Last;
4822 Linker_Switches.Table (Linker_Switches.Last) :=
4831 end Set_Library_For;
4837 function Switches_Of
4838 (Source_File : Name_Id;
4839 Source_File_Name : String;
4840 Naming : Naming_Data;
4841 In_Package : Package_Id;
4842 Allow_ALI : Boolean)
4843 return Variable_Value
4845 Switches : Variable_Value;
4847 Defaults : constant Array_Element_Id :=
4849 (Name => Name_Default_Switches,
4851 Packages.Table (In_Package).Decl.Arrays);
4853 Switches_Array : constant Array_Element_Id :=
4855 (Name => Name_Switches,
4857 Packages.Table (In_Package).Decl.Arrays);
4862 (Index => Source_File,
4863 In_Array => Switches_Array);
4865 if Switches = Nil_Variable_Value then
4867 Name : String (1 .. Source_File_Name'Length + 3);
4868 Last : Positive := Source_File_Name'Length;
4869 Spec_Suffix : constant String :=
4870 Get_Name_String (Naming.Current_Spec_Suffix);
4871 Impl_Suffix : constant String :=
4872 Get_Name_String (Naming.Current_Impl_Suffix);
4873 Truncated : Boolean := False;
4876 Name (1 .. Last) := Source_File_Name;
4878 if Last > Impl_Suffix'Length
4879 and then Name (Last - Impl_Suffix'Length + 1 .. Last) =
4883 Last := Last - Impl_Suffix'Length;
4887 and then Last > Spec_Suffix'Length
4888 and then Name (Last - Spec_Suffix'Length + 1 .. Last) =
4892 Last := Last - Spec_Suffix'Length;
4897 Name_Buffer (1 .. Name_Len) := Name (1 .. Last);
4900 (Index => Name_Find,
4901 In_Array => Switches_Array);
4903 if Switches = Nil_Variable_Value
4906 Last := Source_File_Name'Length;
4908 while Name (Last) /= '.' loop
4912 Name (Last + 1 .. Last + 3) := "ali";
4913 Name_Len := Last + 3;
4914 Name_Buffer (1 .. Name_Len) := Name (1 .. Name_Len);
4917 (Index => Name_Find,
4918 In_Array => Switches_Array);
4924 if Switches = Nil_Variable_Value then
4925 Switches := Prj.Util.Value_Of
4926 (Index => Name_Ada, In_Array => Defaults);
4932 ---------------------------
4933 -- Test_If_Relative_Path --
4934 ---------------------------
4936 procedure Test_If_Relative_Path
4937 (Switch : in out String_Access;
4938 Parent : String_Access)
4941 if Switch /= null then
4944 Sw : String (1 .. Switch'Length);
4950 if Sw (1) = '-' then
4952 and then (Sw (2) = 'A
'
4953 or else Sw (2) = 'I
'
4954 or else Sw (2) = 'L
')
4962 elsif Sw'Length >= 4
4963 and then (Sw (2 .. 3) = "aL"
4964 or else Sw (2 .. 3) = "aO"
4965 or else Sw (2 .. 3) = "aI")
4969 elsif Sw'Length >= 7
4970 and then Sw (2 .. 6) = "-RTS="
4977 if not Is_Absolute_Path (Sw (Start .. Sw'Last)) then
4978 if Parent = null then
4979 Fail ("relative search path switches (""" & Sw &
4980 """) are not allowed inside project files");
4985 (Sw
(1 .. Start
- 1) &
4987 Directory_Separator
&
4988 Sw
(Start
.. Sw
'Last));
4994 end Test_If_Relative_Path
;
5002 if Usage_Needed
then
5003 Usage_Needed
:= False;
5012 procedure Verbose_Msg
5015 N2
: Name_Id
:= No_Name
;
5017 Prefix
: String := " -> ")
5020 if not Opt
.Verbose_Mode
then
5030 if N2
/= No_Name
then