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