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