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