1------------------------------------------------------------------------------ 2-- -- 3-- GNAT COMPILER COMPONENTS -- 4-- -- 5-- M A K E -- 6-- -- 7-- B o d y -- 8-- -- 9-- Copyright (C) 1992-2018, 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 Fmap; 31with Fname; use Fname; 32with Fname.SF; 33with Fname.UF; use Fname.UF; 34with Gnatvsn; use Gnatvsn; 35with Hostparm; use Hostparm; 36with Makeusg; 37with Make_Util; use Make_Util; 38with Namet; use Namet; 39with Opt; use Opt; 40with Osint.M; use Osint.M; 41with Osint; use Osint; 42with Output; use Output; 43with SFN_Scan; 44with Sinput; 45with Snames; 46with Stringt; 47 48pragma Warnings (Off); 49with System.HTable; 50pragma Warnings (On); 51 52with Switch; use Switch; 53with Switch.M; use Switch.M; 54with Table; 55with Targparm; 56with Tempdir; 57with Types; use Types; 58 59with Ada.Command_Line; use Ada.Command_Line; 60with Ada.Directories; 61with Ada.Exceptions; use Ada.Exceptions; 62 63with GNAT.Command_Line; use GNAT.Command_Line; 64with GNAT.Directory_Operations; use GNAT.Directory_Operations; 65with GNAT.OS_Lib; use GNAT.OS_Lib; 66 67package body Make is 68 69 use ASCII; 70 -- Make control characters visible 71 72 Standard_Library_Package_Body_Name : constant String := "s-stalib.adb"; 73 System_Package_Spec_Name : constant String := "system.ads"; 74 -- Every program depends on one of these packages: usually the first one, 75 -- or if Supress_Standard_Library is true on the second one. The dependency 76 -- is not always explicit and considering it is important when -f and -a 77 -- are used. 78 79 type Sigint_Handler is access procedure; 80 pragma Convention (C, Sigint_Handler); 81 82 procedure Install_Int_Handler (Handler : Sigint_Handler); 83 pragma Import (C, Install_Int_Handler, "__gnat_install_int_handler"); 84 -- Called by Gnatmake to install the SIGINT handler below 85 86 procedure Sigint_Intercepted; 87 pragma Convention (C, Sigint_Intercepted); 88 -- Called when the program is interrupted by Ctrl-C to delete the 89 -- temporary mapping files and configuration pragmas files. 90 91 No_Mapping_File : constant Natural := 0; 92 93 type Compilation_Data is record 94 Pid : Process_Id; 95 Full_Source_File : File_Name_Type; 96 Lib_File : File_Name_Type; 97 Source_Unit : Unit_Name_Type; 98 Full_Lib_File : File_Name_Type; 99 Lib_File_Attr : aliased File_Attributes; 100 Mapping_File : Natural := No_Mapping_File; 101 end record; 102 -- Data recorded for each compilation process spawned 103 104 No_Compilation_Data : constant Compilation_Data := 105 (Invalid_Pid, No_File, No_File, No_Unit_Name, No_File, Unknown_Attributes, 106 No_Mapping_File); 107 108 type Comp_Data_Arr is array (Positive range <>) of Compilation_Data; 109 type Comp_Data_Ptr is access Comp_Data_Arr; 110 Running_Compile : Comp_Data_Ptr; 111 -- Used to save information about outstanding compilations 112 113 Outstanding_Compiles : Natural := 0; 114 -- Current number of outstanding compiles 115 116 procedure Initialize; 117 118 Project_File_Name_Present : Boolean := False; 119 120 Project_File_Name : String_Access := null; 121 122 ------------------------- 123 -- Note on terminology -- 124 ------------------------- 125 126 -- In this program, we use the phrase "termination" of a file name to refer 127 -- to the suffix that appears after the unit name portion. Very often this 128 -- is simply the extension, but in some cases, the sequence may be more 129 -- complex, for example in main.1.ada, the termination in this name is 130 -- ".1.ada" and in main_.ada the termination is "_.ada". 131 132 Unique_Compile : Boolean := False; 133 -- Set to True if -u or -U is used 134 135 Must_Compile : Boolean := False; 136 -- True if gnatmake is invoked with -f -u and one or several mains on the 137 -- command line. 138 139 Main_On_Command_Line : Boolean := False; 140 -- True if gnatmake is invoked with one or several mains on the command 141 -- line. 142 143 RTS_Specified : String_Access := null; 144 -- Used to detect multiple --RTS= switches 145 146 N_M_Switch : Natural := 0; 147 -- Used to count -mxxx switches that can affect multilib 148 149 -- The 3 following packages are used to store gcc, gnatbind and gnatlink 150 -- switches found in the project files. 151 152 package Gcc_Switches is new Table.Table ( 153 Table_Component_Type => String_Access, 154 Table_Index_Type => Integer, 155 Table_Low_Bound => 1, 156 Table_Initial => 20, 157 Table_Increment => 100, 158 Table_Name => "Make.Gcc_Switches"); 159 160 package Binder_Switches is new Table.Table ( 161 Table_Component_Type => String_Access, 162 Table_Index_Type => Integer, 163 Table_Low_Bound => 1, 164 Table_Initial => 20, 165 Table_Increment => 100, 166 Table_Name => "Make.Binder_Switches"); 167 168 package Linker_Switches is new Table.Table ( 169 Table_Component_Type => String_Access, 170 Table_Index_Type => Integer, 171 Table_Low_Bound => 1, 172 Table_Initial => 20, 173 Table_Increment => 100, 174 Table_Name => "Make.Linker_Switches"); 175 176 package Switches_To_Check is new Table.Table ( 177 Table_Component_Type => String_Access, 178 Table_Index_Type => Integer, 179 Table_Low_Bound => 1, 180 Table_Initial => 20, 181 Table_Increment => 100, 182 Table_Name => "Make.Switches_To_Check"); 183 184 package Failed_Links is new Table.Table ( 185 Table_Component_Type => File_Name_Type, 186 Table_Index_Type => Integer, 187 Table_Low_Bound => 1, 188 Table_Initial => 10, 189 Table_Increment => 100, 190 Table_Name => "Make.Failed_Links"); 191 192 package Successful_Links is new Table.Table ( 193 Table_Component_Type => File_Name_Type, 194 Table_Index_Type => Integer, 195 Table_Low_Bound => 1, 196 Table_Initial => 10, 197 Table_Increment => 100, 198 Table_Name => "Make.Successful_Links"); 199 200 Normalized_Switches : Argument_List_Access := new Argument_List (1 .. 10); 201 Last_Norm_Switch : Natural := 0; 202 203 Map_File : String_Access := null; 204 -- Value of switch --create-map-file 205 206 procedure Add_Library_Search_Dir (Path : String); 207 -- Call Add_Lib_Search_Dir with an absolute directory path. If Path is 208 -- relative path,, it is relative to the current working directory. 209 210 procedure Add_Source_Search_Dir (Path : String); 211 -- Call Add_Src_Search_Dir with an absolute directory path. If Path is a 212 -- relative path, it is relative to the current working directory. 213 214 type Bad_Compilation_Info is record 215 File : File_Name_Type; 216 Unit : Unit_Name_Type; 217 Found : Boolean; 218 end record; 219 -- File is the name of the file for which a compilation failed. Unit is for 220 -- gnatdist use in order to easily get the unit name of a file when its 221 -- name is krunched or declared in gnat.adc. Found is False if the 222 -- compilation failed because the file could not be found. 223 224 package Bad_Compilation is new Table.Table ( 225 Table_Component_Type => Bad_Compilation_Info, 226 Table_Index_Type => Natural, 227 Table_Low_Bound => 1, 228 Table_Initial => 20, 229 Table_Increment => 100, 230 Table_Name => "Make.Bad_Compilation"); 231 -- Full name of all the source files for which compilation fails 232 233 Do_Compile_Step : Boolean := True; 234 Do_Bind_Step : Boolean := True; 235 Do_Link_Step : Boolean := True; 236 -- Flags to indicate what step should be executed. Can be set to False 237 -- with the switches -c, -b and -l. These flags are reset to True for 238 -- each invocation of procedure Gnatmake. 239 240 CodePeer_Mode_String : aliased String := "-P"; 241 242 No_Shared_Switch : aliased Argument_List := (1 .. 0 => null); 243 Bind_Shared : Argument_List_Access := No_Shared_Switch'Access; 244 -- Switch to added in front of gnatbind switches. By default no switch is 245 -- added. Switch "-shared" is added if there is a non-static Library 246 -- Project File. 247 248 Shared_Libgcc : aliased String := "-shared-libgcc"; 249 250 No_Shared_Libgcc_Switch : aliased Argument_List := (1 .. 0 => null); 251 Shared_Libgcc_Switch : aliased Argument_List := 252 (1 => Shared_Libgcc'Access); 253 Link_With_Shared_Libgcc : Argument_List_Access := 254 No_Shared_Libgcc_Switch'Access; 255 256 procedure Make_Failed (S : String); 257 -- Delete all temp files created by Gnatmake and call Osint.Fail, with the 258 -- parameter S (see osint.ads). 259 260 -------------------------- 261 -- Obsolete Executables -- 262 -------------------------- 263 264 Executable_Obsolete : Boolean := False; 265 -- Executable_Obsolete is initially set to False for each executable, 266 -- and is set to True whenever one of the source of the executable is 267 -- compiled, or has already been compiled for another executable. 268 269 Max_Header : constant := 200; 270 -- This needs a proper comment, it used to say "arbitrary" that's not an 271 -- adequate comment ??? 272 273 type Header_Num is range 1 .. Max_Header; 274 -- Header_Num for the hash table Obsoleted below 275 276 function Hash (F : File_Name_Type) return Header_Num; 277 -- Hash function for the hash table Obsoleted below 278 279 package Obsoleted is new System.HTable.Simple_HTable 280 (Header_Num => Header_Num, 281 Element => Boolean, 282 No_Element => False, 283 Key => File_Name_Type, 284 Hash => Hash, 285 Equal => "="); 286 -- A hash table to keep all files that have been compiled, to detect 287 -- if an executable is up to date or not. 288 289 procedure Enter_Into_Obsoleted (F : File_Name_Type); 290 -- Enter a file name, without directory information, into the hash table 291 -- Obsoleted. 292 293 function Is_In_Obsoleted (F : File_Name_Type) return Boolean; 294 -- Check if a file name, without directory information, has already been 295 -- entered into the hash table Obsoleted. 296 297 type Dependency is record 298 This : File_Name_Type; 299 Depends_On : File_Name_Type; 300 end record; 301 -- Components of table Dependencies below 302 303 package Dependencies is new Table.Table ( 304 Table_Component_Type => Dependency, 305 Table_Index_Type => Integer, 306 Table_Low_Bound => 1, 307 Table_Initial => 20, 308 Table_Increment => 100, 309 Table_Name => "Make.Dependencies"); 310 -- A table to keep dependencies, to be able to decide if an executable 311 -- is obsolete. More explanation needed ??? 312 313 ---------------------------- 314 -- Arguments and Switches -- 315 ---------------------------- 316 317 Arguments : Argument_List_Access; 318 -- Used to gather the arguments for invocation of the compiler 319 320 Last_Argument : Natural := 0; 321 -- Last index of arguments in Arguments above 322 323 Dummy_Switch : constant String_Access := new String'("- "); 324 -- Used to initialized Prev_Switch in procedure Check 325 326 procedure Add_Arguments (Args : Argument_List); 327 -- Add arguments to global variable Arguments, increasing its size 328 -- if necessary and adjusting Last_Argument. 329 330 ------------------- 331 -- Misc Routines -- 332 ------------------- 333 334 procedure List_Depend; 335 -- Prints to standard output the list of object dependencies. This list 336 -- can be used directly in a Makefile. A call to Compile_Sources must 337 -- precede the call to List_Depend. Also because this routine uses the 338 -- ALI files that were originally loaded and scanned by Compile_Sources, 339 -- no additional ALI files should be scanned between the two calls (i.e. 340 -- between the call to Compile_Sources and List_Depend.) 341 342 procedure List_Bad_Compilations; 343 -- Prints out the list of all files for which the compilation failed 344 345 Usage_Needed : Boolean := True; 346 -- Flag used to make sure Makeusg is call at most once 347 348 procedure Usage; 349 -- Call Makeusg, if Usage_Needed is True. 350 -- Set Usage_Needed to False. 351 352 procedure Debug_Msg (S : String; N : Name_Id); 353 procedure Debug_Msg (S : String; N : File_Name_Type); 354 procedure Debug_Msg (S : String; N : Unit_Name_Type); 355 -- If Debug.Debug_Flag_W is set outputs string S followed by name N 356 357 ----------------------- 358 -- Gnatmake Routines -- 359 ----------------------- 360 361 subtype Lib_Mark_Type is Byte; 362 -- Used in Mark_Directory 363 364 Ada_Lib_Dir : constant Lib_Mark_Type := 1; 365 -- Used to mark a directory as a GNAT lib dir 366 367 -- Note that the notion of GNAT lib dir is no longer used. The code related 368 -- to it has not been removed to give an idea on how to use the directory 369 -- prefix marking mechanism. 370 371 -- An Ada library directory is a directory containing ali and object files 372 -- but no source files for the bodies (the specs can be in the same or some 373 -- other directory). These directories are specified in the Gnatmake 374 -- command line with the switch "-Adir" (to specify the spec location -Idir 375 -- cab be used). Gnatmake skips the missing sources whose ali are in Ada 376 -- library directories. For an explanation of why Gnatmake behaves that 377 -- way, see the spec of Make.Compile_Sources. The directory lookup penalty 378 -- is incurred every single time this routine is called. 379 380 function In_Ada_Lib_Dir (File : File_Name_Type) return Boolean; 381 -- Get directory prefix of this file and get lib mark stored in name 382 -- table for this directory. Then check if an Ada lib mark has been set. 383 384 procedure Mark_Directory (Dir : String; Mark : Lib_Mark_Type); 385 -- Store the absolute path from Dir in name table and set lib mark as name 386 -- info to identify Ada libraries. 387 -- 388 -- If Dir is a relative path, it is relative to the current working 389 -- directory. 390 391 Output_Is_Object : Boolean := True; 392 -- Set to False when using a switch -S for the compiler 393 394 procedure Check_For_S_Switch; 395 -- Set Output_Is_Object to False when the -S switch is used for the 396 -- compiler. 397 398 procedure Process_Multilib; 399 -- Add appropriate --RTS argument to handle multilib 400 401 procedure Compute_Executable 402 (Main_Source_File : File_Name_Type; 403 Executable : out File_Name_Type; 404 Non_Std_Executable : out Boolean); 405 -- Parse the linker switches and project file to compute the name of the 406 -- executable to generate. 407 -- ??? What is the meaning of Non_Std_Executable 408 409 procedure Compilation_Phase 410 (Main_Source_File : File_Name_Type; 411 Current_Main_Index : Int := 0; 412 Total_Compilation_Failures : in out Natural; 413 Executable : File_Name_Type := No_File; 414 Stop_Compile : out Boolean); 415 -- Build all source files for a given main file 416 -- 417 -- Current_Main_Index, if not zero, is the index of the current main unit 418 -- in its source file. 419 -- 420 -- Stand_Alone_Libraries is set to True when there are Stand-Alone 421 -- Libraries, so that gnatbind is invoked with the -F switch to force 422 -- checking of elaboration flags. 423 -- 424 -- Stop_Compile is set to true if we should not try to compile any more 425 -- of the main units 426 427 procedure Binding_Phase 428 (Main_ALI_File : File_Name_Type); 429 -- Stand_Alone_Libraries should be set to True when there are Stand-Alone 430 -- Libraries, so that gnatbind is invoked with the -F switch to force 431 -- checking of elaboration flags. 432 433 procedure Linking_Phase 434 (Non_Std_Executable : Boolean := False; 435 Executable : File_Name_Type := No_File; 436 Main_ALI_File : File_Name_Type); 437 -- Perform the link of a single executable. The ali file corresponds 438 -- to Main_ALI_File. Executable is the file name of an executable. 439 -- Non_Std_Executable is set to True when there is a possibility that 440 -- the linker will not choose the correct executable file name. 441 442 ---------------------------------------------------- 443 -- Compiler, Binder & Linker Data and Subprograms -- 444 ---------------------------------------------------- 445 446 Gcc : String_Access := Program_Name ("gcc", "gnatmake"); 447 Gnatbind : String_Access := Program_Name ("gnatbind", "gnatmake"); 448 Gnatlink : String_Access := Program_Name ("gnatlink", "gnatmake"); 449 -- Default compiler, binder, linker programs 450 451 Gcc_Path : String_Access := 452 GNAT.OS_Lib.Locate_Exec_On_Path (Gcc.all); 453 Gnatbind_Path : String_Access := 454 GNAT.OS_Lib.Locate_Exec_On_Path (Gnatbind.all); 455 Gnatlink_Path : String_Access := 456 GNAT.OS_Lib.Locate_Exec_On_Path (Gnatlink.all); 457 -- Path for compiler, binder, linker programs, defaulted now for gnatdist. 458 -- Changed later if overridden on command line. 459 460 Comp_Flag : constant String_Access := new String'("-c"); 461 Output_Flag : constant String_Access := new String'("-o"); 462 Ada_Flag_1 : constant String_Access := new String'("-x"); 463 Ada_Flag_2 : constant String_Access := new String'("ada"); 464 AdaSCIL_Flag : constant String_Access := new String'("adascil"); 465 GNAT_Flag : constant String_Access := new String'("-gnatpg"); 466 Do_Not_Check_Flag : constant String_Access := new String'("-x"); 467 468 Object_Suffix : constant String := Get_Target_Object_Suffix.all; 469 470 Syntax_Only : Boolean := False; 471 -- Set to True when compiling with -gnats 472 473 Output_File_Name_Seen : Boolean := False; 474 -- Set to True after having scanned the file_name for 475 -- switch "-o file_name" 476 477 Object_Directory_Seen : Boolean := False; 478 -- Set to True after having scanned the object directory for 479 -- switch "-D obj_dir". 480 481 Object_Directory_Path : String_Access := null; 482 -- The path name of the object directory, set with switch -D 483 484 type Make_Program_Type is (None, Compiler, Binder, Linker); 485 486 Program_Args : Make_Program_Type := None; 487 -- Used to indicate if we are scanning gnatmake, gcc, gnatbind, or gnatbind 488 -- options within the gnatmake command line. Used in Scan_Make_Arg only, 489 -- but must be global since value preserved from one call to another. 490 491 procedure Add_Switch 492 (S : String_Access; 493 Program : Make_Program_Type; 494 Append_Switch : Boolean := True); 495 procedure Add_Switch 496 (S : String; 497 Program : Make_Program_Type; 498 Append_Switch : Boolean := True); 499 -- Make invokes one of three programs (the compiler, the binder or the 500 -- linker). For the sake of convenience, some program specific switches 501 -- can be passed directly on the gnatmake command line. This procedure 502 -- records these switches so that gnatmake can pass them to the right 503 -- program. S is the switch to be added at the end of the command line 504 -- for Program if Append_Switch is True. If Append_Switch is False S is 505 -- added at the beginning of the command line. 506 507 procedure Check 508 (Source_File : File_Name_Type; 509 The_Args : Argument_List; 510 Lib_File : File_Name_Type; 511 Full_Lib_File : File_Name_Type; 512 Lib_File_Attr : access File_Attributes; 513 Read_Only : Boolean; 514 ALI : out ALI_Id; 515 O_File : out File_Name_Type; 516 O_Stamp : out Time_Stamp_Type); 517 -- Determines whether the library file Lib_File is up-to-date or not. The 518 -- full name (with path information) of the object file corresponding to 519 -- Lib_File is returned in O_File. Its time stamp is saved in O_Stamp. 520 -- ALI is the ALI_Id corresponding to Lib_File. If Lib_File in not 521 -- up-to-date, then the corresponding source file needs to be recompiled. 522 -- In this case ALI = No_ALI_Id. 523 -- Full_Lib_File must be the result of calling Osint.Full_Lib_File_Name on 524 -- Lib_File. Precomputing it saves system calls. Lib_File_Attr is the 525 -- initialized attributes of that file, which is also used to save on 526 -- system calls (it can safely be initialized to Unknown_Attributes). 527 528 procedure Check_Linker_Options 529 (E_Stamp : Time_Stamp_Type; 530 O_File : out File_Name_Type; 531 O_Stamp : out Time_Stamp_Type); 532 -- Checks all linker options for linker files that are newer 533 -- than E_Stamp. If such objects are found, the youngest object 534 -- is returned in O_File and its stamp in O_Stamp. 535 -- 536 -- If no obsolete linker files were found, the first missing 537 -- linker file is returned in O_File and O_Stamp is empty. 538 -- Otherwise O_File is No_File. 539 540 procedure Collect_Arguments (Args : Argument_List); 541 -- Collect all arguments for a source to be compiled. 542 543 procedure Display (Program : String; Args : Argument_List); 544 -- Displays Program followed by the arguments in Args if variable 545 -- Display_Executed_Programs is set. The lower bound of Args must be 1. 546 547 procedure Report_Compilation_Failed; 548 -- Delete all temporary files and fail graciously 549 550 ----------------- 551 -- Mapping files 552 ----------------- 553 554 type Temp_Path_Names is array (Positive range <>) of Path_Name_Type; 555 type Temp_Path_Ptr is access Temp_Path_Names; 556 557 type Free_File_Indexes is array (Positive range <>) of Positive; 558 type Free_Indexes_Ptr is access Free_File_Indexes; 559 560 type Mapping_File_Data is record 561 Mapping_File_Names : Temp_Path_Ptr; 562 -- The name ids of the temporary mapping files used. This is indexed 563 -- on the maximum number of compilation processes we will be spawning 564 -- (-j parameter) 565 566 Last_Mapping_File_Names : Natural; 567 -- Index of the last mapping file created for this project 568 569 Free_Mapping_File_Indexes : Free_Indexes_Ptr; 570 -- Indexes in Mapping_File_Names of the mapping file names that can be 571 -- reused for subsequent compilations. 572 573 Last_Free_Indexes : Natural; 574 -- Number of mapping files that can be reused 575 end record; 576 -- Information necessary when compiling a project 577 578 The_Mapping_Files : Mapping_File_Data; 579 580 Gnatmake_Mapping_File : String_Access := null; 581 -- The path name of a mapping file specified by switch -C= 582 583 procedure Init_Mapping_File (File_Index : in out Natural); 584 -- Create a new mapping file or reuse one already created. 585 586 package Temp_File_Paths is new Table.Table 587 (Table_Component_Type => Path_Name_Type, 588 Table_Index_Type => Natural, 589 Table_Low_Bound => 1, 590 Table_Initial => 4, 591 Table_Increment => 100, 592 Table_Name => "Make.Temp_File_Paths", 593 Release_Threshold => 0); 594 595 procedure Record_Temp_File (Path : Path_Name_Type); 596 -- Record the path of a temporary file, so that it can be deleted at the 597 -- end of execution of gnatmake. 598 599 procedure Record_Temp_File (Path : Path_Name_Type) is 600 begin 601 for J in 1 .. Temp_File_Paths.Last loop 602 if Temp_File_Paths.Table (J) = Path then 603 return; 604 end if; 605 end loop; 606 607 Temp_File_Paths.Append (Path); 608 end Record_Temp_File; 609 610 ------------------------------------------------- 611 -- Subprogram declarations moved from the spec -- 612 ------------------------------------------------- 613 614 procedure Bind (ALI_File : File_Name_Type; Args : Argument_List); 615 -- Binds ALI_File. Args are the arguments to pass to the binder. 616 -- Args must have a lower bound of 1. 617 618 -- If a compilation, bind or link failed one of the following 3 exceptions 619 -- is raised. These need to be handled by the calling routines. 620 621 procedure Compile_Sources 622 (Main_Source : File_Name_Type; 623 Args : Argument_List; 624 First_Compiled_File : out File_Name_Type; 625 Most_Recent_Obj_File : out File_Name_Type; 626 Most_Recent_Obj_Stamp : out Time_Stamp_Type; 627 Main_Unit : out Boolean; 628 Compilation_Failures : out Natural; 629 Main_Index : Int := 0; 630 Check_Readonly_Files : Boolean := False; 631 Do_Not_Execute : Boolean := False; 632 Force_Compilations : Boolean := False; 633 Keep_Going : Boolean := False; 634 In_Place_Mode : Boolean := False; 635 Initialize_ALI_Data : Boolean := True; 636 Max_Process : Positive := 1); 637 -- Compile_Sources will recursively compile all the sources needed by 638 -- Main_Source. Before calling this routine make sure Namet has been 639 -- initialized. This routine can be called repeatedly with different 640 -- Main_Source file as long as all the source (-I flags), library 641 -- (-B flags) and ada library (-A flags) search paths between calls are 642 -- *exactly* the same. The default directory must also be the same. 643 -- 644 -- Args contains the arguments to use during the compilations. 645 -- The lower bound of Args must be 1. 646 -- 647 -- First_Compiled_File is set to the name of the first file that is 648 -- compiled or that needs to be compiled. This is set to No_Name if no 649 -- compilations were needed. 650 -- 651 -- Most_Recent_Obj_File is set to the full name of the most recent 652 -- object file found when no compilations are needed, that is when 653 -- First_Compiled_File is set to No_Name. When First_Compiled_File 654 -- is set then Most_Recent_Obj_File is set to No_Name. 655 -- 656 -- Most_Recent_Obj_Stamp is the time stamp of Most_Recent_Obj_File. 657 -- 658 -- Main_Unit is set to True if Main_Source can be a main unit. 659 -- If Do_Not_Execute is False and First_Compiled_File /= No_Name 660 -- the value of Main_Unit is always False. 661 -- Is this used any more??? It is certainly not used by gnatmake??? 662 -- 663 -- Compilation_Failures is a count of compilation failures. This count 664 -- is used to extract compilation failure reports with Extract_Failure. 665 -- 666 -- Main_Index, when not zero, is the index of the main unit in source 667 -- file Main_Source which is a multi-unit source. 668 -- Zero indicates that Main_Source is a single unit source file. 669 -- 670 -- Check_Readonly_Files set it to True to compile source files 671 -- which library files are read-only. When compiling GNAT predefined 672 -- files the "-gnatg" flag is used. 673 -- 674 -- Do_Not_Execute set it to True to find out the first source that 675 -- needs to be recompiled, but without recompiling it. This file is 676 -- saved in First_Compiled_File. 677 -- 678 -- Force_Compilations forces all compilations no matter what but 679 -- recompiles read-only files only if Check_Readonly_Files 680 -- is set. 681 -- 682 -- Keep_Going when True keep compiling even in the presence of 683 -- compilation errors. 684 -- 685 -- In_Place_Mode when True save library/object files in their object 686 -- directory if they already exist; otherwise, in the source directory. 687 -- 688 -- Initialize_ALI_Data set it to True when you want to initialize ALI 689 -- data-structures. This is what you should do most of the time. 690 -- (especially the first time around when you call this routine). 691 -- This parameter is set to False to preserve previously recorded 692 -- ALI file data. 693 -- 694 -- Max_Process is the maximum number of processes that should be spawned 695 -- to carry out compilations. 696 -- 697 -- Flags in Package Opt Affecting Compile_Sources 698 -- ----------------------------------------------- 699 -- 700 -- Check_Object_Consistency set it to False to omit all consistency 701 -- checks between an .ali file and its corresponding object file. 702 -- When this flag is set to true, every time an .ali is read, 703 -- package Osint checks that the corresponding object file 704 -- exists and is more recent than the .ali. 705 -- 706 -- Use of Name Table Info 707 -- ---------------------- 708 -- 709 -- All file names manipulated by Compile_Sources are entered into the 710 -- Names table. The Byte field of a source file is used to mark it. 711 -- 712 -- Calling Compile_Sources Several Times 713 -- ------------------------------------- 714 -- 715 -- Upon return from Compile_Sources all the ALI data structures are left 716 -- intact for further browsing. HOWEVER upon entry to this routine ALI 717 -- data structures are re-initialized if parameter Initialize_ALI_Data 718 -- above is set to true. Typically this is what you want the first time 719 -- you call Compile_Sources. You should not load an ali file, call this 720 -- routine with flag Initialize_ALI_Data set to True and then expect 721 -- that ALI information to be around after the call. Note that the first 722 -- time you call Compile_Sources you better set Initialize_ALI_Data to 723 -- True unless you have called Initialize_ALI yourself. 724 -- 725 -- Compile_Sources ALGORITHM : Compile_Sources (Main_Source) 726 -- ------------------------- 727 -- 728 -- 1. Insert Main_Source in a Queue (Q) and mark it. 729 -- 730 -- 2. Let unit.adb be the file at the head of the Q. If unit.adb is 731 -- missing but its corresponding ali file is in an Ada library directory 732 -- (see below) then, remove unit.adb from the Q and goto step 4. 733 -- Otherwise, look at the files under the D (dependency) section of 734 -- unit.ali. If unit.ali does not exist or some of the time stamps do 735 -- not match, (re)compile unit.adb. 736 -- 737 -- An Ada library directory is a directory containing Ada specs, ali 738 -- and object files but no source files for the bodies. An Ada library 739 -- directory is communicated to gnatmake by means of some switch so that 740 -- gnatmake can skip the sources whole ali are in that directory. 741 -- There are two reasons for skipping the sources in this case. Firstly, 742 -- Ada libraries typically come without full sources but binding and 743 -- linking against those libraries is still possible. Secondly, it would 744 -- be very wasteful for gnatmake to systematically check the consistency 745 -- of every external Ada library used in a program. The binder is 746 -- already in charge of catching any potential inconsistencies. 747 -- 748 -- 3. Look into the W section of unit.ali and insert into the Q all 749 -- unmarked source files. Mark all files newly inserted in the Q. 750 -- Specifically, assuming that the W section looks like 751 -- 752 -- W types%s types.adb types.ali 753 -- W unchecked_deallocation%s 754 -- W xref_tab%s xref_tab.adb xref_tab.ali 755 -- 756 -- Then xref_tab.adb and types.adb are inserted in the Q if they are not 757 -- already marked. 758 -- Note that there is no file listed under W unchecked_deallocation%s 759 -- so no generic body should ever be explicitly compiled (unless the 760 -- Main_Source at the start was a generic body). 761 -- 762 -- 4. Repeat steps 2 and 3 above until the Q is empty 763 -- 764 -- Note that the above algorithm works because the units withed in 765 -- subunits are transitively included in the W section (with section) of 766 -- the main unit. Likewise the withed units in a generic body needed 767 -- during a compilation are also transitively included in the W section 768 -- of the originally compiled file. 769 770 procedure Link 771 (ALI_File : File_Name_Type; 772 Args : Argument_List; 773 Success : out Boolean); 774 -- Links ALI_File. Args are the arguments to pass to the linker. 775 -- Args must have a lower bound of 1. Success indicates if the link 776 -- succeeded or not. 777 778 Gnatmake_Switch_Found : Boolean := False; 779 780 procedure Scan_Make_Arg (Argv : String); 781 -- Scan make arguments. Argv is a single argument to be processed. 782 783 ------------------- 784 -- Add_Arguments -- 785 ------------------- 786 787 procedure Add_Arguments (Args : Argument_List) is 788 begin 789 if Arguments = null then 790 Arguments := new Argument_List (1 .. Args'Length + 10); 791 792 else 793 while Last_Argument + Args'Length > Arguments'Last loop 794 declare 795 New_Arguments : constant Argument_List_Access := 796 new Argument_List (1 .. Arguments'Last * 2); 797 begin 798 New_Arguments (1 .. Last_Argument) := 799 Arguments (1 .. Last_Argument); 800 Arguments := New_Arguments; 801 end; 802 end loop; 803 end if; 804 805 Arguments (Last_Argument + 1 .. Last_Argument + Args'Length) := Args; 806 Last_Argument := Last_Argument + Args'Length; 807 end Add_Arguments; 808 809 ---------------------------- 810 -- Add_Library_Search_Dir -- 811 ---------------------------- 812 813 procedure Add_Library_Search_Dir (Path : String) is 814 begin 815 Add_Lib_Search_Dir (Normalize_Pathname (Path)); 816 end Add_Library_Search_Dir; 817 818 --------------------------- 819 -- Add_Source_Search_Dir -- 820 --------------------------- 821 822 procedure Add_Source_Search_Dir (Path : String) is 823 begin 824 Add_Src_Search_Dir (Normalize_Pathname (Path)); 825 end Add_Source_Search_Dir; 826 827 ---------------- 828 -- Add_Switch -- 829 ---------------- 830 831 procedure Add_Switch 832 (S : String_Access; 833 Program : Make_Program_Type; 834 Append_Switch : Boolean := True) 835 is 836 generic 837 with package T is new Table.Table (<>); 838 procedure Generic_Position (New_Position : out Integer); 839 -- Generic procedure that chooses a position for S in T at the 840 -- beginning or the end, depending on the boolean Append_Switch. 841 -- Calling this procedure may expand the table. 842 843 ---------------------- 844 -- Generic_Position -- 845 ---------------------- 846 847 procedure Generic_Position (New_Position : out Integer) is 848 begin 849 T.Increment_Last; 850 851 if Append_Switch then 852 New_Position := Integer (T.Last); 853 else 854 for J in reverse T.Table_Index_Type'Succ (T.First) .. T.Last loop 855 T.Table (J) := T.Table (T.Table_Index_Type'Pred (J)); 856 end loop; 857 858 New_Position := Integer (T.First); 859 end if; 860 end Generic_Position; 861 862 procedure Gcc_Switches_Pos is new Generic_Position (Gcc_Switches); 863 procedure Binder_Switches_Pos is new Generic_Position (Binder_Switches); 864 procedure Linker_Switches_Pos is new Generic_Position (Linker_Switches); 865 866 New_Position : Integer; 867 868 -- Start of processing for Add_Switch 869 870 begin 871 case Program is 872 when Compiler => 873 Gcc_Switches_Pos (New_Position); 874 Gcc_Switches.Table (New_Position) := S; 875 876 when Binder => 877 Binder_Switches_Pos (New_Position); 878 Binder_Switches.Table (New_Position) := S; 879 880 when Linker => 881 Linker_Switches_Pos (New_Position); 882 Linker_Switches.Table (New_Position) := S; 883 884 when None => 885 raise Program_Error; 886 end case; 887 end Add_Switch; 888 889 procedure Add_Switch 890 (S : String; 891 Program : Make_Program_Type; 892 Append_Switch : Boolean := True) 893 is 894 begin 895 Add_Switch (S => new String'(S), 896 Program => Program, 897 Append_Switch => Append_Switch); 898 end Add_Switch; 899 900 ---------- 901 -- Bind -- 902 ---------- 903 904 procedure Bind (ALI_File : File_Name_Type; Args : Argument_List) is 905 Bind_Args : Argument_List (1 .. Args'Last + 2); 906 Bind_Last : Integer; 907 Success : Boolean; 908 909 begin 910 pragma Assert (Args'First = 1); 911 912 -- Optimize the simple case where the gnatbind command line looks like 913 -- gnatbind -aO. -I- file.ali 914 -- into 915 -- gnatbind file.adb 916 917 if Args'Length = 2 918 and then Args (Args'First).all = "-aO" & Normalized_CWD 919 and then Args (Args'Last).all = "-I-" 920 and then ALI_File = Strip_Directory (ALI_File) 921 then 922 Bind_Last := Args'First - 1; 923 924 else 925 Bind_Last := Args'Last; 926 Bind_Args (Args'Range) := Args; 927 end if; 928 929 -- It is completely pointless to re-check source file time stamps. This 930 -- has been done already by gnatmake 931 932 Bind_Last := Bind_Last + 1; 933 Bind_Args (Bind_Last) := Do_Not_Check_Flag; 934 935 Get_Name_String (ALI_File); 936 937 Bind_Last := Bind_Last + 1; 938 Bind_Args (Bind_Last) := new String'(Name_Buffer (1 .. Name_Len)); 939 940 GNAT.OS_Lib.Normalize_Arguments (Bind_Args (Args'First .. Bind_Last)); 941 942 Display (Gnatbind.all, Bind_Args (Args'First .. Bind_Last)); 943 944 if Gnatbind_Path = null then 945 Make_Failed ("error, unable to locate " & Gnatbind.all); 946 end if; 947 948 GNAT.OS_Lib.Spawn 949 (Gnatbind_Path.all, Bind_Args (Args'First .. Bind_Last), Success); 950 951 if not Success then 952 Make_Failed ("*** bind failed."); 953 end if; 954 end Bind; 955 956 ----------- 957 -- Check -- 958 ----------- 959 960 procedure Check 961 (Source_File : File_Name_Type; 962 The_Args : Argument_List; 963 Lib_File : File_Name_Type; 964 Full_Lib_File : File_Name_Type; 965 Lib_File_Attr : access File_Attributes; 966 Read_Only : Boolean; 967 ALI : out ALI_Id; 968 O_File : out File_Name_Type; 969 O_Stamp : out Time_Stamp_Type) 970 is 971 function First_New_Spec (A : ALI_Id) return File_Name_Type; 972 -- Looks in the with table entries of A and returns the spec file name 973 -- of the first withed unit (subprogram) for which no spec existed when 974 -- A was generated but for which there exists one now, implying that A 975 -- is now obsolete. If no such unit is found No_File is returned. 976 -- Otherwise the spec file name of the unit is returned. 977 -- 978 -- **WARNING** in the event of Uname format modifications, one *MUST* 979 -- make sure this function is also updated. 980 -- 981 -- Note: This function should really be in ali.adb and use Uname 982 -- services, but this causes the whole compiler to be dragged along 983 -- for gnatbind and gnatmake. 984 985 -------------------- 986 -- First_New_Spec -- 987 -------------------- 988 989 function First_New_Spec (A : ALI_Id) return File_Name_Type is 990 Spec_File_Name : File_Name_Type := No_File; 991 992 function New_Spec (Uname : Unit_Name_Type) return Boolean; 993 -- Uname is the name of the spec or body of some ada unit. This 994 -- function returns True if the Uname is the name of a body which has 995 -- a spec not mentioned in ALI file A. If True is returned 996 -- Spec_File_Name above is set to the name of this spec file. 997 998 -------------- 999 -- New_Spec -- 1000 -------------- 1001 1002 function New_Spec (Uname : Unit_Name_Type) return Boolean is 1003 Spec_Name : Unit_Name_Type; 1004 File_Name : File_Name_Type; 1005 1006 begin 1007 -- Test whether Uname is the name of a body unit (i.e. ends 1008 -- with %b). 1009 1010 Get_Name_String (Uname); 1011 pragma 1012 Assert (Name_Len > 2 and then Name_Buffer (Name_Len - 1) = '%'); 1013 1014 if Name_Buffer (Name_Len) /= 'b' then 1015 return False; 1016 end if; 1017 1018 -- Convert unit name into spec name 1019 1020 -- ??? this code seems dubious in presence of pragma 1021 -- Source_File_Name since there is no more direct relationship 1022 -- between unit name and file name. 1023 1024 -- ??? Further, what about alternative subunit naming 1025 1026 Name_Buffer (Name_Len) := 's'; 1027 Spec_Name := Name_Find; 1028 File_Name := Get_File_Name (Spec_Name, Subunit => False); 1029 1030 -- Look if File_Name is mentioned in A's sdep list. 1031 -- If not look if the file exists. If it does return True. 1032 1033 for D in 1034 ALIs.Table (A).First_Sdep .. ALIs.Table (A).Last_Sdep 1035 loop 1036 if Sdep.Table (D).Sfile = File_Name then 1037 return False; 1038 end if; 1039 end loop; 1040 1041 if Full_Source_Name (File_Name) /= No_File then 1042 Spec_File_Name := File_Name; 1043 return True; 1044 end if; 1045 1046 return False; 1047 end New_Spec; 1048 1049 -- Start of processing for First_New_Spec 1050 1051 begin 1052 U_Chk : for U in 1053 ALIs.Table (A).First_Unit .. ALIs.Table (A).Last_Unit 1054 loop 1055 exit U_Chk when Units.Table (U).Utype = Is_Body_Only 1056 and then New_Spec (Units.Table (U).Uname); 1057 1058 for W in Units.Table (U).First_With 1059 .. 1060 Units.Table (U).Last_With 1061 loop 1062 exit U_Chk when 1063 Withs.Table (W).Afile /= No_File 1064 and then New_Spec (Withs.Table (W).Uname); 1065 end loop; 1066 end loop U_Chk; 1067 1068 return Spec_File_Name; 1069 end First_New_Spec; 1070 1071 --------------------------------- 1072 -- Data declarations for Check -- 1073 --------------------------------- 1074 1075 Full_Obj_File : File_Name_Type; 1076 -- Full name of the object file corresponding to Lib_File 1077 1078 Lib_Stamp : Time_Stamp_Type; 1079 -- Time stamp of the current ada library file 1080 1081 Obj_Stamp : Time_Stamp_Type; 1082 -- Time stamp of the current object file 1083 1084 Modified_Source : File_Name_Type; 1085 -- The first source in Lib_File whose current time stamp differs from 1086 -- that stored in Lib_File. 1087 1088 New_Spec : File_Name_Type; 1089 -- If Lib_File contains in its W (with) section a body (for a 1090 -- subprogram) for which there exists a spec, and the spec did not 1091 -- appear in the Sdep section of Lib_File, New_Spec contains the file 1092 -- name of this new spec. 1093 1094 Source_Name : File_Name_Type; 1095 Text : Text_Buffer_Ptr; 1096 1097 First_Arg : Arg_Id; 1098 -- Index of the first argument in Args.Table for a given unit 1099 1100 Last_Arg : Arg_Id; 1101 -- Index of the last argument in Args.Table for a given unit 1102 1103 Arg : Arg_Id := Arg_Id'First; 1104 -- Current index in Args.Table for a given unit (init to stop warning) 1105 1106 Number_Of_Switches : Natural; 1107 -- Number of switches recorded for a given unit 1108 1109 Prev_Switch : String_Access; 1110 -- Previous switch processed 1111 1112 Switch_Found : Boolean; 1113 -- True if a given switch has been found 1114 1115 begin 1116 pragma Assert (Lib_File /= No_File); 1117 1118 -- If ALI file is read-only, temporarily set Check_Object_Consistency to 1119 -- False. We don't care if the object file is not there (presumably a 1120 -- library will be used for linking.) 1121 1122 if Read_Only then 1123 declare 1124 Saved_Check_Object_Consistency : constant Boolean := 1125 Check_Object_Consistency; 1126 begin 1127 Check_Object_Consistency := False; 1128 Text := Read_Library_Info_From_Full (Full_Lib_File, Lib_File_Attr); 1129 Check_Object_Consistency := Saved_Check_Object_Consistency; 1130 end; 1131 1132 else 1133 Text := Read_Library_Info_From_Full (Full_Lib_File, Lib_File_Attr); 1134 end if; 1135 1136 Full_Obj_File := Full_Object_File_Name; 1137 Lib_Stamp := Current_Library_File_Stamp; 1138 Obj_Stamp := Current_Object_File_Stamp; 1139 1140 if Full_Lib_File = No_File then 1141 Verbose_Msg 1142 (Lib_File, 1143 "being checked ...", 1144 Prefix => " ", 1145 Minimum_Verbosity => Opt.Medium); 1146 else 1147 Verbose_Msg 1148 (Full_Lib_File, 1149 "being checked ...", 1150 Prefix => " ", 1151 Minimum_Verbosity => Opt.Medium); 1152 end if; 1153 1154 ALI := No_ALI_Id; 1155 O_File := Full_Obj_File; 1156 O_Stamp := Obj_Stamp; 1157 1158 if Text = null then 1159 if Full_Lib_File = No_File then 1160 Verbose_Msg (Lib_File, "missing."); 1161 1162 elsif Obj_Stamp (Obj_Stamp'First) = ' ' then 1163 Verbose_Msg (Full_Obj_File, "missing."); 1164 1165 else 1166 Verbose_Msg 1167 (Full_Lib_File, "(" & String (Lib_Stamp) & ") newer than", 1168 Full_Obj_File, "(" & String (Obj_Stamp) & ")"); 1169 end if; 1170 1171 else 1172 ALI := Scan_ALI (Lib_File, Text, Ignore_ED => False, Err => True); 1173 Free (Text); 1174 1175 if ALI = No_ALI_Id then 1176 Verbose_Msg (Full_Lib_File, "incorrectly formatted ALI file"); 1177 return; 1178 1179 elsif ALIs.Table (ALI).Ver (1 .. ALIs.Table (ALI).Ver_Len) /= 1180 Verbose_Library_Version 1181 then 1182 Verbose_Msg (Full_Lib_File, "compiled with old GNAT version"); 1183 ALI := No_ALI_Id; 1184 return; 1185 end if; 1186 1187 -- Don't take ALI file into account if it was generated with errors 1188 1189 if ALIs.Table (ALI).Compile_Errors then 1190 Verbose_Msg (Full_Lib_File, "had errors, must be recompiled"); 1191 ALI := No_ALI_Id; 1192 return; 1193 end if; 1194 1195 -- Don't take ALI file into account if no object was generated 1196 1197 if Operating_Mode /= Check_Semantics 1198 and then ALIs.Table (ALI).No_Object 1199 then 1200 Verbose_Msg (Full_Lib_File, "has no corresponding object"); 1201 ALI := No_ALI_Id; 1202 return; 1203 end if; 1204 1205 -- When compiling with -gnatc, don't take ALI file into account if 1206 -- it has not been generated for the current source, for example if 1207 -- it has been generated for the spec, but we are compiling the body. 1208 1209 if Operating_Mode = Check_Semantics then 1210 declare 1211 File_Name : String := Get_Name_String (Source_File); 1212 OK : Boolean := False; 1213 1214 begin 1215 -- In the ALI file, the source file names are in canonical case 1216 1217 Canonical_Case_File_Name (File_Name); 1218 1219 for U in ALIs.Table (ALI).First_Unit .. 1220 ALIs.Table (ALI).Last_Unit 1221 loop 1222 OK := Get_Name_String (Units.Table (U).Sfile) = File_Name; 1223 exit when OK; 1224 end loop; 1225 1226 if not OK then 1227 Verbose_Msg 1228 (Full_Lib_File, "not generated for the same source"); 1229 ALI := No_ALI_Id; 1230 return; 1231 end if; 1232 end; 1233 end if; 1234 1235 -- Check for matching compiler switches if needed 1236 1237 if Check_Switches then 1238 1239 -- First, collect all the switches 1240 1241 Collect_Arguments (The_Args); 1242 Prev_Switch := Dummy_Switch; 1243 Get_Name_String (ALIs.Table (ALI).Sfile); 1244 Switches_To_Check.Set_Last (0); 1245 1246 for J in 1 .. Last_Argument loop 1247 1248 -- Skip -c, -I and -o switches 1249 1250 if Arguments (J) (1) = '-' 1251 and then Arguments (J) (2) /= 'c' 1252 and then Arguments (J) (2) /= 'o' 1253 and then Arguments (J) (2) /= 'I' 1254 then 1255 Normalize_Compiler_Switches 1256 (Arguments (J).all, 1257 Normalized_Switches, 1258 Last_Norm_Switch); 1259 1260 for K in 1 .. Last_Norm_Switch loop 1261 Switches_To_Check.Increment_Last; 1262 Switches_To_Check.Table (Switches_To_Check.Last) := 1263 Normalized_Switches (K); 1264 end loop; 1265 end if; 1266 end loop; 1267 1268 First_Arg := Units.Table (ALIs.Table (ALI).First_Unit).First_Arg; 1269 Last_Arg := Units.Table (ALIs.Table (ALI).First_Unit).Last_Arg; 1270 1271 for J in 1 .. Switches_To_Check.Last loop 1272 1273 -- Comparing switches is delicate because gcc reorders a number 1274 -- of switches, according to lang-specs.h, but gnatmake doesn't 1275 -- have sufficient knowledge to perform the same reordering. 1276 -- Instead, we ignore orders between different "first letter" 1277 -- switches, but keep orders between same switches, e.g -O -O2 1278 -- is different than -O2 -O, but -g -O is equivalent to -O -g. 1279 1280 if Switches_To_Check.Table (J) (2) /= Prev_Switch (2) or else 1281 (Prev_Switch'Length >= 6 and then 1282 Prev_Switch (2 .. 5) = "gnat" and then 1283 Switches_To_Check.Table (J)'Length >= 6 and then 1284 Switches_To_Check.Table (J) (2 .. 5) = "gnat" and then 1285 Prev_Switch (6) /= Switches_To_Check.Table (J) (6)) 1286 then 1287 Prev_Switch := Switches_To_Check.Table (J); 1288 Arg := First_Arg; 1289 end if; 1290 1291 Switch_Found := False; 1292 1293 for K in Arg .. Last_Arg loop 1294 if 1295 Switches_To_Check.Table (J).all = Args.Table (K).all 1296 then 1297 Arg := K + 1; 1298 Switch_Found := True; 1299 exit; 1300 end if; 1301 end loop; 1302 1303 if not Switch_Found then 1304 if Verbose_Mode then 1305 Verbose_Msg (ALIs.Table (ALI).Sfile, 1306 "switch mismatch """ & 1307 Switches_To_Check.Table (J).all & '"'); 1308 end if; 1309 1310 ALI := No_ALI_Id; 1311 return; 1312 end if; 1313 end loop; 1314 1315 Number_Of_Switches := Natural (Last_Arg - First_Arg + 1); 1316 1317 -- Do not count the multilib switches reinstated by the compiler 1318 -- according to the lang-specs.h.settings. 1319 1320 for K in First_Arg .. Last_Arg loop 1321 if Args.Table (K).all = "-mrtp" then 1322 Number_Of_Switches := Number_Of_Switches - 1; 1323 end if; 1324 end loop; 1325 1326 if Switches_To_Check.Last /= Number_Of_Switches then 1327 if Verbose_Mode then 1328 Verbose_Msg (ALIs.Table (ALI).Sfile, 1329 "different number of switches"); 1330 1331 for K in First_Arg .. Last_Arg loop 1332 Write_Str (Args.Table (K).all); 1333 Write_Char (' '); 1334 end loop; 1335 1336 Write_Eol; 1337 1338 for J in 1 .. Switches_To_Check.Last loop 1339 Write_Str (Switches_To_Check.Table (J).all); 1340 Write_Char (' '); 1341 end loop; 1342 1343 Write_Eol; 1344 end if; 1345 1346 ALI := No_ALI_Id; 1347 return; 1348 end if; 1349 end if; 1350 1351 -- Get the source files and their message digests. Note that some 1352 -- sources may be missing if ALI is out-of-date. 1353 1354 Set_Source_Table (ALI); 1355 1356 Modified_Source := Time_Stamp_Mismatch (ALI, Read_Only); 1357 1358 -- To avoid using too much memory when switch -m is used, free the 1359 -- memory allocated for the source file when computing the checksum. 1360 1361 if Minimal_Recompilation then 1362 Sinput.Clear_Source_File_Table; 1363 end if; 1364 1365 if Modified_Source /= No_File then 1366 ALI := No_ALI_Id; 1367 1368 if Verbose_Mode then 1369 Source_Name := Full_Source_Name (Modified_Source); 1370 1371 if Source_Name /= No_File then 1372 Verbose_Msg (Source_Name, "time stamp mismatch"); 1373 else 1374 Verbose_Msg (Modified_Source, "missing"); 1375 end if; 1376 end if; 1377 1378 else 1379 New_Spec := First_New_Spec (ALI); 1380 1381 if New_Spec /= No_File then 1382 ALI := No_ALI_Id; 1383 1384 if Verbose_Mode then 1385 Source_Name := Full_Source_Name (New_Spec); 1386 1387 if Source_Name /= No_File then 1388 Verbose_Msg (Source_Name, "new spec"); 1389 else 1390 Verbose_Msg (New_Spec, "old spec missing"); 1391 end if; 1392 end if; 1393 1394 end if; 1395 end if; 1396 end if; 1397 end Check; 1398 1399 ------------------------ 1400 -- Check_For_S_Switch -- 1401 ------------------------ 1402 1403 procedure Check_For_S_Switch is 1404 begin 1405 -- By default, we generate an object file 1406 1407 Output_Is_Object := True; 1408 1409 for Arg in 1 .. Last_Argument loop 1410 if Arguments (Arg).all = "-S" then 1411 Output_Is_Object := False; 1412 1413 elsif Arguments (Arg).all = "-c" then 1414 Output_Is_Object := True; 1415 end if; 1416 end loop; 1417 end Check_For_S_Switch; 1418 1419 -------------------------- 1420 -- Check_Linker_Options -- 1421 -------------------------- 1422 1423 procedure Check_Linker_Options 1424 (E_Stamp : Time_Stamp_Type; 1425 O_File : out File_Name_Type; 1426 O_Stamp : out Time_Stamp_Type) 1427 is 1428 procedure Check_File (File : File_Name_Type); 1429 -- Update O_File and O_Stamp if the given file is younger than E_Stamp 1430 -- and O_Stamp, or if O_File is No_File and File does not exist. 1431 1432 function Get_Library_File (Name : String) return File_Name_Type; 1433 -- Return the full file name including path of a library based 1434 -- on the name specified with the -l linker option, using the 1435 -- Ada object path. Return No_File if no such file can be found. 1436 1437 type Char_Array is array (Natural) of Character; 1438 type Char_Array_Access is access constant Char_Array; 1439 1440 Template : Char_Array_Access; 1441 pragma Import (C, Template, "__gnat_library_template"); 1442 1443 ---------------- 1444 -- Check_File -- 1445 ---------------- 1446 1447 procedure Check_File (File : File_Name_Type) is 1448 Stamp : Time_Stamp_Type; 1449 Name : File_Name_Type := File; 1450 1451 begin 1452 Get_Name_String (Name); 1453 1454 -- Remove any trailing NUL characters 1455 1456 while Name_Len >= Name_Buffer'First 1457 and then Name_Buffer (Name_Len) = NUL 1458 loop 1459 Name_Len := Name_Len - 1; 1460 end loop; 1461 1462 if Name_Len = 0 then 1463 return; 1464 1465 elsif Name_Buffer (1) = '-' then 1466 1467 -- Do not check if File is a switch other than "-l" 1468 1469 if Name_Buffer (2) /= 'l' then 1470 return; 1471 end if; 1472 1473 -- The argument is a library switch, get actual name. It 1474 -- is necessary to make a copy of the relevant part of 1475 -- Name_Buffer as Get_Library_Name uses Name_Buffer as well. 1476 1477 declare 1478 Base_Name : constant String := Name_Buffer (3 .. Name_Len); 1479 1480 begin 1481 Name := Get_Library_File (Base_Name); 1482 end; 1483 1484 if Name = No_File then 1485 return; 1486 end if; 1487 end if; 1488 1489 Stamp := File_Stamp (Name); 1490 1491 -- Find the youngest object file that is younger than the 1492 -- executable. If no such file exist, record the first object 1493 -- file that is not found. 1494 1495 if (O_Stamp < Stamp and then E_Stamp < Stamp) 1496 or else (O_File = No_File and then Stamp (Stamp'First) = ' ') 1497 then 1498 O_Stamp := Stamp; 1499 O_File := Name; 1500 1501 -- Strip the trailing NUL if present 1502 1503 Get_Name_String (O_File); 1504 1505 if Name_Buffer (Name_Len) = NUL then 1506 Name_Len := Name_Len - 1; 1507 O_File := Name_Find; 1508 end if; 1509 end if; 1510 end Check_File; 1511 1512 ---------------------- 1513 -- Get_Library_Name -- 1514 ---------------------- 1515 1516 -- See comments in a-adaint.c about template syntax 1517 1518 function Get_Library_File (Name : String) return File_Name_Type is 1519 File : File_Name_Type := No_File; 1520 1521 begin 1522 Name_Len := 0; 1523 1524 for Ptr in Template'Range loop 1525 case Template (Ptr) is 1526 when '*' => 1527 Add_Str_To_Name_Buffer (Name); 1528 1529 when ';' => 1530 File := Full_Lib_File_Name (Name_Find); 1531 exit when File /= No_File; 1532 Name_Len := 0; 1533 1534 when NUL => 1535 exit; 1536 1537 when others => 1538 Add_Char_To_Name_Buffer (Template (Ptr)); 1539 end case; 1540 end loop; 1541 1542 -- The for loop exited because the end of the template 1543 -- was reached. File contains the last possible file name 1544 -- for the library. 1545 1546 if File = No_File and then Name_Len > 0 then 1547 File := Full_Lib_File_Name (Name_Find); 1548 end if; 1549 1550 return File; 1551 end Get_Library_File; 1552 1553 -- Start of processing for Check_Linker_Options 1554 1555 begin 1556 O_File := No_File; 1557 O_Stamp := (others => ' '); 1558 1559 -- Process linker options from the ALI files 1560 1561 for Opt in 1 .. Linker_Options.Last loop 1562 Check_File (File_Name_Type (Linker_Options.Table (Opt).Name)); 1563 end loop; 1564 1565 -- Process options given on the command line 1566 1567 for Opt in Linker_Switches.First .. Linker_Switches.Last loop 1568 1569 -- Check if the previous Opt has one of the two switches 1570 -- that take an extra parameter. (See GCC manual.) 1571 1572 if Opt = Linker_Switches.First 1573 or else (Linker_Switches.Table (Opt - 1).all /= "-u" 1574 and then 1575 Linker_Switches.Table (Opt - 1).all /= "-Xlinker" 1576 and then 1577 Linker_Switches.Table (Opt - 1).all /= "-L") 1578 then 1579 Name_Len := 0; 1580 Add_Str_To_Name_Buffer (Linker_Switches.Table (Opt).all); 1581 Check_File (Name_Find); 1582 end if; 1583 end loop; 1584 end Check_Linker_Options; 1585 1586 ----------------------- 1587 -- Collect_Arguments -- 1588 ----------------------- 1589 1590 procedure Collect_Arguments (Args : Argument_List) is 1591 begin 1592 Last_Argument := 0; 1593 Add_Arguments (Args); 1594 1595 -- Set Output_Is_Object, depending if there is a -S switch. 1596 -- If the bind step is not performed, and there is a -S switch, 1597 -- then we will not check for a valid object file. 1598 1599 Check_For_S_Switch; 1600 end Collect_Arguments; 1601 1602 --------------------- 1603 -- Compile_Sources -- 1604 --------------------- 1605 1606 procedure Compile_Sources 1607 (Main_Source : File_Name_Type; 1608 Args : Argument_List; 1609 First_Compiled_File : out File_Name_Type; 1610 Most_Recent_Obj_File : out File_Name_Type; 1611 Most_Recent_Obj_Stamp : out Time_Stamp_Type; 1612 Main_Unit : out Boolean; 1613 Compilation_Failures : out Natural; 1614 Main_Index : Int := 0; 1615 Check_Readonly_Files : Boolean := False; 1616 Do_Not_Execute : Boolean := False; 1617 Force_Compilations : Boolean := False; 1618 Keep_Going : Boolean := False; 1619 In_Place_Mode : Boolean := False; 1620 Initialize_ALI_Data : Boolean := True; 1621 Max_Process : Positive := 1) 1622 is 1623 Mfile : Natural := No_Mapping_File; 1624 Mapping_File_Arg : String_Access; 1625 -- Info on the mapping file 1626 1627 Need_To_Check_Standard_Library : Boolean := 1628 (Check_Readonly_Files or Must_Compile) 1629 and not Unique_Compile; 1630 1631 procedure Add_Process 1632 (Pid : Process_Id; 1633 Sfile : File_Name_Type; 1634 Afile : File_Name_Type; 1635 Uname : Unit_Name_Type; 1636 Full_Lib_File : File_Name_Type; 1637 Lib_File_Attr : File_Attributes; 1638 Mfile : Natural := No_Mapping_File); 1639 -- Adds process Pid to the current list of outstanding compilation 1640 -- processes and record the full name of the source file Sfile that 1641 -- we are compiling, the name of its library file Afile and the 1642 -- name of its unit Uname. If Mfile is not equal to No_Mapping_File, 1643 -- it is the index of the mapping file used during compilation in the 1644 -- array The_Mapping_File_Names. 1645 1646 procedure Await_Compile 1647 (Data : out Compilation_Data; 1648 OK : out Boolean); 1649 -- Awaits that an outstanding compilation process terminates. When it 1650 -- does set Data to the information registered for the corresponding 1651 -- call to Add_Process. Note that this time stamp can be used to check 1652 -- whether the compilation did generate an object file. OK is set to 1653 -- True if the compilation succeeded. Data could be No_Compilation_Data 1654 -- if there was no compilation to wait for. 1655 1656 function Bad_Compilation_Count return Natural; 1657 -- Returns the number of compilation failures 1658 1659 procedure Check_Standard_Library; 1660 -- Check if s-stalib.adb needs to be compiled 1661 1662 procedure Collect_Arguments_And_Compile 1663 (Full_Source_File : File_Name_Type; 1664 Lib_File : File_Name_Type; 1665 Source_Index : Int; 1666 Pid : out Process_Id; 1667 Process_Created : out Boolean); 1668 -- Collect arguments from project file (if any) and compile. If no 1669 -- compilation was attempted, Processed_Created is set to False, and the 1670 -- value of Pid is unknown. 1671 1672 function Compile 1673 (S : File_Name_Type; 1674 L : File_Name_Type; 1675 Source_Index : Int; 1676 Args : Argument_List) return Process_Id; 1677 -- Compiles S using Args. If S is a GNAT predefined source "-gnatpg" is 1678 -- added to Args. Non blocking call. L corresponds to the expected 1679 -- library file name. Process_Id of the process spawned to execute the 1680 -- compilation. 1681 1682 package Good_ALI is new Table.Table ( 1683 Table_Component_Type => ALI_Id, 1684 Table_Index_Type => Natural, 1685 Table_Low_Bound => 1, 1686 Table_Initial => 50, 1687 Table_Increment => 100, 1688 Table_Name => "Make.Good_ALI"); 1689 -- Contains the set of valid ALI files that have not yet been scanned 1690 1691 function Good_ALI_Present return Boolean; 1692 -- Returns True if any ALI file was recorded in the previous set 1693 1694 procedure Get_Mapping_File; 1695 -- Get a mapping file name. If there is one to be reused, reuse it. 1696 -- Otherwise, create a new mapping file. 1697 1698 function Get_Next_Good_ALI return ALI_Id; 1699 -- Returns the next good ALI_Id record 1700 1701 procedure Record_Failure 1702 (File : File_Name_Type; 1703 Unit : Unit_Name_Type; 1704 Found : Boolean := True); 1705 -- Records in the previous table that the compilation for File failed. 1706 -- If Found is False then the compilation of File failed because we 1707 -- could not find it. Records also Unit when possible. 1708 1709 procedure Record_Good_ALI (A : ALI_Id); 1710 -- Records in the previous set the Id of an ALI file 1711 1712 function Must_Exit_Because_Of_Error return Boolean; 1713 -- Return True if there were errors and the user decided to exit in such 1714 -- a case. This waits for any outstanding compilation. 1715 1716 function Start_Compile_If_Possible (Args : Argument_List) return Boolean; 1717 -- Check if there is more work that we can do (i.e. the Queue is non 1718 -- empty). If there is, do it only if we have not yet used up all the 1719 -- available processes. 1720 -- Returns True if we should exit the main loop 1721 1722 procedure Wait_For_Available_Slot; 1723 -- Check if we should wait for a compilation to finish. This is the case 1724 -- if all the available processes are busy compiling sources or there is 1725 -- nothing else to do (that is the Q is empty and there are no good ALIs 1726 -- to process). 1727 1728 procedure Fill_Queue_From_ALI_Files; 1729 -- Check if we recorded good ALI files. If yes process them now in the 1730 -- order in which they have been recorded. There are two occasions in 1731 -- which we record good ali files. The first is in phase 1 when, after 1732 -- scanning an existing ALI file we realize it is up-to-date, the second 1733 -- instance is after a successful compilation. 1734 1735 ----------------- 1736 -- Add_Process -- 1737 ----------------- 1738 1739 procedure Add_Process 1740 (Pid : Process_Id; 1741 Sfile : File_Name_Type; 1742 Afile : File_Name_Type; 1743 Uname : Unit_Name_Type; 1744 Full_Lib_File : File_Name_Type; 1745 Lib_File_Attr : File_Attributes; 1746 Mfile : Natural := No_Mapping_File) 1747 is 1748 OC1 : constant Positive := Outstanding_Compiles + 1; 1749 1750 begin 1751 pragma Assert (OC1 <= Max_Process); 1752 pragma Assert (Pid /= Invalid_Pid); 1753 1754 Running_Compile (OC1) := 1755 (Pid => Pid, 1756 Full_Source_File => Sfile, 1757 Lib_File => Afile, 1758 Full_Lib_File => Full_Lib_File, 1759 Lib_File_Attr => Lib_File_Attr, 1760 Source_Unit => Uname, 1761 Mapping_File => Mfile); 1762 1763 Outstanding_Compiles := OC1; 1764 1765 end Add_Process; 1766 1767 -------------------- 1768 -- Await_Compile -- 1769 ------------------- 1770 1771 procedure Await_Compile 1772 (Data : out Compilation_Data; 1773 OK : out Boolean) 1774 is 1775 Pid : Process_Id; 1776 1777 begin 1778 pragma Assert (Outstanding_Compiles > 0); 1779 1780 Data := No_Compilation_Data; 1781 OK := False; 1782 1783 Wait_Process (Pid, OK); 1784 1785 if Pid = Invalid_Pid then 1786 return; 1787 end if; 1788 1789 -- Look into the running compilation processes for this PID 1790 1791 for J in Running_Compile'First .. Outstanding_Compiles loop 1792 if Pid = Running_Compile (J).Pid then 1793 Data := Running_Compile (J); 1794 -- If a mapping file was used by this compilation, get its file 1795 -- name for reuse by a subsequent compilation. 1796 1797 if Running_Compile (J).Mapping_File /= No_Mapping_File then 1798 The_Mapping_Files.Last_Free_Indexes := 1799 The_Mapping_Files.Last_Free_Indexes + 1; 1800 The_Mapping_Files.Free_Mapping_File_Indexes 1801 (The_Mapping_Files.Last_Free_Indexes) := 1802 Running_Compile (J).Mapping_File; 1803 end if; 1804 1805 -- To actually remove this Pid and related info from 1806 -- Running_Compile replace its entry with the last valid 1807 -- entry in Running_Compile. 1808 1809 if J = Outstanding_Compiles then 1810 null; 1811 else 1812 Running_Compile (J) := 1813 Running_Compile (Outstanding_Compiles); 1814 end if; 1815 1816 Outstanding_Compiles := Outstanding_Compiles - 1; 1817 exit; 1818 end if; 1819 end loop; 1820 1821 -- If the PID was not found, return with OK set to False 1822 1823 if Data = No_Compilation_Data then 1824 OK := False; 1825 end if; 1826 end Await_Compile; 1827 1828 --------------------------- 1829 -- Bad_Compilation_Count -- 1830 --------------------------- 1831 1832 function Bad_Compilation_Count return Natural is 1833 begin 1834 return Bad_Compilation.Last - Bad_Compilation.First + 1; 1835 end Bad_Compilation_Count; 1836 1837 ---------------------------- 1838 -- Check_Standard_Library -- 1839 ---------------------------- 1840 1841 procedure Check_Standard_Library is 1842 begin 1843 Need_To_Check_Standard_Library := False; 1844 Name_Len := 0; 1845 1846 if not Targparm.Suppress_Standard_Library_On_Target then 1847 Add_Str_To_Name_Buffer (Standard_Library_Package_Body_Name); 1848 else 1849 Add_Str_To_Name_Buffer (System_Package_Spec_Name); 1850 end if; 1851 1852 declare 1853 Add_It : Boolean := True; 1854 Sfile : File_Name_Type; 1855 1856 begin 1857 Sfile := Name_Enter; 1858 1859 -- If we have a special runtime, we add the standard library only 1860 -- if we can find it. 1861 1862 if RTS_Switch then 1863 Add_It := Full_Source_Name (Sfile) /= No_File; 1864 end if; 1865 1866 if Add_It then 1867 if not Queue.Insert 1868 ((File => Sfile, 1869 Unit => No_Unit_Name, 1870 Index => 0)) 1871 then 1872 if Is_In_Obsoleted (Sfile) then 1873 Executable_Obsolete := True; 1874 end if; 1875 end if; 1876 end if; 1877 end; 1878 end Check_Standard_Library; 1879 1880 ----------------------------------- 1881 -- Collect_Arguments_And_Compile -- 1882 ----------------------------------- 1883 1884 procedure Collect_Arguments_And_Compile 1885 (Full_Source_File : File_Name_Type; 1886 Lib_File : File_Name_Type; 1887 Source_Index : Int; 1888 Pid : out Process_Id; 1889 Process_Created : out Boolean) is 1890 begin 1891 Process_Created := False; 1892 1893 -- If we use mapping file (-P or -C switches), then get one 1894 1895 if Create_Mapping_File then 1896 Get_Mapping_File; 1897 end if; 1898 1899 Pid := 1900 Compile 1901 (S => Full_Source_File, 1902 L => Lib_File, 1903 Source_Index => Source_Index, 1904 Args => Arguments (1 .. Last_Argument)); 1905 Process_Created := True; 1906 end Collect_Arguments_And_Compile; 1907 1908 ------------- 1909 -- Compile -- 1910 ------------- 1911 1912 function Compile 1913 (S : File_Name_Type; 1914 L : File_Name_Type; 1915 Source_Index : Int; 1916 Args : Argument_List) return Process_Id 1917 is 1918 Comp_Args : Argument_List (Args'First .. Args'Last + 10); 1919 Comp_Next : Integer := Args'First; 1920 Comp_Last : Integer; 1921 Arg_Index : Integer; 1922 1923 function Ada_File_Name (Name : File_Name_Type) return Boolean; 1924 -- Returns True if Name is the name of an ada source file 1925 -- (i.e. suffix is .ads or .adb) 1926 1927 ------------------- 1928 -- Ada_File_Name -- 1929 ------------------- 1930 1931 function Ada_File_Name (Name : File_Name_Type) return Boolean is 1932 begin 1933 Get_Name_String (Name); 1934 return 1935 Name_Len > 4 1936 and then Name_Buffer (Name_Len - 3 .. Name_Len - 1) = ".ad" 1937 and then (Name_Buffer (Name_Len) = 'b' 1938 or else 1939 Name_Buffer (Name_Len) = 's'); 1940 end Ada_File_Name; 1941 1942 -- Start of processing for Compile 1943 1944 begin 1945 Enter_Into_Obsoleted (S); 1946 1947 -- By default, Syntax_Only is False 1948 1949 Syntax_Only := False; 1950 1951 for J in Args'Range loop 1952 if Args (J).all = "-gnats" then 1953 1954 -- If we compile with -gnats, the bind step and the link step 1955 -- are inhibited. Also, we set Syntax_Only to True, so that 1956 -- we don't fail when we don't find the ALI file, after 1957 -- compilation. 1958 1959 Do_Bind_Step := False; 1960 Do_Link_Step := False; 1961 Syntax_Only := True; 1962 1963 elsif Args (J).all = "-gnatc" then 1964 1965 -- If we compile with -gnatc, the bind step and the link step 1966 -- are inhibited. We set Syntax_Only to False for the case when 1967 -- -gnats was previously specified. 1968 1969 Do_Bind_Step := False; 1970 Do_Link_Step := False; 1971 Syntax_Only := False; 1972 end if; 1973 end loop; 1974 1975 Comp_Args (Comp_Next) := new String'("-gnatea"); 1976 Comp_Next := Comp_Next + 1; 1977 1978 Comp_Args (Comp_Next) := Comp_Flag; 1979 Comp_Next := Comp_Next + 1; 1980 1981 -- Optimize the simple case where the gcc command line looks like 1982 -- gcc -c -I. ... -I- file.adb 1983 -- into 1984 -- gcc -c ... file.adb 1985 1986 if Args (Args'First).all = "-I" & Normalized_CWD 1987 and then Args (Args'Last).all = "-I-" 1988 and then S = Strip_Directory (S) 1989 then 1990 Comp_Last := Comp_Next + Args'Length - 3; 1991 Arg_Index := Args'First + 1; 1992 1993 else 1994 Comp_Last := Comp_Next + Args'Length - 1; 1995 Arg_Index := Args'First; 1996 end if; 1997 1998 -- Make a deep copy of the arguments, because Normalize_Arguments 1999 -- may deallocate some arguments. Also strip target specific -mxxx 2000 -- switches in CodePeer mode. 2001 2002 declare 2003 Index : Natural; 2004 Last : constant Natural := Comp_Last; 2005 2006 begin 2007 Index := Comp_Next; 2008 for J in Comp_Next .. Last loop 2009 declare 2010 Str : String renames Args (Arg_Index).all; 2011 begin 2012 if CodePeer_Mode 2013 and then Str'Length > 2 2014 and then Str (Str'First .. Str'First + 1) = "-m" 2015 then 2016 Comp_Last := Comp_Last - 1; 2017 else 2018 Comp_Args (Index) := new String'(Str); 2019 Index := Index + 1; 2020 end if; 2021 end; 2022 2023 Arg_Index := Arg_Index + 1; 2024 end loop; 2025 end; 2026 2027 -- Set -gnatpg for predefined files (for this purpose the renamings 2028 -- such as Text_IO do not count as predefined). Note that we strip 2029 -- the directory name from the source file name because the call to 2030 -- Fname.Is_Predefined_File_Name cannot deal with directory prefixes. 2031 2032 declare 2033 Fname : constant File_Name_Type := Strip_Directory (S); 2034 2035 begin 2036 if Is_Predefined_File_Name 2037 (Fname, Renamings_Included => False) 2038 then 2039 if Check_Readonly_Files or else Must_Compile then 2040 Comp_Args (Comp_Args'First + 2 .. Comp_Last + 1) := 2041 Comp_Args (Comp_Args'First + 1 .. Comp_Last); 2042 Comp_Last := Comp_Last + 1; 2043 Comp_Args (Comp_Args'First + 1) := GNAT_Flag; 2044 2045 else 2046 Make_Failed 2047 ("not allowed to compile """ & 2048 Get_Name_String (Fname) & 2049 """; use -a switch, or use the compiler directly with " 2050 & "the ""-gnatg"" switch"); 2051 end if; 2052 end if; 2053 end; 2054 2055 -- Now check if the file name has one of the suffixes familiar to 2056 -- the gcc driver. If this is not the case then add the ada flag 2057 -- "-x ada". 2058 -- Append systematically "-x adascil" in CodePeer mode instead, to 2059 -- force the use of gnat1scil instead of gnat1. 2060 2061 if CodePeer_Mode then 2062 Comp_Last := Comp_Last + 1; 2063 Comp_Args (Comp_Last) := Ada_Flag_1; 2064 Comp_Last := Comp_Last + 1; 2065 Comp_Args (Comp_Last) := AdaSCIL_Flag; 2066 2067 elsif not Ada_File_Name (S) then 2068 Comp_Last := Comp_Last + 1; 2069 Comp_Args (Comp_Last) := Ada_Flag_1; 2070 Comp_Last := Comp_Last + 1; 2071 Comp_Args (Comp_Last) := Ada_Flag_2; 2072 end if; 2073 2074 if Source_Index /= 0 then 2075 declare 2076 Num : constant String := Source_Index'Img; 2077 begin 2078 Comp_Last := Comp_Last + 1; 2079 Comp_Args (Comp_Last) := 2080 new String'("-gnateI" & Num (Num'First + 1 .. Num'Last)); 2081 end; 2082 end if; 2083 2084 if Source_Index /= 0 2085 or else L /= Strip_Directory (L) 2086 or else Object_Directory_Path /= null 2087 then 2088 -- Build -o argument 2089 2090 Get_Name_String (L); 2091 2092 for J in reverse 1 .. Name_Len loop 2093 if Name_Buffer (J) = '.' then 2094 Name_Len := J + Object_Suffix'Length - 1; 2095 Name_Buffer (J .. Name_Len) := Object_Suffix; 2096 exit; 2097 end if; 2098 end loop; 2099 2100 Comp_Last := Comp_Last + 1; 2101 Comp_Args (Comp_Last) := Output_Flag; 2102 Comp_Last := Comp_Last + 1; 2103 2104 -- If an object directory was specified, prepend the object file 2105 -- name with this object directory. 2106 2107 if Object_Directory_Path /= null then 2108 Comp_Args (Comp_Last) := 2109 new String'(Object_Directory_Path.all & 2110 Name_Buffer (1 .. Name_Len)); 2111 2112 else 2113 Comp_Args (Comp_Last) := 2114 new String'(Name_Buffer (1 .. Name_Len)); 2115 end if; 2116 end if; 2117 2118 if Create_Mapping_File and then Mapping_File_Arg /= null then 2119 Comp_Last := Comp_Last + 1; 2120 Comp_Args (Comp_Last) := new String'(Mapping_File_Arg.all); 2121 end if; 2122 2123 Get_Name_String (S); 2124 2125 Comp_Last := Comp_Last + 1; 2126 Comp_Args (Comp_Last) := new String'(Name_Buffer (1 .. Name_Len)); 2127 2128 -- Change to object directory of the project file, if necessary 2129 2130 GNAT.OS_Lib.Normalize_Arguments (Comp_Args (Args'First .. Comp_Last)); 2131 2132 Comp_Last := Comp_Last + 1; 2133 Comp_Args (Comp_Last) := new String'("-gnatez"); 2134 2135 Display (Gcc.all, Comp_Args (Args'First .. Comp_Last)); 2136 2137 if Gcc_Path = null then 2138 Make_Failed ("error, unable to locate " & Gcc.all); 2139 end if; 2140 2141 return 2142 GNAT.OS_Lib.Non_Blocking_Spawn 2143 (Gcc_Path.all, Comp_Args (Args'First .. Comp_Last)); 2144 end Compile; 2145 2146 ------------------------------- 2147 -- Fill_Queue_From_ALI_Files -- 2148 ------------------------------- 2149 2150 procedure Fill_Queue_From_ALI_Files is 2151 ALI : ALI_Id; 2152 Source_Index : Int; 2153 Sfile : File_Name_Type; 2154 2155 begin 2156 while Good_ALI_Present loop 2157 ALI := Get_Next_Good_ALI; 2158 Source_Index := Unit_Index_Of (ALIs.Table (ALI).Afile); 2159 2160 -- If we are processing the library file corresponding to the 2161 -- main source file check if this source can be a main unit. 2162 2163 if ALIs.Table (ALI).Sfile = Main_Source 2164 and then Source_Index = Main_Index 2165 then 2166 Main_Unit := ALIs.Table (ALI).Main_Program /= None; 2167 end if; 2168 2169 -- The following adds the standard library (s-stalib) to the list 2170 -- of files to be handled by gnatmake: this file and any files it 2171 -- depends on are always included in every bind, even if they are 2172 -- not in the explicit dependency list. Of course, it is not added 2173 -- if Suppress_Standard_Library is True. 2174 2175 -- However, to avoid annoying output about s-stalib.ali being read 2176 -- only, when "-v" is used, we add the standard library only when 2177 -- "-a" is used. 2178 2179 if Need_To_Check_Standard_Library then 2180 Check_Standard_Library; 2181 end if; 2182 2183 -- Now insert in the Q the unmarked source files (i.e. those which 2184 -- have never been inserted in the Q and hence never considered). 2185 -- Only do that if Unique_Compile is False. 2186 2187 if not Unique_Compile then 2188 for J in 2189 ALIs.Table (ALI).First_Unit .. ALIs.Table (ALI).Last_Unit 2190 loop 2191 for K in 2192 Units.Table (J).First_With .. Units.Table (J).Last_With 2193 loop 2194 Sfile := Withs.Table (K).Sfile; 2195 2196 Dependencies.Append ((ALIs.Table (ALI).Sfile, Sfile)); 2197 2198 if Is_In_Obsoleted (Sfile) then 2199 Executable_Obsolete := True; 2200 end if; 2201 2202 if Sfile = No_File then 2203 Debug_Msg ("Skipping generic:", Withs.Table (K).Uname); 2204 2205 else 2206 Source_Index := Unit_Index_Of (Withs.Table (K).Afile); 2207 2208 if not (Check_Readonly_Files or Must_Compile) 2209 and then Is_Internal_File_Name (Sfile, False) 2210 then 2211 Debug_Msg ("Skipping internal file:", Sfile); 2212 2213 else 2214 Queue.Insert 2215 ((File => Sfile, 2216 Unit => Withs.Table (K).Uname, 2217 Index => Source_Index)); 2218 end if; 2219 end if; 2220 end loop; 2221 end loop; 2222 end if; 2223 end loop; 2224 end Fill_Queue_From_ALI_Files; 2225 2226 ---------------------- 2227 -- Get_Mapping_File -- 2228 ---------------------- 2229 2230 procedure Get_Mapping_File is 2231 begin 2232 -- If there is a mapping file ready to be reused, reuse it 2233 2234 if The_Mapping_Files.Last_Free_Indexes > 0 then 2235 Mfile := 2236 The_Mapping_Files.Free_Mapping_File_Indexes 2237 (The_Mapping_Files.Last_Free_Indexes); 2238 The_Mapping_Files.Last_Free_Indexes := 2239 The_Mapping_Files.Last_Free_Indexes - 1; 2240 2241 -- Otherwise, create and initialize a new one 2242 2243 else 2244 Init_Mapping_File (File_Index => Mfile); 2245 end if; 2246 2247 -- Put the name in the mapping file argument for the invocation 2248 -- of the compiler. 2249 2250 Free (Mapping_File_Arg); 2251 Mapping_File_Arg := 2252 new String' 2253 ("-gnatem=" & 2254 Get_Name_String 2255 (The_Mapping_Files.Mapping_File_Names (Mfile))); 2256 end Get_Mapping_File; 2257 2258 ----------------------- 2259 -- Get_Next_Good_ALI -- 2260 ----------------------- 2261 2262 function Get_Next_Good_ALI return ALI_Id is 2263 ALIP : ALI_Id; 2264 2265 begin 2266 pragma Assert (Good_ALI_Present); 2267 ALIP := Good_ALI.Table (Good_ALI.Last); 2268 Good_ALI.Decrement_Last; 2269 return ALIP; 2270 end Get_Next_Good_ALI; 2271 2272 ---------------------- 2273 -- Good_ALI_Present -- 2274 ---------------------- 2275 2276 function Good_ALI_Present return Boolean is 2277 begin 2278 return Good_ALI.First <= Good_ALI.Last; 2279 end Good_ALI_Present; 2280 2281 -------------------------------- 2282 -- Must_Exit_Because_Of_Error -- 2283 -------------------------------- 2284 2285 function Must_Exit_Because_Of_Error return Boolean is 2286 Data : Compilation_Data; 2287 Success : Boolean; 2288 2289 begin 2290 if Bad_Compilation_Count > 0 and then not Keep_Going then 2291 while Outstanding_Compiles > 0 loop 2292 Await_Compile (Data, Success); 2293 2294 if not Success then 2295 Record_Failure (Data.Full_Source_File, Data.Source_Unit); 2296 end if; 2297 end loop; 2298 2299 return True; 2300 end if; 2301 2302 return False; 2303 end Must_Exit_Because_Of_Error; 2304 2305 -------------------- 2306 -- Record_Failure -- 2307 -------------------- 2308 2309 procedure Record_Failure 2310 (File : File_Name_Type; 2311 Unit : Unit_Name_Type; 2312 Found : Boolean := True) 2313 is 2314 begin 2315 Bad_Compilation.Increment_Last; 2316 Bad_Compilation.Table (Bad_Compilation.Last) := (File, Unit, Found); 2317 end Record_Failure; 2318 2319 --------------------- 2320 -- Record_Good_ALI -- 2321 --------------------- 2322 2323 procedure Record_Good_ALI (A : ALI_Id) is 2324 begin 2325 Good_ALI.Increment_Last; 2326 Good_ALI.Table (Good_ALI.Last) := A; 2327 end Record_Good_ALI; 2328 2329 ------------------------------- 2330 -- Start_Compile_If_Possible -- 2331 ------------------------------- 2332 2333 function Start_Compile_If_Possible 2334 (Args : Argument_List) return Boolean 2335 is 2336 In_Lib_Dir : Boolean; 2337 Need_To_Compile : Boolean; 2338 Pid : Process_Id := Invalid_Pid; 2339 Process_Created : Boolean; 2340 2341 Source : Queue.Source_Info; 2342 Full_Source_File : File_Name_Type := No_File; 2343 Source_File_Attr : aliased File_Attributes; 2344 -- The full name of the source file and its attributes (size, ...) 2345 2346 Lib_File : File_Name_Type; 2347 Full_Lib_File : File_Name_Type := No_File; 2348 Lib_File_Attr : aliased File_Attributes; 2349 Read_Only : Boolean := False; 2350 ALI : ALI_Id; 2351 -- The ALI file and its attributes (size, stamp, ...) 2352 2353 Obj_File : File_Name_Type; 2354 Obj_Stamp : Time_Stamp_Type; 2355 -- The object file 2356 2357 Found : Boolean; 2358 2359 begin 2360 if not Queue.Is_Empty and then 2361 Outstanding_Compiles < Max_Process 2362 then 2363 Queue.Extract (Found, Source); 2364 2365 Osint.Full_Source_Name 2366 (Source.File, 2367 Full_File => Full_Source_File, 2368 Attr => Source_File_Attr'Access); 2369 2370 Lib_File := Osint.Lib_File_Name (Source.File, Source.Index); 2371 2372 Osint.Full_Lib_File_Name 2373 (Lib_File, 2374 Lib_File => Full_Lib_File, 2375 Attr => Lib_File_Attr); 2376 2377 -- If source has already been compiled, executable is obsolete 2378 2379 if Is_In_Obsoleted (Source.File) then 2380 Executable_Obsolete := True; 2381 end if; 2382 2383 In_Lib_Dir := Full_Lib_File /= No_File 2384 and then In_Ada_Lib_Dir (Full_Lib_File); 2385 2386 -- Since the following requires a system call, we precompute it 2387 -- when needed. 2388 2389 if not In_Lib_Dir then 2390 if Full_Lib_File /= No_File 2391 and then not (Check_Readonly_Files or else Must_Compile) 2392 then 2393 Get_Name_String (Full_Lib_File); 2394 Name_Buffer (Name_Len + 1) := ASCII.NUL; 2395 Read_Only := not Is_Writable_File 2396 (Name_Buffer'Address, Lib_File_Attr'Access); 2397 else 2398 Read_Only := False; 2399 end if; 2400 end if; 2401 2402 -- If the library file is an Ada library skip it 2403 2404 if In_Lib_Dir then 2405 Verbose_Msg 2406 (Lib_File, 2407 "is in an Ada library", 2408 Prefix => " ", 2409 Minimum_Verbosity => Opt.High); 2410 2411 -- If the library file is a read-only library skip it, but only 2412 -- if, when using project files, this library file is in the 2413 -- right object directory (a read-only ALI file in the object 2414 -- directory of a project being extended must not be skipped). 2415 2416 elsif Read_Only then 2417 Verbose_Msg 2418 (Lib_File, 2419 "is a read-only library", 2420 Prefix => " ", 2421 Minimum_Verbosity => Opt.High); 2422 2423 -- The source file that we are checking cannot be located 2424 2425 elsif Full_Source_File = No_File then 2426 Record_Failure (Source.File, Source.Unit, False); 2427 2428 -- Source and library files can be located but are internal 2429 -- files. 2430 2431 elsif not (Check_Readonly_Files or else Must_Compile) 2432 and then Full_Lib_File /= No_File 2433 and then Is_Internal_File_Name (Source.File, False) 2434 then 2435 if Force_Compilations then 2436 Fail 2437 ("not allowed to compile """ & 2438 Get_Name_String (Source.File) & 2439 """; use -a switch, or use the compiler directly with " 2440 & "the ""-gnatg"" switch"); 2441 end if; 2442 2443 Verbose_Msg 2444 (Lib_File, 2445 "is an internal library", 2446 Prefix => " ", 2447 Minimum_Verbosity => Opt.High); 2448 2449 -- The source file that we are checking can be located 2450 2451 else 2452 Collect_Arguments (Args); 2453 2454 -- Don't waste any time if we have to recompile anyway 2455 2456 Obj_Stamp := Empty_Time_Stamp; 2457 Need_To_Compile := Force_Compilations; 2458 2459 if not Force_Compilations then 2460 Check (Source_File => Source.File, 2461 The_Args => Args, 2462 Lib_File => Lib_File, 2463 Full_Lib_File => Full_Lib_File, 2464 Lib_File_Attr => Lib_File_Attr'Access, 2465 Read_Only => Read_Only, 2466 ALI => ALI, 2467 O_File => Obj_File, 2468 O_Stamp => Obj_Stamp); 2469 Need_To_Compile := (ALI = No_ALI_Id); 2470 end if; 2471 2472 if not Need_To_Compile then 2473 2474 -- The ALI file is up-to-date; record its Id 2475 2476 Record_Good_ALI (ALI); 2477 2478 -- Record the time stamp of the most recent object 2479 -- file as long as no (re)compilations are needed. 2480 2481 if First_Compiled_File = No_File 2482 and then (Most_Recent_Obj_File = No_File 2483 or else Obj_Stamp > Most_Recent_Obj_Stamp) 2484 then 2485 Most_Recent_Obj_File := Obj_File; 2486 Most_Recent_Obj_Stamp := Obj_Stamp; 2487 end if; 2488 2489 else 2490 -- Is this the first file we have to compile? 2491 2492 if First_Compiled_File = No_File then 2493 First_Compiled_File := Full_Source_File; 2494 Most_Recent_Obj_File := No_File; 2495 2496 if Do_Not_Execute then 2497 2498 -- Exit the main loop 2499 2500 return True; 2501 end if; 2502 end if; 2503 2504 -- Compute where the ALI file must be generated in 2505 -- In_Place_Mode (this does not require to know the 2506 -- location of the object directory). 2507 2508 if In_Place_Mode then 2509 if Full_Lib_File = No_File then 2510 2511 -- If the library file was not found, then save 2512 -- the library file near the source file. 2513 2514 Lib_File := 2515 Osint.Lib_File_Name 2516 (Full_Source_File, Source.Index); 2517 Full_Lib_File := Lib_File; 2518 2519 else 2520 -- If the library file was found, then save the 2521 -- library file in the same place. 2522 2523 Lib_File := Full_Lib_File; 2524 end if; 2525 end if; 2526 2527 -- Start the compilation and record it. We can do this 2528 -- because there is at least one free process. This might 2529 -- change the current directory. 2530 2531 Collect_Arguments_And_Compile 2532 (Full_Source_File => Full_Source_File, 2533 Lib_File => Lib_File, 2534 Source_Index => Source.Index, 2535 Pid => Pid, 2536 Process_Created => Process_Created); 2537 2538 -- Compute where the ALI file will be generated (for 2539 -- cases that might require to know the current 2540 -- directory). The current directory might be changed 2541 -- when compiling other files so we cannot rely on it 2542 -- being the same to find the resulting ALI file. 2543 2544 if not In_Place_Mode then 2545 2546 -- Compute the expected location of the ALI file. This 2547 -- can be from several places: 2548 -- -i => in place mode. In such a case, 2549 -- Full_Lib_File has already been set above 2550 -- -D => if specified 2551 -- or defaults in current dir 2552 -- We could simply use a call similar to 2553 -- Osint.Full_Lib_File_Name (Lib_File) 2554 -- but that involves system calls and is thus slower 2555 2556 if Object_Directory_Path /= null then 2557 Name_Len := 0; 2558 Add_Str_To_Name_Buffer (Object_Directory_Path.all); 2559 Add_Str_To_Name_Buffer (Get_Name_String (Lib_File)); 2560 Full_Lib_File := Name_Find; 2561 2562 else 2563 Full_Lib_File := Lib_File; 2564 end if; 2565 2566 end if; 2567 2568 Lib_File_Attr := Unknown_Attributes; 2569 2570 -- Make sure we could successfully start the compilation 2571 2572 if Process_Created then 2573 if Pid = Invalid_Pid then 2574 Record_Failure (Full_Source_File, Source.Unit); 2575 else 2576 Add_Process 2577 (Pid => Pid, 2578 Sfile => Full_Source_File, 2579 Afile => Lib_File, 2580 Uname => Source.Unit, 2581 Mfile => Mfile, 2582 Full_Lib_File => Full_Lib_File, 2583 Lib_File_Attr => Lib_File_Attr); 2584 end if; 2585 end if; 2586 end if; 2587 end if; 2588 end if; 2589 return False; 2590 end Start_Compile_If_Possible; 2591 2592 ----------------------------- 2593 -- Wait_For_Available_Slot -- 2594 ----------------------------- 2595 2596 procedure Wait_For_Available_Slot is 2597 Compilation_OK : Boolean; 2598 Text : Text_Buffer_Ptr; 2599 ALI : ALI_Id; 2600 Data : Compilation_Data; 2601 2602 begin 2603 if Outstanding_Compiles = Max_Process 2604 or else (Queue.Is_Empty 2605 and then not Good_ALI_Present 2606 and then Outstanding_Compiles > 0) 2607 then 2608 Await_Compile (Data, Compilation_OK); 2609 2610 if not Compilation_OK then 2611 Record_Failure (Data.Full_Source_File, Data.Source_Unit); 2612 end if; 2613 2614 if Compilation_OK or else Keep_Going then 2615 2616 -- Re-read the updated library file 2617 2618 declare 2619 Saved_Object_Consistency : constant Boolean := 2620 Check_Object_Consistency; 2621 2622 begin 2623 -- If compilation was not OK, or if output is not an object 2624 -- file and we don't do the bind step, don't check for 2625 -- object consistency. 2626 2627 Check_Object_Consistency := 2628 Check_Object_Consistency 2629 and Compilation_OK 2630 and (Output_Is_Object or Do_Bind_Step); 2631 2632 Text := 2633 Read_Library_Info_From_Full 2634 (Data.Full_Lib_File, Data.Lib_File_Attr'Access); 2635 2636 -- Restore Check_Object_Consistency to its initial value 2637 2638 Check_Object_Consistency := Saved_Object_Consistency; 2639 end; 2640 2641 -- If an ALI file was generated by this compilation, scan the 2642 -- ALI file and record it. 2643 2644 -- If the scan fails, a previous ali file is inconsistent with 2645 -- the unit just compiled. 2646 2647 if Text /= null then 2648 ALI := 2649 Scan_ALI 2650 (Data.Lib_File, Text, Ignore_ED => False, Err => True); 2651 2652 if ALI = No_ALI_Id then 2653 2654 -- Record a failure only if not already done 2655 2656 if Compilation_OK then 2657 Inform 2658 (Data.Lib_File, 2659 "incompatible ALI file, please recompile"); 2660 Record_Failure 2661 (Data.Full_Source_File, Data.Source_Unit); 2662 end if; 2663 2664 else 2665 Record_Good_ALI (ALI); 2666 end if; 2667 2668 Free (Text); 2669 2670 -- If we could not read the ALI file that was just generated 2671 -- then there could be a problem reading either the ALI or the 2672 -- corresponding object file (if Check_Object_Consistency is 2673 -- set Read_Library_Info checks that the time stamp of the 2674 -- object file is more recent than that of the ALI). However, 2675 -- we record a failure only if not already done. 2676 2677 else 2678 if Compilation_OK and not Syntax_Only then 2679 Inform 2680 (Data.Lib_File, 2681 "WARNING: ALI or object file not found after compile"); 2682 2683 if not Is_Regular_File 2684 (Get_Name_String (Name_Id (Data.Full_Lib_File))) 2685 then 2686 Inform (Data.Full_Lib_File, "not found"); 2687 end if; 2688 2689 Record_Failure (Data.Full_Source_File, Data.Source_Unit); 2690 end if; 2691 end if; 2692 end if; 2693 end if; 2694 end Wait_For_Available_Slot; 2695 2696 -- Start of processing for Compile_Sources 2697 2698 begin 2699 pragma Assert (Args'First = 1); 2700 2701 Outstanding_Compiles := 0; 2702 Running_Compile := new Comp_Data_Arr (1 .. Max_Process); 2703 2704 -- Package and Queue initializations 2705 2706 Good_ALI.Init; 2707 2708 if Initialize_ALI_Data then 2709 Initialize_ALI; 2710 Initialize_ALI_Source; 2711 end if; 2712 2713 -- The following two flags affect the behavior of ALI.Set_Source_Table. 2714 -- We set Check_Source_Files to True to ensure that source file time 2715 -- stamps are checked, and we set All_Sources to False to avoid checking 2716 -- the presence of the source files listed in the source dependency 2717 -- section of an ali file (which would be a mistake since the ali file 2718 -- may be obsolete). 2719 2720 Check_Source_Files := True; 2721 All_Sources := False; 2722 2723 Queue.Insert 2724 ((File => Main_Source, 2725 Unit => No_Unit_Name, 2726 Index => Main_Index)); 2727 2728 First_Compiled_File := No_File; 2729 Most_Recent_Obj_File := No_File; 2730 Most_Recent_Obj_Stamp := Empty_Time_Stamp; 2731 Main_Unit := False; 2732 2733 -- Keep looping until there is no more work to do (the Q is empty) 2734 -- and all the outstanding compilations have terminated. 2735 2736 Make_Loop : 2737 while not Queue.Is_Empty or else Outstanding_Compiles > 0 loop 2738 exit Make_Loop when Must_Exit_Because_Of_Error; 2739 exit Make_Loop when Start_Compile_If_Possible (Args); 2740 2741 Wait_For_Available_Slot; 2742 2743 -- ??? Should be done as soon as we add a Good_ALI, wouldn't it avoid 2744 -- the need for a list of good ALI? 2745 2746 Fill_Queue_From_ALI_Files; 2747 2748 if Display_Compilation_Progress then 2749 Write_Str ("completed "); 2750 Write_Int (Int (Queue.Processed)); 2751 Write_Str (" out of "); 2752 Write_Int (Int (Queue.Size)); 2753 Write_Str (" ("); 2754 Write_Int (Int ((Queue.Processed * 100) / Queue.Size)); 2755 Write_Str ("%)..."); 2756 Write_Eol; 2757 end if; 2758 end loop Make_Loop; 2759 2760 Compilation_Failures := Bad_Compilation_Count; 2761 2762 -- Compilation is finished 2763 2764 end Compile_Sources; 2765 2766 --------------- 2767 -- Debug_Msg -- 2768 --------------- 2769 2770 procedure Debug_Msg (S : String; N : Name_Id) is 2771 begin 2772 if Debug.Debug_Flag_W then 2773 Write_Str (" ... "); 2774 Write_Str (S); 2775 Write_Str (" "); 2776 Write_Name (N); 2777 Write_Eol; 2778 end if; 2779 end Debug_Msg; 2780 2781 procedure Debug_Msg (S : String; N : File_Name_Type) is 2782 begin 2783 Debug_Msg (S, Name_Id (N)); 2784 end Debug_Msg; 2785 2786 procedure Debug_Msg (S : String; N : Unit_Name_Type) is 2787 begin 2788 Debug_Msg (S, Name_Id (N)); 2789 end Debug_Msg; 2790 2791 ------------- 2792 -- Display -- 2793 ------------- 2794 2795 procedure Display (Program : String; Args : Argument_List) is 2796 begin 2797 pragma Assert (Args'First = 1); 2798 2799 if not Quiet_Output then 2800 Write_Str (Program); 2801 2802 for J in Args'Range loop 2803 2804 -- Never display -gnatea nor -gnatez 2805 2806 if Args (J).all /= "-gnatea" 2807 and then 2808 Args (J).all /= "-gnatez" 2809 then 2810 -- Do not display the -F=mapping_file switch for gnatbind if 2811 -- -dn is not specified. 2812 2813 if Opt.Keep_Temporary_Files 2814 or else Args (J)'Length < 4 2815 or else 2816 Args (J) (Args (J)'First .. Args (J)'First + 2) /= "-F=" 2817 then 2818 Write_Str (" "); 2819 2820 -- If -df is used, only display file names, not path 2821 -- names. 2822 2823 if Debug.Debug_Flag_F then 2824 declare 2825 Equal_Pos : Natural; 2826 2827 begin 2828 Equal_Pos := Args (J)'First - 1; 2829 for K in Args (J)'Range loop 2830 if Args (J) (K) = '=' then 2831 Equal_Pos := K; 2832 exit; 2833 end if; 2834 end loop; 2835 2836 if Is_Absolute_Path 2837 (Args (J) (Equal_Pos + 1 .. Args (J)'Last)) 2838 then 2839 Write_Str 2840 (Args (J) (Args (J)'First .. Equal_Pos)); 2841 Write_Str 2842 (File_Name 2843 (Args (J) 2844 (Equal_Pos + 1 .. Args (J)'Last))); 2845 2846 else 2847 Write_Str (Args (J).all); 2848 end if; 2849 end; 2850 2851 else 2852 Write_Str (Args (J).all); 2853 end if; 2854 end if; 2855 end if; 2856 end loop; 2857 2858 Write_Eol; 2859 end if; 2860 end Display; 2861 2862 -------------------------- 2863 -- Enter_Into_Obsoleted -- 2864 -------------------------- 2865 2866 procedure Enter_Into_Obsoleted (F : File_Name_Type) is 2867 Name : constant String := Get_Name_String (F); 2868 First : Natural; 2869 F2 : File_Name_Type; 2870 2871 begin 2872 First := Name'Last; 2873 while First > Name'First 2874 and then not Is_Directory_Separator (Name (First - 1)) 2875 loop 2876 First := First - 1; 2877 end loop; 2878 2879 if First /= Name'First then 2880 Name_Len := 0; 2881 Add_Str_To_Name_Buffer (Name (First .. Name'Last)); 2882 F2 := Name_Find; 2883 2884 else 2885 F2 := F; 2886 end if; 2887 2888 Debug_Msg ("New entry in Obsoleted table:", F2); 2889 Obsoleted.Set (F2, True); 2890 end Enter_Into_Obsoleted; 2891 2892 ------------------- 2893 -- Linking_Phase -- 2894 ------------------- 2895 2896 procedure Linking_Phase 2897 (Non_Std_Executable : Boolean := False; 2898 Executable : File_Name_Type := No_File; 2899 Main_ALI_File : File_Name_Type) 2900 is 2901 Linker_Switches_Last : constant Integer := Linker_Switches.Last; 2902 2903 begin 2904 if not Run_Path_Option then 2905 Linker_Switches.Increment_Last; 2906 Linker_Switches.Table (Linker_Switches.Last) := 2907 new String'("-R"); 2908 end if; 2909 2910 if CodePeer_Mode then 2911 Linker_Switches.Increment_Last; 2912 Linker_Switches.Table (Linker_Switches.Last) := 2913 new String'(CodePeer_Mode_String); 2914 end if; 2915 2916 -- Add switch -M to gnatlink if builder switch --create-map-file 2917 -- has been specified. 2918 2919 if Map_File /= null then 2920 Linker_Switches.Increment_Last; 2921 Linker_Switches.Table (Linker_Switches.Last) := 2922 new String'("-M" & Map_File.all); 2923 end if; 2924 2925 declare 2926 Args : Argument_List 2927 (Linker_Switches.First .. Linker_Switches.Last + 2); 2928 2929 Last_Arg : Integer := Linker_Switches.First - 1; 2930 Skip : Boolean := False; 2931 2932 begin 2933 -- Get all the linker switches 2934 2935 for J in Linker_Switches.First .. Linker_Switches.Last loop 2936 if Skip then 2937 Skip := False; 2938 2939 elsif Non_Std_Executable 2940 and then Linker_Switches.Table (J).all = "-o" 2941 then 2942 Skip := True; 2943 2944 -- Here we capture and duplicate the linker argument. We 2945 -- need to do the duplication since the arguments will get 2946 -- normalized. Not doing so will result in calling normalized 2947 -- two times for the same set of arguments if gnatmake is 2948 -- passed multiple mains. This can result in the wrong 2949 -- argument being passed to the linker. 2950 2951 else 2952 Last_Arg := Last_Arg + 1; 2953 Args (Last_Arg) := new String'(Linker_Switches.Table (J).all); 2954 end if; 2955 end loop; 2956 2957 -- If need be, add the -o switch 2958 2959 if Non_Std_Executable then 2960 Last_Arg := Last_Arg + 1; 2961 Args (Last_Arg) := new String'("-o"); 2962 Last_Arg := Last_Arg + 1; 2963 Args (Last_Arg) := new String'(Get_Name_String (Executable)); 2964 end if; 2965 2966 -- And invoke the linker 2967 2968 declare 2969 Success : Boolean := False; 2970 2971 begin 2972 -- If gnatmake was invoked with --subdirs, put the executable in 2973 -- the subdirectory specified. 2974 2975 if Subdirs /= null then 2976 Change_Dir (Object_Directory_Path.all); 2977 end if; 2978 2979 Link (Main_ALI_File, 2980 Link_With_Shared_Libgcc.all & 2981 Args (Args'First .. Last_Arg), 2982 Success); 2983 2984 if Success then 2985 Successful_Links.Increment_Last; 2986 Successful_Links.Table (Successful_Links.Last) := Main_ALI_File; 2987 2988 elsif Osint.Number_Of_Files = 1 or else not Keep_Going then 2989 Make_Failed ("*** link failed."); 2990 2991 else 2992 Set_Standard_Error; 2993 Write_Line ("*** link failed"); 2994 2995 if Commands_To_Stdout then 2996 Set_Standard_Output; 2997 end if; 2998 2999 Failed_Links.Increment_Last; 3000 Failed_Links.Table (Failed_Links.Last) := Main_ALI_File; 3001 end if; 3002 end; 3003 end; 3004 3005 Linker_Switches.Set_Last (Linker_Switches_Last); 3006 end Linking_Phase; 3007 3008 ------------------- 3009 -- Binding_Phase -- 3010 ------------------- 3011 3012 procedure Binding_Phase (Main_ALI_File : File_Name_Type) is 3013 Args : Argument_List (Binder_Switches.First .. Binder_Switches.Last + 2); 3014 -- The arguments for the invocation of gnatbind 3015 3016 Last_Arg : Natural := Binder_Switches.Last; 3017 -- Index of the last argument in Args 3018 3019 Shared_Libs : Boolean := False; 3020 -- Set to True when there are shared library project files or 3021 -- when gnatbind is invoked with -shared. 3022 3023 begin 3024 3025 -- Check now for switch -shared 3026 3027 for J in Binder_Switches.First .. Last_Arg loop 3028 if Binder_Switches.Table (J).all = "-shared" then 3029 Shared_Libs := True; 3030 exit; 3031 end if; 3032 end loop; 3033 3034 -- If shared libraries present, invoke gnatlink with 3035 -- -shared-libgcc. 3036 3037 if Shared_Libs then 3038 Link_With_Shared_Libgcc := Shared_Libgcc_Switch'Access; 3039 end if; 3040 3041 -- Get all the binder switches 3042 3043 for J in Binder_Switches.First .. Last_Arg loop 3044 Args (J) := Binder_Switches.Table (J); 3045 end loop; 3046 3047 if CodePeer_Mode then 3048 Last_Arg := Last_Arg + 1; 3049 Args (Last_Arg) := CodePeer_Mode_String'Access; 3050 end if; 3051 3052 -- If gnatmake was invoked with --subdirs, put the 3053 -- binder generated files in the subdirectory specified. 3054 3055 if Subdirs /= null then 3056 Change_Dir (Object_Directory_Path.all); 3057 end if; 3058 3059 Bind (Main_ALI_File, Bind_Shared.all & Args (Args'First .. Last_Arg)); 3060 3061 end Binding_Phase; 3062 3063 ----------------------- 3064 -- Compilation_Phase -- 3065 ----------------------- 3066 3067 procedure Compilation_Phase 3068 (Main_Source_File : File_Name_Type; 3069 Current_Main_Index : Int := 0; 3070 Total_Compilation_Failures : in out Natural; 3071 Executable : File_Name_Type := No_File; 3072 Stop_Compile : out Boolean) 3073 is 3074 Args : Argument_List (1 .. Gcc_Switches.Last); 3075 First_Compiled_File : File_Name_Type; 3076 Youngest_Obj_File : File_Name_Type; 3077 Youngest_Obj_Stamp : Time_Stamp_Type; 3078 3079 Is_Main_Unit : Boolean; 3080 -- Set True by Compile_Sources if Main_Source_File can be a main unit 3081 3082 Compilation_Failures : Natural; 3083 3084 Executable_Stamp : Time_Stamp_Type; 3085 3086 begin 3087 Stop_Compile := False; 3088 3089 for J in 1 .. Gcc_Switches.Last loop 3090 Args (J) := Gcc_Switches.Table (J); 3091 end loop; 3092 3093 -- Now we invoke Compile_Sources for the current main 3094 3095 Compile_Sources 3096 (Main_Source => Main_Source_File, 3097 Args => Args, 3098 First_Compiled_File => First_Compiled_File, 3099 Most_Recent_Obj_File => Youngest_Obj_File, 3100 Most_Recent_Obj_Stamp => Youngest_Obj_Stamp, 3101 Main_Unit => Is_Main_Unit, 3102 Main_Index => Current_Main_Index, 3103 Compilation_Failures => Compilation_Failures, 3104 Check_Readonly_Files => Check_Readonly_Files, 3105 Do_Not_Execute => Do_Not_Execute, 3106 Force_Compilations => Force_Compilations, 3107 In_Place_Mode => In_Place_Mode, 3108 Keep_Going => Keep_Going, 3109 Initialize_ALI_Data => True, 3110 Max_Process => Maximum_Processes); 3111 3112 if Verbose_Mode then 3113 Write_Str ("End of compilation"); 3114 Write_Eol; 3115 end if; 3116 3117 Total_Compilation_Failures := 3118 Total_Compilation_Failures + Compilation_Failures; 3119 3120 if Total_Compilation_Failures /= 0 then 3121 Stop_Compile := True; 3122 return; 3123 end if; 3124 3125 if List_Dependencies then 3126 if First_Compiled_File /= No_File then 3127 Inform 3128 (First_Compiled_File, 3129 "must be recompiled. Can't generate dependence list."); 3130 else 3131 List_Depend; 3132 end if; 3133 3134 elsif First_Compiled_File = No_File 3135 and then not Do_Bind_Step 3136 and then not Quiet_Output 3137 and then Osint.Number_Of_Files = 1 3138 then 3139 Inform (Msg => "objects up to date."); 3140 Stop_Compile := True; 3141 return; 3142 3143 elsif Do_Not_Execute and then First_Compiled_File /= No_File then 3144 Write_Name (First_Compiled_File); 3145 Write_Eol; 3146 end if; 3147 3148 -- Stop after compile step if any of: 3149 3150 -- 1) -n (Do_Not_Execute) specified 3151 3152 -- 2) -M (List_Dependencies) specified (also sets 3153 -- Do_Not_Execute above, so this is probably superfluous). 3154 3155 -- 3) -c (Compile_Only) specified, but not -b (Bind_Only) 3156 3157 -- 4) Made unit cannot be a main unit 3158 3159 if ((Do_Not_Execute 3160 or List_Dependencies 3161 or not Do_Bind_Step 3162 or not Is_Main_Unit) 3163 and not No_Main_Subprogram 3164 and not Build_Bind_And_Link_Full_Project) 3165 or Unique_Compile 3166 then 3167 Stop_Compile := True; 3168 return; 3169 end if; 3170 3171 -- If the objects were up-to-date check if the executable file is also 3172 -- up-to-date. For now always bind and link in CodePeer mode where there 3173 -- is no executable. 3174 3175 if not CodePeer_Mode 3176 and then Do_Link_Step 3177 and then First_Compiled_File = No_File 3178 then 3179 Executable_Stamp := File_Stamp (Executable); 3180 3181 if not Executable_Obsolete then 3182 Executable_Obsolete := Youngest_Obj_Stamp > Executable_Stamp; 3183 end if; 3184 3185 if not Executable_Obsolete then 3186 for Index in reverse 1 .. Dependencies.Last loop 3187 if Is_In_Obsoleted (Dependencies.Table (Index).Depends_On) then 3188 Enter_Into_Obsoleted (Dependencies.Table (Index).This); 3189 end if; 3190 end loop; 3191 3192 Executable_Obsolete := Is_In_Obsoleted (Main_Source_File); 3193 Dependencies.Init; 3194 end if; 3195 3196 if not Executable_Obsolete then 3197 3198 -- If no Ada object files obsolete the executable, check 3199 -- for younger or missing linker files. 3200 3201 Check_Linker_Options 3202 (Executable_Stamp, 3203 Youngest_Obj_File, 3204 Youngest_Obj_Stamp); 3205 3206 Executable_Obsolete := Youngest_Obj_File /= No_File; 3207 end if; 3208 3209 -- Return if the executable is up to date and otherwise 3210 -- motivate the relink/rebind. 3211 3212 if not Executable_Obsolete then 3213 if not Quiet_Output then 3214 Inform (Executable, "up to date."); 3215 end if; 3216 3217 Stop_Compile := True; 3218 return; 3219 end if; 3220 3221 if Executable_Stamp (1) = ' ' then 3222 if not No_Main_Subprogram then 3223 Verbose_Msg (Executable, "missing.", Prefix => " "); 3224 end if; 3225 3226 elsif Youngest_Obj_Stamp (1) = ' ' then 3227 Verbose_Msg 3228 (Youngest_Obj_File, "missing.", Prefix => " "); 3229 3230 elsif Youngest_Obj_Stamp > Executable_Stamp then 3231 Verbose_Msg 3232 (Youngest_Obj_File, 3233 "(" & String (Youngest_Obj_Stamp) & ") newer than", 3234 Executable, 3235 "(" & String (Executable_Stamp) & ")"); 3236 3237 else 3238 Verbose_Msg 3239 (Executable, "needs to be rebuilt", Prefix => " "); 3240 3241 end if; 3242 end if; 3243 end Compilation_Phase; 3244 3245 ------------------------ 3246 -- Compute_Executable -- 3247 ------------------------ 3248 3249 procedure Compute_Executable 3250 (Main_Source_File : File_Name_Type; 3251 Executable : out File_Name_Type; 3252 Non_Std_Executable : out Boolean) 3253 is 3254 begin 3255 Executable := No_File; 3256 Non_Std_Executable := 3257 Targparm.Executable_Extension_On_Target /= No_Name; 3258 3259 -- Look inside the linker switches to see if the name of the final 3260 -- executable program was specified. 3261 3262 for J in reverse Linker_Switches.First .. Linker_Switches.Last loop 3263 if Linker_Switches.Table (J).all = Output_Flag.all then 3264 pragma Assert (J < Linker_Switches.Last); 3265 3266 -- We cannot specify a single executable for several main 3267 -- subprograms 3268 3269 if Osint.Number_Of_Files > 1 then 3270 Fail ("cannot specify a single executable for several mains"); 3271 end if; 3272 3273 Name_Len := 0; 3274 Add_Str_To_Name_Buffer (Linker_Switches.Table (J + 1).all); 3275 Executable := Name_Enter; 3276 3277 Verbose_Msg (Executable, "final executable"); 3278 end if; 3279 end loop; 3280 3281 -- If the name of the final executable program was not specified then 3282 -- construct it from the main input file. 3283 3284 if Executable = No_File then 3285 Executable := Executable_Name (Strip_Suffix (Main_Source_File)); 3286 end if; 3287 3288 end Compute_Executable; 3289 3290 -------------- 3291 -- Gnatmake -- 3292 -------------- 3293 3294 procedure Gnatmake is 3295 Main_Source_File : File_Name_Type; 3296 -- The source file containing the main compilation unit 3297 3298 Total_Compilation_Failures : Natural := 0; 3299 3300 Main_ALI_File : File_Name_Type; 3301 -- The ali file corresponding to Main_Source_File 3302 3303 Executable : File_Name_Type := No_File; 3304 -- The file name of an executable 3305 3306 Non_Std_Executable : Boolean := False; 3307 -- Non_Std_Executable is set to True when there is a possibility that 3308 -- the linker will not choose the correct executable file name. 3309 3310 Current_Main_Index : Int := 0; 3311 -- If not zero, the index of the current main unit in its source file 3312 3313 Is_First_Main : Boolean; 3314 -- Whether we are processing the first main 3315 3316 Stop_Compile : Boolean; 3317 3318 Discard : Boolean; 3319 pragma Warnings (Off, Discard); 3320 3321 begin 3322 Install_Int_Handler (Sigint_Intercepted'Access); 3323 3324 Do_Compile_Step := True; 3325 Do_Bind_Step := True; 3326 Do_Link_Step := True; 3327 3328 Obsoleted.Reset; 3329 3330 Make.Initialize; 3331 3332 Bind_Shared := No_Shared_Switch'Access; 3333 Link_With_Shared_Libgcc := No_Shared_Libgcc_Switch'Access; 3334 3335 Failed_Links.Set_Last (0); 3336 Successful_Links.Set_Last (0); 3337 3338 -- Special case when switch -B was specified 3339 3340 if Main_Index /= 0 and then Osint.Number_Of_Files > 1 then 3341 Make_Failed ("cannot specify several mains with a multi-unit index"); 3342 end if; 3343 3344 if Verbose_Mode then 3345 Write_Eol; 3346 Display_Version ("GNATMAKE", "1992"); 3347 end if; 3348 3349 if Osint.Number_Of_Files = 0 then 3350 -- Call Get_Target_Parameters to ensure that flags are properly 3351 -- set before calling Usage. 3352 3353 Targparm.Get_Target_Parameters; 3354 3355 -- Output usage information if no argument on the command line 3356 3357 if Argument_Count = 0 then 3358 Usage; 3359 else 3360 Try_Help; 3361 end if; 3362 3363 Finish_Program (E_Success); 3364 end if; 3365 3366 -- Get the first executable. 3367 -- ??? This needs to be done early, because Osint.Next_Main_File also 3368 -- initializes the primary search directory, used below to initialize 3369 -- the "-I" parameter 3370 3371 Main_Source_File := Next_Main_Source; -- No directory information 3372 3373 -- If -M was specified, behave as if -n was specified 3374 3375 if List_Dependencies then 3376 Do_Not_Execute := True; 3377 end if; 3378 3379 Add_Switch ("-I-", Compiler); 3380 3381 if Look_In_Primary_Dir then 3382 Add_Switch 3383 ("-I" & 3384 Normalize_Directory_Name 3385 (Get_Primary_Src_Search_Directory.all).all, 3386 Compiler, 3387 Append_Switch => False); 3388 3389 end if; 3390 3391 -- If the user wants a program without a main subprogram, add the 3392 -- appropriate switch to the binder. 3393 3394 if No_Main_Subprogram then 3395 Add_Switch ("-z", Binder); 3396 end if; 3397 3398 -- The combination of -f -u and one or several mains on the command line 3399 -- implies -a. 3400 3401 if Force_Compilations 3402 and then Unique_Compile 3403 and then Main_On_Command_Line 3404 then 3405 Must_Compile := True; 3406 end if; 3407 3408 Bad_Compilation.Init; 3409 3410 -- Here is where the make process is started 3411 3412 Queue.Initialize; 3413 3414 Is_First_Main := True; 3415 3416 Multiple_Main_Loop : for N_File in 1 .. Osint.Number_Of_Files loop 3417 if Current_File_Index /= No_Index then 3418 Main_Index := Current_File_Index; 3419 end if; 3420 3421 Current_Main_Index := Main_Index; 3422 3423 if Is_First_Main then 3424 3425 -- Put the default source dirs in the source path only now, so 3426 -- that we take the correct ones in the case where --RTS= is 3427 -- specified in the Builder switches. 3428 3429 Osint.Add_Default_Search_Dirs; 3430 3431 -- Get the target parameters, which are only needed for a couple 3432 -- of cases in gnatmake. Protect against an exception, such as the 3433 -- case of system.ads missing from the library, and fail 3434 -- gracefully. 3435 3436 begin 3437 Targparm.Get_Target_Parameters; 3438 exception 3439 when Unrecoverable_Error => 3440 Make_Failed ("*** make failed."); 3441 end; 3442 3443 Gcc_Path := GNAT.OS_Lib.Locate_Exec_On_Path (Gcc.all); 3444 Gnatbind_Path := GNAT.OS_Lib.Locate_Exec_On_Path (Gnatbind.all); 3445 Gnatlink_Path := GNAT.OS_Lib.Locate_Exec_On_Path (Gnatlink.all); 3446 3447 -- If we have specified -j switch both from the project file 3448 -- and on the command line, the one from the command line takes 3449 -- precedence. 3450 3451 if Debug.Debug_Flag_M then 3452 Write_Line ("Maximum number of simultaneous compilations =" & 3453 Maximum_Processes'Img); 3454 end if; 3455 3456 -- Allocate as many temporary mapping file names as the maximum 3457 -- number of compilations processed. 3458 3459 The_Mapping_Files := 3460 (Mapping_File_Names => 3461 new Temp_Path_Names (1 .. Maximum_Processes), 3462 Last_Mapping_File_Names => 0, 3463 Free_Mapping_File_Indexes => 3464 new Free_File_Indexes (1 .. Maximum_Processes), 3465 Last_Free_Indexes => 0); 3466 3467 Is_First_Main := False; 3468 end if; 3469 3470 Executable_Obsolete := False; 3471 3472 Compute_Executable 3473 (Main_Source_File => Main_Source_File, 3474 Executable => Executable, 3475 Non_Std_Executable => Non_Std_Executable); 3476 3477 if Do_Compile_Step then 3478 Compilation_Phase 3479 (Main_Source_File => Main_Source_File, 3480 Current_Main_Index => Current_Main_Index, 3481 Total_Compilation_Failures => Total_Compilation_Failures, 3482 Executable => Executable, 3483 Stop_Compile => Stop_Compile); 3484 3485 if Stop_Compile then 3486 if Total_Compilation_Failures /= 0 then 3487 if Keep_Going then 3488 goto Next_Main; 3489 3490 else 3491 List_Bad_Compilations; 3492 Report_Compilation_Failed; 3493 end if; 3494 3495 elsif Osint.Number_Of_Files = 1 then 3496 exit Multiple_Main_Loop; 3497 else 3498 goto Next_Main; 3499 end if; 3500 end if; 3501 end if; 3502 3503 -- If we are here, it means that we need to rebuilt the current main, 3504 -- so we set Executable_Obsolete to True to make sure that subsequent 3505 -- mains will be rebuilt. 3506 3507 Main_ALI_In_Place_Mode_Step : declare 3508 ALI_File : File_Name_Type; 3509 Src_File : File_Name_Type; 3510 3511 begin 3512 Src_File := Strip_Directory (Main_Source_File); 3513 ALI_File := Lib_File_Name (Src_File, Current_Main_Index); 3514 Main_ALI_File := Full_Lib_File_Name (ALI_File); 3515 3516 -- When In_Place_Mode, the library file can be located in the 3517 -- Main_Source_File directory which may not be present in the 3518 -- library path. If it is not present then use the corresponding 3519 -- library file name. 3520 3521 if Main_ALI_File = No_File and then In_Place_Mode then 3522 Get_Name_String (Get_Directory (Full_Source_Name (Src_File))); 3523 Get_Name_String_And_Append (ALI_File); 3524 Main_ALI_File := Name_Find; 3525 Main_ALI_File := Full_Lib_File_Name (Main_ALI_File); 3526 end if; 3527 3528 if Main_ALI_File = No_File then 3529 Make_Failed ("could not find the main ALI file"); 3530 end if; 3531 end Main_ALI_In_Place_Mode_Step; 3532 3533 if Do_Bind_Step then 3534 Binding_Phase (Main_ALI_File); 3535 end if; 3536 3537 if Do_Link_Step then 3538 Linking_Phase 3539 (Non_Std_Executable => Non_Std_Executable, 3540 Executable => Executable, 3541 Main_ALI_File => Main_ALI_File); 3542 end if; 3543 3544 -- We go to here when we skip the bind and link steps 3545 3546 <<Next_Main>> 3547 3548 Queue.Remove_Marks; 3549 3550 if N_File < Osint.Number_Of_Files then 3551 Main_Source_File := Next_Main_Source; -- No directory information 3552 end if; 3553 end loop Multiple_Main_Loop; 3554 3555 if Failed_Links.Last > 0 then 3556 for Index in 1 .. Successful_Links.Last loop 3557 Write_Str ("Linking of """); 3558 Write_Str (Get_Name_String (Successful_Links.Table (Index))); 3559 Write_Line (""" succeeded."); 3560 end loop; 3561 3562 Set_Standard_Error; 3563 3564 for Index in 1 .. Failed_Links.Last loop 3565 Write_Str ("Linking of """); 3566 Write_Str (Get_Name_String (Failed_Links.Table (Index))); 3567 Write_Line (""" failed."); 3568 end loop; 3569 3570 if Commands_To_Stdout then 3571 Set_Standard_Output; 3572 end if; 3573 3574 if Total_Compilation_Failures = 0 then 3575 Report_Compilation_Failed; 3576 end if; 3577 end if; 3578 3579 if Total_Compilation_Failures /= 0 then 3580 List_Bad_Compilations; 3581 Report_Compilation_Failed; 3582 end if; 3583 3584 Finish_Program (E_Success); 3585 3586 exception 3587 when X : others => 3588 Set_Standard_Error; 3589 Write_Line (Exception_Information (X)); 3590 Make_Failed ("INTERNAL ERROR. Please report."); 3591 end Gnatmake; 3592 3593 ---------- 3594 -- Hash -- 3595 ---------- 3596 3597 function Hash (F : File_Name_Type) return Header_Num is 3598 begin 3599 return Header_Num (1 + F mod Max_Header); 3600 end Hash; 3601 3602 -------------------- 3603 -- In_Ada_Lib_Dir -- 3604 -------------------- 3605 3606 function In_Ada_Lib_Dir (File : File_Name_Type) return Boolean is 3607 D : constant File_Name_Type := Get_Directory (File); 3608 B : constant Byte := Get_Name_Table_Byte (D); 3609 begin 3610 return (B and Ada_Lib_Dir) /= 0; 3611 end In_Ada_Lib_Dir; 3612 3613 ----------------------- 3614 -- Init_Mapping_File -- 3615 ----------------------- 3616 3617 procedure Init_Mapping_File (File_Index : in out Natural) is 3618 FD : File_Descriptor; 3619 Status : Boolean; 3620 -- For call to Close 3621 3622 begin 3623 -- Increase the index of the last mapping file for this project 3624 3625 The_Mapping_Files.Last_Mapping_File_Names := 3626 The_Mapping_Files.Last_Mapping_File_Names + 1; 3627 3628 -- Just create an empty file 3629 3630 Tempdir.Create_Temp_File 3631 (FD, 3632 The_Mapping_Files.Mapping_File_Names 3633 (The_Mapping_Files.Last_Mapping_File_Names)); 3634 3635 if FD = Invalid_FD then 3636 Make_Failed ("disk full"); 3637 else 3638 Record_Temp_File 3639 (The_Mapping_Files.Mapping_File_Names 3640 (The_Mapping_Files.Last_Mapping_File_Names)); 3641 end if; 3642 3643 Close (FD, Status); 3644 3645 if not Status then 3646 Make_Failed ("disk full"); 3647 end if; 3648 3649 -- And return the index of the newly created file 3650 3651 File_Index := The_Mapping_Files.Last_Mapping_File_Names; 3652 end Init_Mapping_File; 3653 3654 ---------------- 3655 -- Initialize -- 3656 ---------------- 3657 3658 procedure Initialize is 3659 procedure Check_Version_And_Help is 3660 new Check_Version_And_Help_G (Makeusg); 3661 3662 begin 3663 -- Override default initialization of Check_Object_Consistency since 3664 -- this is normally False for GNATBIND, but is True for GNATMAKE since 3665 -- we do not need to check source consistency again once GNATMAKE has 3666 -- looked at the sources to check. 3667 3668 Check_Object_Consistency := True; 3669 3670 -- Package initializations (the order of calls is important here) 3671 3672 Output.Set_Standard_Error; 3673 3674 Gcc_Switches.Init; 3675 Binder_Switches.Init; 3676 Linker_Switches.Init; 3677 3678 Csets.Initialize; 3679 Snames.Initialize; 3680 Stringt.Initialize; 3681 3682 Dependencies.Init; 3683 3684 RTS_Specified := null; 3685 N_M_Switch := 0; 3686 3687 Mains.Delete; 3688 3689 -- Add the directory where gnatmake is invoked in front of the path, 3690 -- if gnatmake is invoked from a bin directory or with directory 3691 -- information. 3692 3693 declare 3694 Prefix : constant String := Executable_Prefix_Path; 3695 Command : constant String := Command_Name; 3696 3697 begin 3698 if Prefix'Length > 0 then 3699 declare 3700 PATH : constant String := 3701 Prefix & Directory_Separator & "bin" & Path_Separator 3702 & Getenv ("PATH").all; 3703 begin 3704 Setenv ("PATH", PATH); 3705 end; 3706 3707 else 3708 for Index in reverse Command'Range loop 3709 if Command (Index) = Directory_Separator then 3710 declare 3711 Absolute_Dir : constant String := 3712 Normalize_Pathname 3713 (Command (Command'First .. Index)); 3714 PATH : constant String := 3715 Absolute_Dir & 3716 Path_Separator & 3717 Getenv ("PATH").all; 3718 begin 3719 Setenv ("PATH", PATH); 3720 end; 3721 3722 exit; 3723 end if; 3724 end loop; 3725 end if; 3726 end; 3727 3728 -- Scan the switches and arguments 3729 3730 -- First, scan to detect --version and/or --help 3731 3732 Check_Version_And_Help ("GNATMAKE", "1995"); 3733 3734 -- Scan again the switch and arguments, now that we are sure that they 3735 -- do not include --version or --help. 3736 3737 -- First, check for switch -P and, if found and gprbuild is available, 3738 -- silently invoke gprbuild, with switch --target if not on a native 3739 -- platform. 3740 3741 declare 3742 Arg_Len : Natural := Argument_Count; 3743 Call_Gprbuild : Boolean := False; 3744 Gprbuild : String_Access := null; 3745 Pos : Natural := 0; 3746 Success : Boolean; 3747 Target : String_Access := null; 3748 3749 In_Gnatmake_Switches : Boolean := True; 3750 -- Set to False after -cargs, -bargs, or -largs, to avoid detecting 3751 -- -P switches that are not for gnatmake. 3752 3753 begin 3754 Find_Program_Name; 3755 3756 if Name_Len >= 8 3757 and then Name_Buffer (Name_Len - 7 .. Name_Len) = "gnatmake" 3758 then 3759 if Name_Len > 9 then 3760 Target := new String'(Name_Buffer (1 .. Name_Len - 9)); 3761 Arg_Len := Arg_Len + 1; 3762 end if; 3763 3764 for J in 1 .. Argument_Count loop 3765 declare 3766 Arg : constant String := Argument (J); 3767 begin 3768 if Arg = "-cargs" or Arg = "-bargs" or Arg = "-largs" then 3769 In_Gnatmake_Switches := False; 3770 3771 elsif Arg = "-margs" then 3772 In_Gnatmake_Switches := True; 3773 3774 elsif In_Gnatmake_Switches 3775 and then Arg'Length >= 2 3776 and then Arg (Arg'First .. Arg'First + 1) = "-P" 3777 then 3778 Call_Gprbuild := True; 3779 exit; 3780 end if; 3781 end; 3782 end loop; 3783 3784 if Call_Gprbuild then 3785 Gprbuild := Locate_Exec_On_Path (Exec_Name => "gprbuild"); 3786 3787 if Gprbuild = null then 3788 Fail_Program 3789 ("project files are no longer supported by gnamake;" & 3790 " use gprbuild instead"); 3791 end if; 3792 3793 declare 3794 Args : Argument_List (1 .. Arg_Len); 3795 begin 3796 if Target /= null then 3797 Args (1) := new String'("--target=" & Target.all); 3798 Pos := 1; 3799 end if; 3800 3801 for J in 1 .. Argument_Count loop 3802 Pos := Pos + 1; 3803 Args (Pos) := new String'(Argument (J)); 3804 end loop; 3805 3806 Spawn (Gprbuild.all, Args, Success); 3807 3808 Free (Gprbuild); 3809 3810 if Success then 3811 Exit_Program (E_Success); 3812 else 3813 Exit_Program (E_Errors); 3814 end if; 3815 end; 3816 end if; 3817 end if; 3818 end; 3819 3820 Scan_Args : for Next_Arg in 1 .. Argument_Count loop 3821 Scan_Make_Arg (Argument (Next_Arg)); 3822 end loop Scan_Args; 3823 3824 if Make_Steps then 3825 Do_Compile_Step := Compile_Only; 3826 Do_Bind_Step := Bind_Only; 3827 Do_Link_Step := Link_Only; 3828 3829 if Do_Compile_Step and then Do_Link_Step then 3830 Do_Bind_Step := True; 3831 end if; 3832 end if; 3833 3834 if N_M_Switch > 0 and RTS_Specified = null then 3835 Process_Multilib; 3836 end if; 3837 3838 if Commands_To_Stdout then 3839 Set_Standard_Output; 3840 end if; 3841 3842 if Usage_Requested then 3843 Usage; 3844 end if; 3845 3846 -- Test for trailing -P switch 3847 3848 if Project_File_Name_Present and then Project_File_Name = null then 3849 Make_Failed ("project file name missing after -P"); 3850 3851 -- Test for trailing -o switch 3852 3853 elsif Output_File_Name_Present and then not Output_File_Name_Seen then 3854 Make_Failed ("output file name missing after -o"); 3855 3856 -- Test for trailing -D switch 3857 3858 elsif Object_Directory_Present and then not Object_Directory_Seen then 3859 Make_Failed ("object directory missing after -D"); 3860 end if; 3861 3862 -- Test for simultaneity of -i and -D 3863 3864 if Object_Directory_Path /= null and then In_Place_Mode then 3865 Make_Failed ("-i and -D cannot be used simultaneously"); 3866 end if; 3867 3868 -- If --subdirs= is specified, but not -P, this is equivalent to -D, 3869 -- except that the directory is created if it does not exist. 3870 3871 if Subdirs /= null then 3872 if Object_Directory_Path /= null then 3873 Make_Failed ("--subdirs and -D cannot be used simultaneously"); 3874 3875 elsif In_Place_Mode then 3876 Make_Failed ("--subdirs and -i cannot be used simultaneously"); 3877 3878 else 3879 if not Is_Directory (Subdirs.all) then 3880 begin 3881 Ada.Directories.Create_Path (Subdirs.all); 3882 exception 3883 when others => 3884 Make_Failed ("unable to create object directory " & 3885 Subdirs.all); 3886 end; 3887 end if; 3888 3889 Object_Directory_Present := True; 3890 3891 declare 3892 Argv : constant String (1 .. Subdirs'Length) := 3893 Subdirs.all; 3894 begin 3895 Scan_Make_Arg (Argv); 3896 end; 3897 end if; 3898 end if; 3899 3900 -- Deal with -C= switch 3901 3902 if Gnatmake_Mapping_File /= null then 3903 3904 -- First, check compatibility with other switches 3905 3906 if Maximum_Processes > 1 then 3907 Make_Failed ("-C= switch is not compatible with -jnnn switch"); 3908 end if; 3909 3910 Fmap.Initialize (Gnatmake_Mapping_File.all); 3911 Add_Switch 3912 ("-gnatem=" & Gnatmake_Mapping_File.all, 3913 Compiler); 3914 end if; 3915 3916 Osint.Add_Default_Search_Dirs; 3917 3918 -- Source file lookups should be cached for efficiency. Source files 3919 -- are not supposed to change. However, we do that now only if no 3920 -- project file is used; if a project file is used, we do it just 3921 -- after changing the directory to the object directory. 3922 3923 Osint.Source_File_Data (Cache => True); 3924 3925 -- Read gnat.adc file to initialize Fname.UF 3926 3927 Fname.UF.Initialize; 3928 3929 if Config_File then 3930 begin 3931 Fname.SF.Read_Source_File_Name_Pragmas; 3932 3933 exception 3934 when Err : SFN_Scan.Syntax_Error_In_GNAT_ADC => 3935 Make_Failed (Exception_Message (Err)); 3936 end; 3937 end if; 3938 3939 if Debug.Debug_Flag_N then 3940 Opt.Keep_Temporary_Files := True; 3941 end if; 3942 end Initialize; 3943 3944 --------------------- 3945 -- Is_In_Obsoleted -- 3946 --------------------- 3947 3948 function Is_In_Obsoleted (F : File_Name_Type) return Boolean is 3949 begin 3950 if F = No_File then 3951 return False; 3952 3953 else 3954 declare 3955 Name : constant String := Get_Name_String (F); 3956 First : Natural; 3957 F2 : File_Name_Type; 3958 3959 begin 3960 First := Name'Last; 3961 while First > Name'First 3962 and then not Is_Directory_Separator (Name (First - 1)) 3963 loop 3964 First := First - 1; 3965 end loop; 3966 3967 if First /= Name'First then 3968 Name_Len := 0; 3969 Add_Str_To_Name_Buffer (Name (First .. Name'Last)); 3970 F2 := Name_Find; 3971 3972 else 3973 F2 := F; 3974 end if; 3975 3976 return Obsoleted.Get (F2); 3977 end; 3978 end if; 3979 end Is_In_Obsoleted; 3980 3981 ---------- 3982 -- Link -- 3983 ---------- 3984 3985 procedure Link 3986 (ALI_File : File_Name_Type; 3987 Args : Argument_List; 3988 Success : out Boolean) 3989 is 3990 Link_Args : Argument_List (1 .. Args'Length + 1); 3991 3992 begin 3993 Get_Name_String (ALI_File); 3994 Link_Args (1) := new String'(Name_Buffer (1 .. Name_Len)); 3995 3996 Link_Args (2 .. Args'Length + 1) := Args; 3997 3998 GNAT.OS_Lib.Normalize_Arguments (Link_Args); 3999 4000 Display (Gnatlink.all, Link_Args); 4001 4002 if Gnatlink_Path = null then 4003 Make_Failed ("error, unable to locate " & Gnatlink.all); 4004 end if; 4005 4006 GNAT.OS_Lib.Spawn (Gnatlink_Path.all, Link_Args, Success); 4007 end Link; 4008 4009 --------------------------- 4010 -- List_Bad_Compilations -- 4011 --------------------------- 4012 4013 procedure List_Bad_Compilations is 4014 begin 4015 if not No_Exit_Message then 4016 for J in Bad_Compilation.First .. Bad_Compilation.Last loop 4017 if Bad_Compilation.Table (J).File = No_File then 4018 null; 4019 elsif not Bad_Compilation.Table (J).Found then 4020 Inform (Bad_Compilation.Table (J).File, "not found"); 4021 else 4022 Inform (Bad_Compilation.Table (J).File, "compilation error"); 4023 end if; 4024 end loop; 4025 end if; 4026 end List_Bad_Compilations; 4027 4028 ----------------- 4029 -- List_Depend -- 4030 ----------------- 4031 4032 procedure List_Depend is 4033 Lib_Name : File_Name_Type; 4034 Obj_Name : File_Name_Type; 4035 Src_Name : File_Name_Type; 4036 4037 Len : Natural; 4038 Line_Pos : Natural; 4039 Line_Size : constant := 77; 4040 4041 begin 4042 Set_Standard_Output; 4043 4044 for A in ALIs.First .. ALIs.Last loop 4045 Lib_Name := ALIs.Table (A).Afile; 4046 4047 -- We have to provide the full library file name in In_Place_Mode 4048 4049 if In_Place_Mode then 4050 Lib_Name := Full_Lib_File_Name (Lib_Name); 4051 end if; 4052 4053 Obj_Name := Object_File_Name (Lib_Name); 4054 Write_Name (Obj_Name); 4055 Write_Str (" :"); 4056 4057 Get_Name_String (Obj_Name); 4058 Len := Name_Len; 4059 Line_Pos := Len + 2; 4060 4061 for D in ALIs.Table (A).First_Sdep .. ALIs.Table (A).Last_Sdep loop 4062 Src_Name := Sdep.Table (D).Sfile; 4063 4064 if Is_Internal_File_Name (Src_Name) 4065 and then not Check_Readonly_Files 4066 then 4067 null; 4068 else 4069 if not Quiet_Output then 4070 Src_Name := Full_Source_Name (Src_Name); 4071 end if; 4072 4073 Get_Name_String (Src_Name); 4074 Len := Name_Len; 4075 4076 if Line_Pos + Len + 1 > Line_Size then 4077 Write_Str (" \"); 4078 Write_Eol; 4079 Line_Pos := 0; 4080 end if; 4081 4082 Line_Pos := Line_Pos + Len + 1; 4083 4084 Write_Str (" "); 4085 Write_Name (Src_Name); 4086 end if; 4087 end loop; 4088 4089 Write_Eol; 4090 end loop; 4091 4092 if not Commands_To_Stdout then 4093 Set_Standard_Error; 4094 end if; 4095 end List_Depend; 4096 4097 ----------------- 4098 -- Make_Failed -- 4099 ----------------- 4100 4101 procedure Make_Failed (S : String) is 4102 begin 4103 Fail_Program (S); 4104 end Make_Failed; 4105 4106 -------------------- 4107 -- Mark_Directory -- 4108 -------------------- 4109 4110 procedure Mark_Directory (Dir : String; Mark : Lib_Mark_Type) is 4111 N : Name_Id; 4112 B : Byte; 4113 4114 Real_Path : constant String := Normalize_Pathname (Dir, ""); 4115 4116 begin 4117 Name_Len := 0; 4118 4119 if Real_Path'Length = 0 then 4120 Add_Str_To_Name_Buffer (Dir); 4121 4122 else 4123 Add_Str_To_Name_Buffer (Real_Path); 4124 end if; 4125 4126 -- Last character is supposed to be a directory separator 4127 4128 if not Is_Directory_Separator (Name_Buffer (Name_Len)) then 4129 Add_Char_To_Name_Buffer (Directory_Separator); 4130 end if; 4131 4132 -- Add flags to the already existing flags 4133 4134 N := Name_Find; 4135 B := Get_Name_Table_Byte (N); 4136 Set_Name_Table_Byte (N, B or Mark); 4137 end Mark_Directory; 4138 4139 ---------------------- 4140 -- Process_Multilib -- 4141 ---------------------- 4142 4143 procedure Process_Multilib is 4144 Output_FD : File_Descriptor; 4145 Output_Name : String_Access; 4146 Arg_Index : Natural := 0; 4147 Success : Boolean := False; 4148 Return_Code : Integer := 0; 4149 Multilib_Gcc_Path : String_Access; 4150 Multilib_Gcc : String_Access; 4151 N_Read : Integer := 0; 4152 Line : String (1 .. 1000); 4153 Args : Argument_List (1 .. N_M_Switch + 1); 4154 4155 begin 4156 pragma Assert (N_M_Switch > 0 and RTS_Specified = null); 4157 4158 -- In case we detected a multilib switch and the user has not 4159 -- manually specified a specific RTS we emulate the following command: 4160 -- gnatmake $FLAGS --RTS=$(gcc -print-multi-directory $FLAGS) 4161 4162 -- First select the flags which might have an impact on multilib 4163 -- processing. Note that this is an heuristic selection and it 4164 -- will need to be maintained over time. The condition has to 4165 -- be kept synchronized with N_M_Switch counting in Scan_Make_Arg. 4166 4167 for Next_Arg in 1 .. Argument_Count loop 4168 declare 4169 Argv : constant String := Argument (Next_Arg); 4170 4171 begin 4172 if Argv'Length > 2 4173 and then Argv (1) = '-' 4174 and then Argv (2) = 'm' 4175 and then Argv /= "-margs" 4176 4177 -- Ignore -mieee to avoid spawning an extra gcc in this case 4178 4179 and then Argv /= "-mieee" 4180 then 4181 Arg_Index := Arg_Index + 1; 4182 Args (Arg_Index) := new String'(Argv); 4183 end if; 4184 end; 4185 end loop; 4186 4187 pragma Assert (Arg_Index = N_M_Switch); 4188 4189 Args (Args'Last) := new String'("-print-multi-directory"); 4190 4191 -- Call the GCC driver with the collected flags and save its 4192 -- output. Alternate design would be to link in gnatmake the 4193 -- relevant part of the GCC driver. 4194 4195 Multilib_Gcc := Gcc; 4196 4197 Multilib_Gcc_Path := GNAT.OS_Lib.Locate_Exec_On_Path (Multilib_Gcc.all); 4198 4199 Create_Temp_Output_File (Output_FD, Output_Name); 4200 4201 if Output_FD = Invalid_FD then 4202 return; 4203 end if; 4204 4205 GNAT.OS_Lib.Spawn 4206 (Multilib_Gcc_Path.all, Args, Output_FD, Return_Code, False); 4207 Close (Output_FD); 4208 4209 if Return_Code /= 0 then 4210 return; 4211 end if; 4212 4213 -- Parse the GCC driver output which is a single line, removing CR/LF 4214 4215 Output_FD := Open_Read (Output_Name.all, Binary); 4216 4217 if Output_FD = Invalid_FD then 4218 return; 4219 end if; 4220 4221 N_Read := Read (Output_FD, Line (1)'Address, Line'Length); 4222 Close (Output_FD); 4223 Delete_File (Output_Name.all, Success); 4224 4225 for J in reverse 1 .. N_Read loop 4226 if Line (J) = ASCII.CR or else Line (J) = ASCII.LF then 4227 N_Read := N_Read - 1; 4228 else 4229 exit; 4230 end if; 4231 end loop; 4232 4233 -- In case the standard RTS is selected do nothing 4234 4235 if N_Read = 0 or else Line (1 .. N_Read) = "." then 4236 return; 4237 end if; 4238 4239 -- Otherwise add -margs --RTS=output 4240 4241 Scan_Make_Arg ("-margs"); 4242 Scan_Make_Arg ("--RTS=" & Line (1 .. N_Read)); 4243 end Process_Multilib; 4244 4245 ------------------------------- 4246 -- Report_Compilation_Failed -- 4247 ------------------------------- 4248 4249 procedure Report_Compilation_Failed is 4250 begin 4251 Fail_Program (""); 4252 end Report_Compilation_Failed; 4253 4254 ------------------------ 4255 -- Sigint_Intercepted -- 4256 ------------------------ 4257 4258 procedure Sigint_Intercepted is 4259 begin 4260 Set_Standard_Error; 4261 Write_Line ("*** Interrupted ***"); 4262 4263 -- Send SIGINT to all outstanding compilation processes spawned 4264 4265 for J in 1 .. Outstanding_Compiles loop 4266 Kill (Running_Compile (J).Pid, Hard_Kill => False); 4267 end loop; 4268 4269 Finish_Program (E_No_Compile); 4270 end Sigint_Intercepted; 4271 4272 ------------------- 4273 -- Scan_Make_Arg -- 4274 ------------------- 4275 4276 procedure Scan_Make_Arg (Argv : String) is 4277 Success : Boolean; 4278 4279 begin 4280 Gnatmake_Switch_Found := True; 4281 4282 pragma Assert (Argv'First = 1); 4283 4284 if Argv'Length = 0 then 4285 return; 4286 end if; 4287 4288 -- If the previous switch has set the Output_File_Name_Present flag 4289 -- (that is we have seen a -o), then the next argument is the name of 4290 -- the output executable. 4291 4292 if Output_File_Name_Present and then not Output_File_Name_Seen then 4293 Output_File_Name_Seen := True; 4294 4295 if Argv (1) = '-' then 4296 Make_Failed ("output file name missing after -o"); 4297 4298 else 4299 Add_Switch ("-o", Linker); 4300 Add_Switch (Executable_Name (Argv), Linker); 4301 end if; 4302 4303 -- If the previous switch has set the Object_Directory_Present flag 4304 -- (that is we have seen a -D), then the next argument is the path name 4305 -- of the object directory. 4306 4307 elsif Object_Directory_Present 4308 and then not Object_Directory_Seen 4309 then 4310 Object_Directory_Seen := True; 4311 4312 if Argv (1) = '-' then 4313 Make_Failed ("object directory path name missing after -D"); 4314 4315 elsif not Is_Directory (Argv) then 4316 Make_Failed ("cannot find object directory """ & Argv & """"); 4317 4318 else 4319 -- Record the object directory. Make sure it ends with a directory 4320 -- separator. 4321 4322 declare 4323 Norm : constant String := Normalize_Pathname (Argv); 4324 4325 begin 4326 if Norm (Norm'Last) = Directory_Separator then 4327 Object_Directory_Path := new String'(Norm); 4328 else 4329 Object_Directory_Path := 4330 new String'(Norm & Directory_Separator); 4331 end if; 4332 4333 Add_Lib_Search_Dir (Norm); 4334 4335 -- Specify the object directory to the binder 4336 4337 Add_Switch ("-aO" & Norm, Binder); 4338 end; 4339 4340 end if; 4341 4342 -- Then check if we are dealing with -cargs/-bargs/-largs/-margs. These 4343 -- options are taken as is when found in package Compiler, Binder or 4344 -- Linker of the main project file. 4345 4346 elsif Argv = "-bargs" or else 4347 Argv = "-cargs" or else 4348 Argv = "-largs" or else 4349 Argv = "-margs" 4350 then 4351 case Argv (2) is 4352 when 'c' => Program_Args := Compiler; 4353 when 'b' => Program_Args := Binder; 4354 when 'l' => Program_Args := Linker; 4355 when 'm' => Program_Args := None; 4356 4357 when others => 4358 raise Program_Error; 4359 end case; 4360 4361 -- A special test is needed for the -o switch within a -largs since that 4362 -- is another way to specify the name of the final executable. 4363 4364 elsif Program_Args = Linker and then Argv = "-o" then 4365 Make_Failed 4366 ("switch -o not allowed within a -largs. Use -o directly."); 4367 4368 -- Check to see if we are reading switches after a -cargs, -bargs or 4369 -- -largs switch. If so, save it. 4370 4371 elsif Program_Args /= None then 4372 4373 -- Check to see if we are reading -I switches in order to take into 4374 -- account in the src & lib search directories. 4375 4376 if Argv'Length > 2 and then Argv (1 .. 2) = "-I" then 4377 if Argv (3 .. Argv'Last) = "-" then 4378 Look_In_Primary_Dir := False; 4379 4380 elsif Program_Args = Compiler then 4381 if Argv (3 .. Argv'Last) /= "-" then 4382 Add_Source_Search_Dir (Argv (3 .. Argv'Last)); 4383 end if; 4384 4385 elsif Program_Args = Binder then 4386 Add_Library_Search_Dir (Argv (3 .. Argv'Last)); 4387 end if; 4388 end if; 4389 4390 Add_Switch (Argv, Program_Args); 4391 4392 -- Make sure that all significant switches -m on the command line 4393 -- are counted. 4394 4395 if Argv'Length > 2 4396 and then Argv (1 .. 2) = "-m" 4397 and then Argv /= "-mieee" 4398 then 4399 N_M_Switch := N_M_Switch + 1; 4400 end if; 4401 4402 -- Handle non-default compiler, binder, linker, and handle --RTS switch 4403 4404 elsif Argv'Length > 2 and then Argv (1 .. 2) = "--" then 4405 if Argv'Length > 6 4406 and then Argv (1 .. 6) = "--GCC=" 4407 then 4408 declare 4409 Program_Args : constant Argument_List_Access := 4410 Argument_String_To_List 4411 (Argv (7 .. Argv'Last)); 4412 4413 begin 4414 Gcc := new String'(Program_Args.all (1).all); 4415 4416 for J in 2 .. Program_Args.all'Last loop 4417 Add_Switch 4418 (Program_Args.all (J).all, Compiler); 4419 end loop; 4420 end; 4421 4422 elsif Argv'Length > 11 4423 and then Argv (1 .. 11) = "--GNATBIND=" 4424 then 4425 declare 4426 Program_Args : constant Argument_List_Access := 4427 Argument_String_To_List 4428 (Argv (12 .. Argv'Last)); 4429 4430 begin 4431 Gnatbind := new String'(Program_Args.all (1).all); 4432 4433 for J in 2 .. Program_Args.all'Last loop 4434 Add_Switch 4435 (Program_Args.all (J).all, Binder); 4436 end loop; 4437 end; 4438 4439 elsif Argv'Length > 11 4440 and then Argv (1 .. 11) = "--GNATLINK=" 4441 then 4442 declare 4443 Program_Args : constant Argument_List_Access := 4444 Argument_String_To_List 4445 (Argv (12 .. Argv'Last)); 4446 begin 4447 Gnatlink := new String'(Program_Args.all (1).all); 4448 4449 for J in 2 .. Program_Args.all'Last loop 4450 Add_Switch (Program_Args.all (J).all, Linker); 4451 end loop; 4452 end; 4453 4454 elsif Argv'Length >= 5 and then 4455 Argv (1 .. 5) = "--RTS" 4456 then 4457 Add_Switch (Argv, Compiler); 4458 Add_Switch (Argv, Binder); 4459 4460 if Argv'Length <= 6 or else Argv (6) /= '=' then 4461 Make_Failed ("missing path for --RTS"); 4462 4463 else 4464 -- Check that this is the first time we see this switch or 4465 -- if it is not the first time, the same path is specified. 4466 4467 if RTS_Specified = null then 4468 RTS_Specified := new String'(Argv (7 .. Argv'Last)); 4469 4470 elsif RTS_Specified.all /= Argv (7 .. Argv'Last) then 4471 Make_Failed ("--RTS cannot be specified multiple times"); 4472 end if; 4473 4474 -- Valid --RTS switch 4475 4476 No_Stdinc := True; 4477 No_Stdlib := True; 4478 RTS_Switch := True; 4479 4480 declare 4481 Src_Path_Name : constant String_Ptr := 4482 Get_RTS_Search_Dir 4483 (Argv (7 .. Argv'Last), Include); 4484 4485 Lib_Path_Name : constant String_Ptr := 4486 Get_RTS_Search_Dir 4487 (Argv (7 .. Argv'Last), Objects); 4488 4489 begin 4490 if Src_Path_Name /= null 4491 and then Lib_Path_Name /= null 4492 then 4493 -- Set RTS_*_Path_Name variables, so that correct direct- 4494 -- ories will be set when Osint.Add_Default_Search_Dirs 4495 -- is called later. 4496 4497 RTS_Src_Path_Name := Src_Path_Name; 4498 RTS_Lib_Path_Name := Lib_Path_Name; 4499 4500 elsif Src_Path_Name = null 4501 and then Lib_Path_Name = null 4502 then 4503 Make_Failed 4504 ("RTS path not valid: missing adainclude and adalib " 4505 & "directories"); 4506 4507 elsif Src_Path_Name = null then 4508 Make_Failed 4509 ("RTS path not valid: missing adainclude directory"); 4510 4511 elsif Lib_Path_Name = null then 4512 Make_Failed 4513 ("RTS path not valid: missing adalib directory"); 4514 end if; 4515 end; 4516 end if; 4517 4518 elsif Argv'Length >= 8 and then Argv (1 .. 8) = "--param=" then 4519 Add_Switch (Argv, Compiler); 4520 Add_Switch (Argv, Linker); 4521 4522 elsif Argv = Create_Map_File_Switch then 4523 Map_File := new String'(""); 4524 4525 elsif Argv'Length > Create_Map_File_Switch'Length + 1 4526 and then 4527 Argv (1 .. Create_Map_File_Switch'Length) = Create_Map_File_Switch 4528 and then 4529 Argv (Create_Map_File_Switch'Length + 1) = '=' 4530 then 4531 Map_File := 4532 new String' 4533 (Argv (Create_Map_File_Switch'Length + 2 .. Argv'Last)); 4534 4535 else 4536 Scan_Make_Switches (Argv, Success); 4537 end if; 4538 4539 -- If we have seen a regular switch process it 4540 4541 elsif Argv (1) = '-' then 4542 if Argv'Length = 1 then 4543 Make_Failed ("switch character cannot be followed by a blank"); 4544 4545 -- Incorrect switches that should start with "--" 4546 4547 elsif (Argv'Length > 5 and then Argv (1 .. 5) = "-RTS=") 4548 or else (Argv'Length > 5 and then Argv (1 .. 5) = "-GCC=") 4549 or else (Argv'Length > 8 and then Argv (1 .. 7) = "-param=") 4550 or else (Argv'Length > 10 and then Argv (1 .. 10) = "-GNATLINK=") 4551 or else (Argv'Length > 10 and then Argv (1 .. 10) = "-GNATBIND=") 4552 then 4553 Make_Failed ("option " & Argv & " should start with '--'"); 4554 4555 -- -I- 4556 4557 elsif Argv (2 .. Argv'Last) = "I-" then 4558 Look_In_Primary_Dir := False; 4559 4560 -- Forbid -?- or -??- where ? is any character 4561 4562 elsif (Argv'Length = 3 and then Argv (3) = '-') 4563 or else (Argv'Length = 4 and then Argv (4) = '-') 4564 then 4565 Make_Failed 4566 ("trailing ""-"" at the end of " & Argv & " forbidden."); 4567 4568 -- -Idir 4569 4570 elsif Argv (2) = 'I' then 4571 Add_Source_Search_Dir (Argv (3 .. Argv'Last)); 4572 Add_Library_Search_Dir (Argv (3 .. Argv'Last)); 4573 Add_Switch (Argv, Compiler); 4574 Add_Switch (Argv, Binder); 4575 4576 -- -aIdir (to gcc this is like a -I switch) 4577 4578 elsif Argv'Length >= 3 and then Argv (2 .. 3) = "aI" then 4579 Add_Source_Search_Dir (Argv (4 .. Argv'Last)); 4580 Add_Switch 4581 ("-I" & Argv (4 .. Argv'Last), Compiler); 4582 Add_Switch (Argv, Binder); 4583 4584 -- -aOdir 4585 4586 elsif Argv'Length >= 3 and then Argv (2 .. 3) = "aO" then 4587 Add_Library_Search_Dir (Argv (4 .. Argv'Last)); 4588 Add_Switch (Argv, Binder); 4589 4590 -- -aLdir (to gnatbind this is like a -aO switch) 4591 4592 elsif Argv'Length >= 3 and then Argv (2 .. 3) = "aL" then 4593 Mark_Directory (Argv (4 .. Argv'Last), Ada_Lib_Dir); 4594 Add_Library_Search_Dir (Argv (4 .. Argv'Last)); 4595 Add_Switch 4596 ("-aO" & Argv (4 .. Argv'Last), Binder); 4597 4598 -- -aamp_target=... 4599 4600 elsif Argv'Length >= 13 and then Argv (2 .. 13) = "aamp_target=" then 4601 Add_Switch (Argv, Compiler); 4602 4603 -- Set the aamp_target environment variable so that the binder and 4604 -- linker will use the proper target library. This is consistent 4605 -- with how things work when -aamp_target is passed on the command 4606 -- line to gnaampmake. 4607 4608 Setenv ("aamp_target", Argv (14 .. Argv'Last)); 4609 4610 -- -Adir (to gnatbind this is like a -aO switch, to gcc like a -I) 4611 4612 elsif Argv (2) = 'A' then 4613 Mark_Directory (Argv (3 .. Argv'Last), Ada_Lib_Dir); 4614 Add_Source_Search_Dir (Argv (3 .. Argv'Last)); 4615 Add_Library_Search_Dir (Argv (3 .. Argv'Last)); 4616 Add_Switch ("-I" & Argv (3 .. Argv'Last), Compiler); 4617 Add_Switch ("-aO" & Argv (3 .. Argv'Last), Binder); 4618 4619 -- -Ldir 4620 4621 elsif Argv (2) = 'L' then 4622 Add_Switch (Argv, Linker); 4623 4624 -- For -gxxx, -pg, -mxxx, -fxxx, -Oxxx, pass the switch to both the 4625 -- compiler and the linker (except for -gnatxxx which is only for the 4626 -- compiler). Some of the -mxxx (for example -m64) and -fxxx (for 4627 -- example -ftest-coverage for gcov) need to be used when compiling 4628 -- the binder generated files, and using all these gcc switches for 4629 -- them should not be a problem. Pass -Oxxx to the linker for LTO. 4630 4631 elsif 4632 (Argv (2) = 'g' and then (Argv'Last < 5 4633 or else Argv (2 .. 5) /= "gnat")) 4634 or else Argv (2 .. Argv'Last) = "pg" 4635 or else (Argv (2) = 'm' and then Argv'Last > 2) 4636 or else (Argv (2) = 'f' and then Argv'Last > 2) 4637 or else Argv (2) = 'O' 4638 then 4639 Add_Switch (Argv, Compiler); 4640 Add_Switch (Argv, Linker); 4641 4642 -- The following condition has to be kept synchronized with 4643 -- the Process_Multilib one. 4644 4645 if Argv (2) = 'm' 4646 and then Argv /= "-mieee" 4647 then 4648 N_M_Switch := N_M_Switch + 1; 4649 end if; 4650 4651 -- -C=<mapping file> 4652 4653 elsif Argv'Last > 2 and then Argv (2) = 'C' then 4654 if Argv (3) /= '=' or else Argv'Last <= 3 then 4655 Make_Failed ("illegal switch " & Argv); 4656 end if; 4657 4658 Gnatmake_Mapping_File := new String'(Argv (4 .. Argv'Last)); 4659 4660 -- -D 4661 4662 elsif Argv'Last = 2 and then Argv (2) = 'D' then 4663 if Project_File_Name /= null then 4664 Make_Failed 4665 ("-D cannot be used in conjunction with a project file"); 4666 4667 else 4668 Scan_Make_Switches (Argv, Success); 4669 end if; 4670 4671 -- -d 4672 4673 elsif Argv (2) = 'd' and then Argv'Last = 2 then 4674 Display_Compilation_Progress := True; 4675 4676 -- -i 4677 4678 elsif Argv'Last = 2 and then Argv (2) = 'i' then 4679 if Project_File_Name /= null then 4680 Make_Failed 4681 ("-i cannot be used in conjunction with a project file"); 4682 else 4683 Scan_Make_Switches (Argv, Success); 4684 end if; 4685 4686 -- -j (need to save the result) 4687 4688 elsif Argv (2) = 'j' then 4689 Scan_Make_Switches (Argv, Success); 4690 4691 -- -m 4692 4693 elsif Argv (2) = 'm' and then Argv'Last = 2 then 4694 Minimal_Recompilation := True; 4695 4696 -- -u 4697 4698 elsif Argv (2) = 'u' and then Argv'Last = 2 then 4699 Unique_Compile := True; 4700 Compile_Only := True; 4701 Do_Bind_Step := False; 4702 Do_Link_Step := False; 4703 4704 -- -U 4705 4706 elsif Argv (2) = 'U' 4707 and then Argv'Last = 2 4708 then 4709 Unique_Compile := True; 4710 Compile_Only := True; 4711 Do_Bind_Step := False; 4712 Do_Link_Step := False; 4713 4714 -- -Pprj or -P prj (only once, and only on the command line) 4715 4716 elsif Argv (2) = 'P' then 4717 if Project_File_Name /= null then 4718 Make_Failed ("cannot have several project files specified"); 4719 4720 elsif Object_Directory_Path /= null then 4721 Make_Failed 4722 ("-D cannot be used in conjunction with a project file"); 4723 4724 elsif In_Place_Mode then 4725 Make_Failed 4726 ("-i cannot be used in conjunction with a project file"); 4727 4728 elsif Argv'Last = 2 then 4729 4730 -- -P is used alone: the project file name is the next option 4731 4732 Project_File_Name_Present := True; 4733 4734 else 4735 Project_File_Name := new String'(Argv (3 .. Argv'Last)); 4736 end if; 4737 4738 -- -vPx (verbosity of the parsing of the project files) 4739 4740 elsif Argv'Length >= 3 and then Argv (2 .. 3) = "vP" then 4741 if Argv'Last /= 4 or else Argv (4) not in '0' .. '2' then 4742 Make_Failed 4743 ("invalid verbosity level " & Argv (4 .. Argv'Last)); 4744 end if; 4745 4746 -- -Xext=val (External assignment) 4747 4748 elsif Argv (2) = 'X' then 4749 null; 4750 4751 -- If -gnath is present, then generate the usage information right 4752 -- now and do not pass this option on to the compiler calls. 4753 4754 elsif Argv = "-gnath" then 4755 Usage; 4756 4757 -- If -gnatc is specified, make sure the bind and link steps are not 4758 -- executed. 4759 4760 elsif Argv'Length >= 6 and then Argv (2 .. 6) = "gnatc" then 4761 4762 -- If -gnatc is specified, make sure the bind and link steps are 4763 -- not executed. 4764 4765 Add_Switch (Argv, Compiler); 4766 Operating_Mode := Check_Semantics; 4767 Check_Object_Consistency := False; 4768 4769 -- Except in CodePeer mode (set by -gnatcC), where we do want to 4770 -- call bind/link in CodePeer mode (-P switch). 4771 4772 if Argv'Last >= 7 and then Argv (7) = 'C' then 4773 CodePeer_Mode := True; 4774 else 4775 Compile_Only := True; 4776 Do_Bind_Step := False; 4777 Do_Link_Step := False; 4778 end if; 4779 4780 -- If -gnatA is specified, make sure that gnat.adc is never read 4781 4782 elsif Argv'Length >= 6 and then Argv (2 .. 6) = "gnatA" then 4783 Add_Switch (Argv, Compiler); 4784 Opt.Config_File := False; 4785 4786 elsif Argv (2 .. Argv'Last) = "nostdlib" then 4787 4788 -- Pass -nstdlib to gnatbind and gnatlink 4789 4790 No_Stdlib := True; 4791 Add_Switch (Argv, Binder); 4792 Add_Switch (Argv, Linker); 4793 4794 elsif Argv (2 .. Argv'Last) = "nostdinc" then 4795 4796 -- Pass -nostdinc to the Compiler and to gnatbind 4797 4798 No_Stdinc := True; 4799 Add_Switch (Argv, Compiler); 4800 Add_Switch (Argv, Binder); 4801 4802 -- All other switches are processed by Scan_Make_Switches. If the 4803 -- call returns with Gnatmake_Switch_Found = False, then the switch 4804 -- is passed to the compiler. 4805 4806 else 4807 Scan_Make_Switches (Argv, Gnatmake_Switch_Found); 4808 4809 if not Gnatmake_Switch_Found then 4810 Add_Switch (Argv, Compiler); 4811 end if; 4812 end if; 4813 4814 -- If not a switch it must be a file name 4815 4816 else 4817 Main_On_Command_Line := True; 4818 4819 Add_File (Argv); 4820 Mains.Add_Main (Argv); 4821 end if; 4822 end Scan_Make_Arg; 4823 4824 ----------- 4825 -- Usage -- 4826 ----------- 4827 4828 procedure Usage is 4829 begin 4830 if Usage_Needed then 4831 Usage_Needed := False; 4832 Makeusg; 4833 end if; 4834 end Usage; 4835 4836end Make; 4837