| 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;
|