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