1------------------------------------------------------------------------------ 2-- -- 3-- GNAT COMPILER COMPONENTS -- 4-- -- 5-- M L I B . P R J -- 6-- -- 7-- B o d y -- 8-- -- 9-- Copyright (C) 2001-2015, AdaCore -- 10-- -- 11-- GNAT is free software; you can redistribute it and/or modify it under -- 12-- terms of the GNU General Public License as published by the Free Soft- -- 13-- ware Foundation; either version 3, or (at your option) any later ver- -- 14-- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- 15-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- 16-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- 17-- for more details. You should have received a copy of the GNU General -- 18-- Public License distributed with GNAT; see file COPYING3. If not, go to -- 19-- http://www.gnu.org/licenses for a complete copy of the license. -- 20-- -- 21-- GNAT was originally developed by the GNAT team at New York University. -- 22-- Extensive contributions were provided by Ada Core Technologies Inc. -- 23-- -- 24------------------------------------------------------------------------------ 25 26with ALI; use ALI; 27with Gnatvsn; use Gnatvsn; 28with Makeutl; use Makeutl; 29with MLib.Fil; use MLib.Fil; 30with MLib.Tgt; use MLib.Tgt; 31with MLib.Utl; use MLib.Utl; 32with Opt; 33with Output; use Output; 34with Prj.Com; use Prj.Com; 35with Prj.Env; use Prj.Env; 36with Prj.Util; use Prj.Util; 37with Sinput.P; 38with Snames; use Snames; 39with Switch; use Switch; 40with Table; 41with Tempdir; 42with Types; use Types; 43 44with Ada.Characters.Handling; 45 46with GNAT.Directory_Operations; use GNAT.Directory_Operations; 47with GNAT.HTable; 48with Interfaces.C_Streams; use Interfaces.C_Streams; 49with System; use System; 50with System.Case_Util; use System.Case_Util; 51 52package body MLib.Prj is 53 54 Prj_Add_Obj_Files : Types.Int; 55 pragma Import (C, Prj_Add_Obj_Files, "__gnat_prj_add_obj_files"); 56 Add_Object_Files : constant Boolean := Prj_Add_Obj_Files /= 0; 57 -- Indicates if object files in pragmas Linker_Options (found in the 58 -- binder generated file) should be taken when linking a stand-alone 59 -- library. False for Windows, True for other platforms. 60 61 ALI_Suffix : constant String := ".ali"; 62 63 B_Start : constant String := "b~"; 64 -- Prefix of bind file 65 66 S_Osinte_Ads : File_Name_Type := No_File; 67 -- Name_Id for "s-osinte.ads" 68 69 S_Dec_Ads : File_Name_Type := No_File; 70 -- Name_Id for "dec.ads" 71 72 Arguments : String_List_Access := No_Argument; 73 -- Used to accumulate arguments for the invocation of gnatbind and of the 74 -- compiler. Also used to collect the interface ALI when copying the ALI 75 -- files to the library directory. 76 77 Argument_Number : Natural := 0; 78 -- Index of the last argument in Arguments 79 80 Initial_Argument_Max : constant := 10; 81 -- Where does the magic constant 10 come from??? 82 83 No_Main_String : aliased String := "-n"; 84 No_Main : constant String_Access := No_Main_String'Access; 85 86 Output_Switch_String : aliased String := "-o"; 87 Output_Switch : constant String_Access := 88 Output_Switch_String'Access; 89 90 Compile_Switch_String : aliased String := "-c"; 91 Compile_Switch : constant String_Access := 92 Compile_Switch_String'Access; 93 94 No_Warning_String : aliased String := "-gnatws"; 95 No_Warning : constant String_Access := No_Warning_String'Access; 96 97 Auto_Initialize : constant String := "-a"; 98 99 -- List of objects to put inside the library 100 101 Object_Files : Argument_List_Access; 102 103 package Objects is new Table.Table 104 (Table_Name => "Mlib.Prj.Objects", 105 Table_Component_Type => String_Access, 106 Table_Index_Type => Natural, 107 Table_Low_Bound => 1, 108 Table_Initial => 50, 109 Table_Increment => 100); 110 111 package Objects_Htable is new GNAT.HTable.Simple_HTable 112 (Header_Num => Header_Num, 113 Element => Boolean, 114 No_Element => False, 115 Key => Name_Id, 116 Hash => Hash, 117 Equal => "="); 118 119 -- List of ALI files 120 121 Ali_Files : Argument_List_Access; 122 123 package ALIs is new Table.Table 124 (Table_Name => "Mlib.Prj.Alis", 125 Table_Component_Type => String_Access, 126 Table_Index_Type => Natural, 127 Table_Low_Bound => 1, 128 Table_Initial => 50, 129 Table_Increment => 100); 130 131 -- List of options set in the command line 132 133 Options : Argument_List_Access; 134 135 package Opts is new Table.Table 136 (Table_Name => "Mlib.Prj.Opts", 137 Table_Component_Type => String_Access, 138 Table_Index_Type => Natural, 139 Table_Low_Bound => 1, 140 Table_Initial => 5, 141 Table_Increment => 100); 142 143 -- All the ALI file in the library 144 145 package Library_ALIs is new GNAT.HTable.Simple_HTable 146 (Header_Num => Header_Num, 147 Element => Boolean, 148 No_Element => False, 149 Key => File_Name_Type, 150 Hash => Hash, 151 Equal => "="); 152 153 -- The ALI files in the interface sets 154 155 package Interface_ALIs is new GNAT.HTable.Simple_HTable 156 (Header_Num => Header_Num, 157 Element => Boolean, 158 No_Element => False, 159 Key => File_Name_Type, 160 Hash => Hash, 161 Equal => "="); 162 163 -- The ALI files that have been processed to check if the corresponding 164 -- library unit is in the interface set. 165 166 package Processed_ALIs is new GNAT.HTable.Simple_HTable 167 (Header_Num => Header_Num, 168 Element => Boolean, 169 No_Element => False, 170 Key => File_Name_Type, 171 Hash => Hash, 172 Equal => "="); 173 174 -- The projects imported directly or indirectly 175 176 package Processed_Projects is new GNAT.HTable.Simple_HTable 177 (Header_Num => Header_Num, 178 Element => Boolean, 179 No_Element => False, 180 Key => Name_Id, 181 Hash => Hash, 182 Equal => "="); 183 184 -- The library projects imported directly or indirectly 185 186 package Library_Projs is new Table.Table ( 187 Table_Component_Type => Project_Id, 188 Table_Index_Type => Integer, 189 Table_Low_Bound => 1, 190 Table_Initial => 10, 191 Table_Increment => 10, 192 Table_Name => "Make.Library_Projs"); 193 194 type Build_Mode_State is (None, Static, Dynamic, Relocatable); 195 196 procedure Add_Argument (S : String); 197 -- Add one argument to Arguments array, if array is full, double its size 198 199 function ALI_File_Name (Source : String) return String; 200 -- Return the ALI file name corresponding to a source 201 202 procedure Check (Filename : String); 203 -- Check if filename is a regular file. Fail if it is not 204 205 procedure Check_Context; 206 -- Check each object files in table Object_Files 207 -- Fail if any of them is not a regular file 208 209 procedure Copy_Interface_Sources 210 (For_Project : Project_Id; 211 In_Tree : Project_Tree_Ref; 212 Interfaces : Argument_List; 213 To_Dir : Path_Name_Type); 214 -- Copy the interface sources of a SAL to directory To_Dir 215 216 procedure Display (Executable : String); 217 -- Display invocation of gnatbind and of the compiler with the arguments 218 -- in Arguments, except when Quiet_Output is True. 219 220 function Index (S, Pattern : String) return Natural; 221 -- Return the last occurrence of Pattern in S, or 0 if none 222 223 procedure Process_Binder_File (Name : String); 224 -- For Stand-Alone libraries, get the Linker Options in the binder 225 -- generated file. 226 227 procedure Reset_Tables; 228 -- Make sure that all the above tables are empty 229 -- (Objects, Ali_Files, Options). 230 231 function SALs_Use_Constructors return Boolean; 232 -- Indicate if Stand-Alone Libraries are automatically initialized using 233 -- the constructor mechanism. 234 235 ------------------ 236 -- Add_Argument -- 237 ------------------ 238 239 procedure Add_Argument (S : String) is 240 begin 241 if Argument_Number = Arguments'Last then 242 declare 243 New_Args : constant String_List_Access := 244 new String_List (1 .. 2 * Arguments'Last); 245 246 begin 247 -- Copy the String_Accesses and set them to null in Arguments 248 -- so that they will not be deallocated by the call to 249 -- Free (Arguments). 250 251 New_Args (Arguments'Range) := Arguments.all; 252 Arguments.all := (others => null); 253 Free (Arguments); 254 Arguments := New_Args; 255 end; 256 end if; 257 258 Argument_Number := Argument_Number + 1; 259 Arguments (Argument_Number) := new String'(S); 260 end Add_Argument; 261 262 ------------------- 263 -- ALI_File_Name -- 264 ------------------- 265 266 function ALI_File_Name (Source : String) return String is 267 begin 268 -- If the source name has an extension, then replace it with 269 -- the ALI suffix. 270 271 for Index in reverse Source'First + 1 .. Source'Last loop 272 if Source (Index) = '.' then 273 return Source (Source'First .. Index - 1) & ALI_Suffix; 274 end if; 275 end loop; 276 277 -- If there is no dot, or if it is the first character, just add the 278 -- ALI suffix. 279 280 return Source & ALI_Suffix; 281 end ALI_File_Name; 282 283 ------------------- 284 -- Build_Library -- 285 ------------------- 286 287 procedure Build_Library 288 (For_Project : Project_Id; 289 In_Tree : Project_Tree_Ref; 290 Gnatbind : String; 291 Gnatbind_Path : String_Access; 292 Gcc : String; 293 Gcc_Path : String_Access; 294 Bind : Boolean := True; 295 Link : Boolean := True) 296 is 297 Maximum_Size : Integer; 298 pragma Import (C, Maximum_Size, "__gnat_link_max"); 299 -- Maximum number of bytes to put in an invocation of gnatbind 300 301 Size : Integer; 302 -- The number of bytes for the invocation of gnatbind 303 304 Warning_For_Library : Boolean := False; 305 -- Set True for first warning for a unit missing from the interface set 306 307 Current_Proj : Project_Id; 308 309 Libgnarl_Needed : Yes_No_Unknown := For_Project.Libgnarl_Needed; 310 -- Set True if library needs to be linked with libgnarl 311 312 Object_Directory_Path : constant String := 313 Get_Name_String 314 (For_Project.Object_Directory.Display_Name); 315 316 Standalone : constant Boolean := For_Project.Standalone_Library /= No; 317 318 Project_Name : constant String := Get_Name_String (For_Project.Name); 319 320 Current_Dir : constant String := Get_Current_Dir; 321 322 Lib_Filename : String_Access; 323 Lib_Dirpath : String_Access; 324 Lib_Version : String_Access := new String'(""); 325 326 The_Build_Mode : Build_Mode_State := None; 327 328 Success : Boolean := False; 329 330 Library_Options : Variable_Value := Nil_Variable_Value; 331 332 Driver_Name : Name_Id := No_Name; 333 334 In_Main_Object_Directory : Boolean := True; 335 336 Foreign_Sources : Boolean; 337 338 Rpath_Disabled : Boolean := False; 339 -- If -R is passed through the library options for the linker, it will 340 -- prevent the implemented libraries portion of the rpath switch from 341 -- being built, even if the linker is capable of supporting rpath. 342 343 Rpath : String_Access := null; 344 -- Allocated only if Path Option is supported 345 346 Rpath_Last : Natural := 0; 347 -- Index of last valid character of Rpath 348 349 Initial_Rpath_Length : constant := 200; 350 -- Initial size of Rpath, when first allocated 351 352 Path_Option : String_Access := Linker_Library_Path_Option; 353 -- If null, Path Option is not supported. Not a constant so that it can 354 -- be deallocated. 355 356 First_ALI : File_Name_Type := No_File; 357 -- Store the ALI file name of a source of the library (the first found) 358 359 procedure Add_ALI_For (Source : File_Name_Type); 360 -- Add name of the ALI file corresponding to Source to the Arguments 361 362 procedure Add_Rpath (Path : String); 363 -- Add a path name to Rpath 364 365 function Check_Project (P : Project_Id) return Boolean; 366 -- Returns True if P is For_Project or a project extended by For_Project 367 368 procedure Check_Libs (ALI_File : String; Main_Project : Boolean); 369 -- Set Libgnarl_Needed if the ALI_File indicates that there is a need 370 -- to link with -lgnarl (this is the case when there is a dependency 371 -- on s-osinte.ads). 372 373 procedure Process (The_ALI : File_Name_Type); 374 -- Check if the closure of a library unit which is or should be in the 375 -- interface set is also in the interface set. Issue a warning for each 376 -- missing library unit. 377 378 procedure Process_Imported_Libraries; 379 -- Add the -L and -l switches for the imported Library Project Files, 380 -- and, if Path Option is supported, the library directory path names 381 -- to Rpath. 382 383 ----------------- 384 -- Add_ALI_For -- 385 ----------------- 386 387 procedure Add_ALI_For (Source : File_Name_Type) is 388 ALI : constant String := ALI_File_Name (Get_Name_String (Source)); 389 ALI_Id : File_Name_Type; 390 391 begin 392 if Bind then 393 Add_Argument (ALI); 394 end if; 395 396 Name_Len := 0; 397 Add_Str_To_Name_Buffer (S => ALI); 398 ALI_Id := Name_Find; 399 400 -- Add the ALI file name to the library ALIs 401 402 if Bind then 403 Library_ALIs.Set (ALI_Id, True); 404 end if; 405 406 -- Set First_ALI, if not already done 407 408 if First_ALI = No_File then 409 First_ALI := ALI_Id; 410 end if; 411 end Add_ALI_For; 412 413 --------------- 414 -- Add_Rpath -- 415 --------------- 416 417 procedure Add_Rpath (Path : String) is 418 419 procedure Double; 420 -- Double Rpath size 421 422 ------------ 423 -- Double -- 424 ------------ 425 426 procedure Double is 427 New_Rpath : constant String_Access := 428 new String (1 .. 2 * Rpath'Length); 429 begin 430 New_Rpath (1 .. Rpath_Last) := Rpath (1 .. Rpath_Last); 431 Free (Rpath); 432 Rpath := New_Rpath; 433 end Double; 434 435 -- Start of processing for Add_Rpath 436 437 begin 438 -- If first path, allocate initial Rpath 439 440 if Rpath = null then 441 Rpath := new String (1 .. Initial_Rpath_Length); 442 Rpath_Last := 0; 443 444 else 445 -- Otherwise, add a path separator between two path names 446 447 if Rpath_Last = Rpath'Last then 448 Double; 449 end if; 450 451 Rpath_Last := Rpath_Last + 1; 452 Rpath (Rpath_Last) := Path_Separator; 453 end if; 454 455 -- Increase Rpath size until it is large enough 456 457 while Rpath_Last + Path'Length > Rpath'Last loop 458 Double; 459 end loop; 460 461 -- Add the path name 462 463 Rpath (Rpath_Last + 1 .. Rpath_Last + Path'Length) := Path; 464 Rpath_Last := Rpath_Last + Path'Length; 465 end Add_Rpath; 466 467 ------------------- 468 -- Check_Project -- 469 ------------------- 470 471 function Check_Project (P : Project_Id) return Boolean is 472 begin 473 if P = For_Project then 474 return True; 475 476 elsif P /= No_Project then 477 declare 478 Proj : Project_Id; 479 480 begin 481 Proj := For_Project; 482 while Proj.Extends /= No_Project loop 483 if P = Proj.Extends then 484 return True; 485 end if; 486 487 Proj := Proj.Extends; 488 end loop; 489 end; 490 end if; 491 492 return False; 493 end Check_Project; 494 495 ---------------- 496 -- Check_Libs -- 497 ---------------- 498 499 procedure Check_Libs (ALI_File : String; Main_Project : Boolean) is 500 Lib_File : File_Name_Type; 501 Text : Text_Buffer_Ptr; 502 Id : ALI.ALI_Id; 503 504 begin 505 if Libgnarl_Needed /= Yes then 506 507 -- Scan the ALI file 508 509 Name_Len := ALI_File'Length; 510 Name_Buffer (1 .. Name_Len) := ALI_File; 511 Lib_File := Name_Find; 512 Text := Read_Library_Info (Lib_File, True); 513 514 Id := ALI.Scan_ALI 515 (F => Lib_File, 516 T => Text, 517 Ignore_ED => False, 518 Err => True, 519 Read_Lines => "D"); 520 Free (Text); 521 522 -- Look for s-osinte.ads in the dependencies 523 524 for Index in ALI.ALIs.Table (Id).First_Sdep .. 525 ALI.ALIs.Table (Id).Last_Sdep 526 loop 527 if ALI.Sdep.Table (Index).Sfile = S_Osinte_Ads then 528 Libgnarl_Needed := Yes; 529 530 if Main_Project then 531 For_Project.Libgnarl_Needed := Yes; 532 else 533 exit; 534 end if; 535 end if; 536 end loop; 537 end if; 538 end Check_Libs; 539 540 ------------- 541 -- Process -- 542 ------------- 543 544 procedure Process (The_ALI : File_Name_Type) is 545 Text : Text_Buffer_Ptr; 546 Idread : ALI_Id; 547 First_Unit : ALI.Unit_Id; 548 Last_Unit : ALI.Unit_Id; 549 Unit_Data : Unit_Record; 550 Afile : File_Name_Type; 551 552 begin 553 -- Nothing to do if the ALI file has already been processed. 554 -- This happens if an interface imports another interface. 555 556 if not Processed_ALIs.Get (The_ALI) then 557 Processed_ALIs.Set (The_ALI, True); 558 Text := Read_Library_Info (The_ALI); 559 560 if Text /= null then 561 Idread := 562 Scan_ALI 563 (F => The_ALI, 564 T => Text, 565 Ignore_ED => False, 566 Err => True); 567 Free (Text); 568 569 if Idread /= No_ALI_Id then 570 First_Unit := ALI.ALIs.Table (Idread).First_Unit; 571 Last_Unit := ALI.ALIs.Table (Idread).Last_Unit; 572 573 -- Process both unit (spec and body) if the body is needed 574 -- by the spec (inline or generic). Otherwise, just process 575 -- the spec. 576 577 if First_Unit /= Last_Unit and then 578 not ALI.Units.Table (Last_Unit).Body_Needed_For_SAL 579 then 580 First_Unit := Last_Unit; 581 end if; 582 583 for Unit in First_Unit .. Last_Unit loop 584 Unit_Data := ALI.Units.Table (Unit); 585 586 -- Check if each withed unit which is in the library is 587 -- also in the interface set, if it has not yet been 588 -- processed. 589 590 for W in Unit_Data.First_With .. Unit_Data.Last_With loop 591 Afile := Withs.Table (W).Afile; 592 593 if Afile /= No_File and then Library_ALIs.Get (Afile) 594 and then not Processed_ALIs.Get (Afile) 595 then 596 if not Interface_ALIs.Get (Afile) then 597 if not Warning_For_Library then 598 Write_Str ("Warning: In library project """); 599 Get_Name_String (Current_Proj.Name); 600 To_Mixed (Name_Buffer (1 .. Name_Len)); 601 Write_Str (Name_Buffer (1 .. Name_Len)); 602 Write_Line (""""); 603 Warning_For_Library := True; 604 end if; 605 606 Write_Str (" Unit """); 607 Get_Name_String (Withs.Table (W).Uname); 608 To_Mixed (Name_Buffer (1 .. Name_Len - 2)); 609 Write_Str (Name_Buffer (1 .. Name_Len - 2)); 610 Write_Line (""" is not in the interface set"); 611 Write_Str (" but it is needed by "); 612 613 case Unit_Data.Utype is 614 when Is_Spec => 615 Write_Str ("the spec of "); 616 617 when Is_Body => 618 Write_Str ("the body of "); 619 620 when others => 621 null; 622 end case; 623 624 Write_Str (""""); 625 Get_Name_String (Unit_Data.Uname); 626 To_Mixed (Name_Buffer (1 .. Name_Len - 2)); 627 Write_Str (Name_Buffer (1 .. Name_Len - 2)); 628 Write_Line (""""); 629 end if; 630 631 -- Now, process this unit 632 633 Process (Afile); 634 end if; 635 end loop; 636 end loop; 637 end if; 638 end if; 639 end if; 640 end Process; 641 642 -------------------------------- 643 -- Process_Imported_Libraries -- 644 -------------------------------- 645 646 procedure Process_Imported_Libraries is 647 Current : Project_Id; 648 649 procedure Process_Project (Project : Project_Id); 650 -- Process Project and its imported projects recursively. 651 -- Add any library projects to table Library_Projs. 652 653 --------------------- 654 -- Process_Project -- 655 --------------------- 656 657 procedure Process_Project (Project : Project_Id) is 658 Imported : Project_List; 659 660 begin 661 -- Nothing to do if process has already been processed 662 663 if not Processed_Projects.Get (Project.Name) then 664 Processed_Projects.Set (Project.Name, True); 665 666 -- Call Process_Project recursively for any imported project. 667 -- We first process the imported projects to guarantee that 668 -- we have a proper reverse order for the libraries. 669 670 Imported := Project.Imported_Projects; 671 while Imported /= null loop 672 if Imported.Project /= No_Project then 673 Process_Project (Imported.Project); 674 end if; 675 676 Imported := Imported.Next; 677 end loop; 678 679 -- If it is a library project, add it to Library_Projs 680 681 if Project /= For_Project and then Project.Library then 682 Library_Projs.Increment_Last; 683 Library_Projs.Table (Library_Projs.Last) := Project; 684 685 -- Check if because of this library we need to use libgnarl 686 687 if Libgnarl_Needed = Unknown then 688 if Project.Libgnarl_Needed = Unknown 689 and then Project.Object_Directory /= No_Path_Information 690 then 691 -- Check if libgnarl is needed for this library 692 693 declare 694 Object_Dir_Path : constant String := 695 Get_Name_String 696 (Project.Object_Directory. 697 Display_Name); 698 Object_Dir : Dir_Type; 699 Filename : String (1 .. 255); 700 Last : Natural; 701 702 begin 703 Open (Object_Dir, Object_Dir_Path); 704 705 -- For all entries in the object directory 706 707 loop 708 Read (Object_Dir, Filename, Last); 709 exit when Last = 0; 710 711 -- Check if it is an object file 712 713 if Is_Obj (Filename (1 .. Last)) then 714 declare 715 Object_Path : constant String := 716 Normalize_Pathname 717 (Object_Dir_Path & 718 Directory_Separator & 719 Filename (1 .. Last)); 720 ALI_File : constant String := 721 Ext_To 722 (Object_Path, "ali"); 723 724 begin 725 if Is_Regular_File (ALI_File) then 726 727 -- Find out if for this ALI file, 728 -- libgnarl is necessary. 729 730 Check_Libs 731 (ALI_File, Main_Project => False); 732 733 if Libgnarl_Needed = Yes then 734 Project.Libgnarl_Needed := Yes; 735 For_Project.Libgnarl_Needed := Yes; 736 exit; 737 end if; 738 end if; 739 end; 740 end if; 741 end loop; 742 743 Close (Object_Dir); 744 end; 745 end if; 746 747 if Project.Libgnarl_Needed = Yes then 748 Libgnarl_Needed := Yes; 749 For_Project.Libgnarl_Needed := Yes; 750 end if; 751 end if; 752 end if; 753 end if; 754 end Process_Project; 755 756 -- Start of processing for Process_Imported_Libraries 757 758 begin 759 -- Build list of library projects imported directly or indirectly, 760 -- in the reverse order. 761 762 Process_Project (For_Project); 763 764 -- Add the -L and -l switches and, if the Rpath option is supported, 765 -- add the directory to the Rpath. As the library projects are in the 766 -- wrong order, process from the last to the first. 767 768 for Index in reverse 1 .. Library_Projs.Last loop 769 Current := Library_Projs.Table (Index); 770 771 Get_Name_String (Current.Library_Dir.Display_Name); 772 Opts.Increment_Last; 773 Opts.Table (Opts.Last) := 774 new String'("-L" & Name_Buffer (1 .. Name_Len)); 775 776 if not Rpath_Disabled and then Path_Option /= null then 777 Add_Rpath (Name_Buffer (1 .. Name_Len)); 778 end if; 779 780 Opts.Increment_Last; 781 Opts.Table (Opts.Last) := 782 new String'("-l" & Get_Name_String (Current.Library_Name)); 783 end loop; 784 end Process_Imported_Libraries; 785 786 Path_FD : File_Descriptor := Invalid_FD; 787 -- Used for setting the source and object paths 788 789 -- Start of processing for Build_Library 790 791 begin 792 Reset_Tables; 793 794 -- Fail if project is not a library project 795 796 if not For_Project.Library then 797 Com.Fail ("project """ & Project_Name & """ has no library"); 798 end if; 799 800 -- Do not attempt to build the library if it is externally built 801 802 if For_Project.Externally_Built then 803 return; 804 end if; 805 806 -- If this is the first time Build_Library is called, get the Name_Id 807 -- of "s-osinte.ads". 808 809 if S_Osinte_Ads = No_File then 810 Name_Len := 0; 811 Add_Str_To_Name_Buffer ("s-osinte.ads"); 812 S_Osinte_Ads := Name_Find; 813 end if; 814 815 if S_Dec_Ads = No_File then 816 Name_Len := 0; 817 Add_Str_To_Name_Buffer ("dec.ads"); 818 S_Dec_Ads := Name_Find; 819 end if; 820 821 -- We work in the object directory 822 823 Change_Dir (Object_Directory_Path); 824 825 if Standalone then 826 827 -- Call gnatbind only if Bind is True 828 829 if Bind then 830 if Gnatbind_Path = null then 831 Com.Fail ("unable to locate " & Gnatbind); 832 end if; 833 834 if Gcc_Path = null then 835 Com.Fail ("unable to locate " & Gcc); 836 end if; 837 838 -- Allocate Arguments, if it is the first time we see a standalone 839 -- library. 840 841 if Arguments = No_Argument then 842 Arguments := new String_List (1 .. Initial_Argument_Max); 843 end if; 844 845 -- Add "-n -o b~<lib>.adb -L<lib>_" 846 847 Argument_Number := 2; 848 Arguments (1) := No_Main; 849 Arguments (2) := Output_Switch; 850 851 Add_Argument 852 (B_Start & Get_Name_String (For_Project.Library_Name) & ".adb"); 853 854 -- Make sure that the init procedure is never "adainit" 855 856 Get_Name_String (For_Project.Library_Name); 857 858 if Name_Buffer (1 .. Name_Len) = "ada" then 859 Add_Argument ("-Lada_"); 860 else 861 Add_Argument 862 ("-L" & Get_Name_String (For_Project.Library_Name)); 863 end if; 864 865 if For_Project.Lib_Auto_Init and then SALs_Use_Constructors then 866 Add_Argument (Auto_Initialize); 867 end if; 868 869 -- Check if Binder'Default_Switches ("Ada") is defined. If it is, 870 -- add these switches to call gnatbind. 871 872 declare 873 Binder_Package : constant Package_Id := 874 Value_Of 875 (Name => Name_Binder, 876 In_Packages => For_Project.Decl.Packages, 877 Shared => In_Tree.Shared); 878 879 begin 880 if Binder_Package /= No_Package then 881 declare 882 Defaults : constant Array_Element_Id := 883 Value_Of 884 (Name => Name_Default_Switches, 885 In_Arrays => 886 In_Tree.Shared.Packages.Table 887 (Binder_Package).Decl.Arrays, 888 Shared => In_Tree.Shared); 889 890 Switches : Variable_Value := Nil_Variable_Value; 891 Switch : String_List_Id := Nil_String; 892 893 begin 894 if Defaults /= No_Array_Element then 895 Switches := 896 Value_Of 897 (Index => Name_Ada, 898 Src_Index => 0, 899 In_Array => Defaults, 900 Shared => In_Tree.Shared); 901 902 if not Switches.Default then 903 Switch := Switches.Values; 904 905 while Switch /= Nil_String loop 906 Add_Argument 907 (Get_Name_String 908 (In_Tree.Shared.String_Elements.Table 909 (Switch).Value)); 910 Switch := In_Tree.Shared.String_Elements. 911 Table (Switch).Next; 912 end loop; 913 end if; 914 end if; 915 end; 916 end if; 917 end; 918 end if; 919 920 -- Get all the ALI files of the project file. We do that even if 921 -- Bind is False, so that First_ALI is set. 922 923 declare 924 Unit : Unit_Index; 925 926 begin 927 Library_ALIs.Reset; 928 Interface_ALIs.Reset; 929 Processed_ALIs.Reset; 930 931 Unit := Units_Htable.Get_First (In_Tree.Units_HT); 932 while Unit /= No_Unit_Index loop 933 if Unit.File_Names (Impl) /= null 934 and then not Unit.File_Names (Impl).Locally_Removed 935 then 936 if Check_Project (Unit.File_Names (Impl).Project) then 937 if Unit.File_Names (Spec) = null then 938 939 -- Add the ALI file only if it is not a subunit 940 941 declare 942 Src_Ind : constant Source_File_Index := 943 Sinput.P.Load_Project_File 944 (Get_Name_String 945 (Unit.File_Names (Impl).Path.Name)); 946 begin 947 if not 948 Sinput.P.Source_File_Is_Subunit (Src_Ind) 949 then 950 Add_ALI_For (Unit.File_Names (Impl).File); 951 exit when not Bind; 952 end if; 953 end; 954 955 else 956 Add_ALI_For (Unit.File_Names (Impl).File); 957 exit when not Bind; 958 end if; 959 end if; 960 961 elsif Unit.File_Names (Spec) /= null 962 and then not Unit.File_Names (Spec).Locally_Removed 963 and then Check_Project (Unit.File_Names (Spec).Project) 964 then 965 Add_ALI_For (Unit.File_Names (Spec).File); 966 exit when not Bind; 967 end if; 968 969 Unit := Units_Htable.Get_Next (In_Tree.Units_HT); 970 end loop; 971 end; 972 973 -- Continue setup and call gnatbind if Bind is True 974 975 if Bind then 976 977 -- Get an eventual --RTS from the ALI file 978 979 if First_ALI /= No_File then 980 declare 981 T : Text_Buffer_Ptr; 982 A : ALI_Id; 983 984 begin 985 -- Load the ALI file 986 987 T := Read_Library_Info (First_ALI, True); 988 989 -- Read it 990 991 A := Scan_ALI 992 (First_ALI, T, Ignore_ED => False, Err => False); 993 994 if A /= No_ALI_Id then 995 for Index in 996 ALI.Units.Table 997 (ALI.ALIs.Table (A).First_Unit).First_Arg .. 998 ALI.Units.Table 999 (ALI.ALIs.Table (A).First_Unit).Last_Arg 1000 loop 1001 -- If --RTS found, add switch to call gnatbind 1002 1003 declare 1004 Arg : String_Ptr renames Args.Table (Index); 1005 begin 1006 if Arg'Length >= 6 and then 1007 Arg (Arg'First + 2 .. Arg'First + 5) = "RTS=" 1008 then 1009 Add_Argument (Arg.all); 1010 exit; 1011 end if; 1012 end; 1013 end loop; 1014 end if; 1015 end; 1016 end if; 1017 1018 -- Set the paths 1019 1020 -- First the source path 1021 1022 if For_Project.Include_Path_File = No_Path then 1023 Get_Directories 1024 (Project_Tree => In_Tree, 1025 For_Project => For_Project, 1026 Activity => Compilation, 1027 Languages => Ada_Only); 1028 1029 Create_New_Path_File 1030 (In_Tree.Shared, Path_FD, For_Project.Include_Path_File); 1031 1032 Write_Path_File (Path_FD); 1033 Path_FD := Invalid_FD; 1034 end if; 1035 1036 if Current_Source_Path_File_Of (In_Tree.Shared) /= 1037 For_Project.Include_Path_File 1038 then 1039 Set_Current_Source_Path_File_Of 1040 (In_Tree.Shared, For_Project.Include_Path_File); 1041 Set_Path_File_Var 1042 (Project_Include_Path_File, 1043 Get_Name_String (For_Project.Include_Path_File)); 1044 end if; 1045 1046 -- Then, the object path 1047 1048 Get_Directories 1049 (Project_Tree => In_Tree, 1050 For_Project => For_Project, 1051 Activity => SAL_Binding, 1052 Languages => Ada_Only); 1053 1054 declare 1055 Path_File_Name : Path_Name_Type; 1056 1057 begin 1058 Create_New_Path_File (In_Tree.Shared, Path_FD, Path_File_Name); 1059 1060 Write_Path_File (Path_FD); 1061 Path_FD := Invalid_FD; 1062 1063 Set_Path_File_Var 1064 (Project_Objects_Path_File, Get_Name_String (Path_File_Name)); 1065 Set_Current_Source_Path_File_Of 1066 (In_Tree.Shared, Path_File_Name); 1067 end; 1068 1069 -- Display the gnatbind command, if not in quiet output 1070 1071 Display (Gnatbind); 1072 1073 Size := 0; 1074 for J in 1 .. Argument_Number loop 1075 Size := Size + Arguments (J)'Length + 1; 1076 end loop; 1077 1078 -- Invoke gnatbind with the arguments if the size is not too large 1079 1080 if Size <= Maximum_Size then 1081 Spawn 1082 (Gnatbind_Path.all, 1083 Arguments (1 .. Argument_Number), 1084 Success); 1085 1086 -- Otherwise create a temporary response file 1087 1088 else 1089 declare 1090 FD : File_Descriptor; 1091 Path : Path_Name_Type; 1092 Args : Argument_List (1 .. 1); 1093 EOL : constant String (1 .. 1) := (1 => ASCII.LF); 1094 Status : Integer; 1095 Succ : Boolean; 1096 Quotes_Needed : Boolean; 1097 Last_Char : Natural; 1098 Ch : Character; 1099 1100 begin 1101 Tempdir.Create_Temp_File (FD, Path); 1102 Args (1) := new String'("@" & Get_Name_String (Path)); 1103 1104 for J in 1 .. Argument_Number loop 1105 1106 -- Check if the argument should be quoted 1107 1108 Quotes_Needed := False; 1109 Last_Char := Arguments (J)'Length; 1110 1111 for K in Arguments (J)'Range loop 1112 Ch := Arguments (J) (K); 1113 1114 if Ch = ' ' or else Ch = ASCII.HT or else Ch = '"' then 1115 Quotes_Needed := True; 1116 exit; 1117 end if; 1118 end loop; 1119 1120 if Quotes_Needed then 1121 1122 -- Quote the argument, doubling '"' 1123 1124 declare 1125 Arg : String (1 .. Arguments (J)'Length * 2 + 2); 1126 1127 begin 1128 Arg (1) := '"'; 1129 Last_Char := 1; 1130 1131 for K in Arguments (J)'Range loop 1132 Ch := Arguments (J) (K); 1133 Last_Char := Last_Char + 1; 1134 Arg (Last_Char) := Ch; 1135 1136 if Ch = '"' then 1137 Last_Char := Last_Char + 1; 1138 Arg (Last_Char) := '"'; 1139 end if; 1140 end loop; 1141 1142 Last_Char := Last_Char + 1; 1143 Arg (Last_Char) := '"'; 1144 1145 Status := Write (FD, Arg'Address, Last_Char); 1146 end; 1147 1148 else 1149 Status := Write 1150 (FD, 1151 Arguments (J) (Arguments (J)'First)'Address, 1152 Last_Char); 1153 end if; 1154 1155 if Status /= Last_Char then 1156 Fail ("disk full"); 1157 end if; 1158 1159 Status := Write (FD, EOL (1)'Address, 1); 1160 1161 if Status /= 1 then 1162 Fail ("disk full"); 1163 end if; 1164 end loop; 1165 1166 Close (FD); 1167 1168 -- And invoke gnatbind with this response file 1169 1170 Spawn (Gnatbind_Path.all, Args, Success); 1171 1172 Delete_File (Get_Name_String (Path), Succ); 1173 1174 -- We ignore a failure in this Delete_File operation. 1175 -- Is that OK??? If so, worth a comment as to why we 1176 -- are OK with the operation failing 1177 end; 1178 end if; 1179 1180 if not Success then 1181 Com.Fail ("could not bind standalone library " 1182 & Get_Name_String (For_Project.Library_Name)); 1183 end if; 1184 end if; 1185 1186 -- Compile the binder generated file only if Link is true 1187 1188 if Link then 1189 1190 -- Set the paths 1191 1192 Set_Ada_Paths 1193 (Project => For_Project, 1194 In_Tree => In_Tree, 1195 Including_Libraries => True); 1196 1197 -- Invoke <gcc> -c b__<lib>.adb 1198 1199 -- Allocate Arguments, if first time we see a standalone library 1200 1201 if Arguments = No_Argument then 1202 Arguments := new String_List (1 .. Initial_Argument_Max); 1203 end if; 1204 1205 Argument_Number := 2; 1206 Arguments (1) := Compile_Switch; 1207 Arguments (2) := No_Warning; 1208 1209 Add_Argument 1210 (B_Start & Get_Name_String (For_Project.Library_Name) & ".adb"); 1211 1212 -- If necessary, add the PIC option 1213 1214 if PIC_Option /= "" then 1215 Add_Argument (PIC_Option); 1216 end if; 1217 1218 -- Get the back-end switches and --RTS from the ALI file 1219 1220 if First_ALI /= No_File then 1221 declare 1222 T : Text_Buffer_Ptr; 1223 A : ALI_Id; 1224 1225 begin 1226 -- Load the ALI file 1227 1228 T := Read_Library_Info (First_ALI, True); 1229 1230 -- Read it 1231 1232 A := 1233 Scan_ALI (First_ALI, T, Ignore_ED => False, Err => False); 1234 1235 if A /= No_ALI_Id then 1236 for Index in 1237 ALI.Units.Table 1238 (ALI.ALIs.Table (A).First_Unit).First_Arg .. 1239 ALI.Units.Table 1240 (ALI.ALIs.Table (A).First_Unit).Last_Arg 1241 loop 1242 -- Do not compile with the front end switches except 1243 -- for --RTS. 1244 1245 declare 1246 Arg : String_Ptr renames Args.Table (Index); 1247 begin 1248 if not Is_Front_End_Switch (Arg.all) 1249 or else 1250 Arg (Arg'First + 2 .. Arg'First + 5) = "RTS=" 1251 then 1252 Add_Argument (Arg.all); 1253 end if; 1254 end; 1255 end loop; 1256 end if; 1257 end; 1258 end if; 1259 1260 -- Now all the arguments are set, compile binder generated file 1261 1262 Display (Gcc); 1263 Spawn 1264 (Gcc_Path.all, Arguments (1 .. Argument_Number), Success); 1265 1266 if not Success then 1267 Com.Fail 1268 ("could not compile binder generated file for library " 1269 & Get_Name_String (For_Project.Library_Name)); 1270 end if; 1271 1272 -- Process binder generated file for pragmas Linker_Options 1273 1274 Process_Binder_File (Arguments (3).all & ASCII.NUL); 1275 end if; 1276 end if; 1277 1278 -- Build the library only if Link is True 1279 1280 if Link then 1281 1282 -- If attributes Library_GCC or Linker'Driver were specified, get the 1283 -- driver name. 1284 1285 if For_Project.Config.Shared_Lib_Driver /= No_File then 1286 Driver_Name := Name_Id (For_Project.Config.Shared_Lib_Driver); 1287 end if; 1288 1289 -- If attribute Library_Options was specified, add these options 1290 1291 Library_Options := Value_Of 1292 (Name_Library_Options, For_Project.Decl.Attributes, 1293 In_Tree.Shared); 1294 1295 if not Library_Options.Default then 1296 declare 1297 Current : String_List_Id; 1298 Element : String_Element; 1299 1300 begin 1301 Current := Library_Options.Values; 1302 while Current /= Nil_String loop 1303 Element := In_Tree.Shared.String_Elements.Table (Current); 1304 Get_Name_String (Element.Value); 1305 1306 if Name_Len /= 0 then 1307 if Name_Buffer (1 .. Name_Len) = "-R" then 1308 Rpath_Disabled := True; 1309 else 1310 Opts.Increment_Last; 1311 Opts.Table (Opts.Last) := 1312 new String'(Name_Buffer (1 .. Name_Len)); 1313 end if; 1314 end if; 1315 1316 Current := Element.Next; 1317 end loop; 1318 end; 1319 end if; 1320 1321 Lib_Dirpath := 1322 new String'(Get_Name_String (For_Project.Library_Dir.Display_Name)); 1323 Lib_Filename := 1324 new String'(Get_Name_String (For_Project.Library_Name)); 1325 1326 case For_Project.Library_Kind is 1327 when Static => 1328 The_Build_Mode := Static; 1329 1330 when Dynamic => 1331 The_Build_Mode := Dynamic; 1332 1333 when Relocatable => 1334 The_Build_Mode := Relocatable; 1335 1336 if PIC_Option /= "" then 1337 Opts.Increment_Last; 1338 Opts.Table (Opts.Last) := new String'(PIC_Option); 1339 end if; 1340 end case; 1341 1342 -- Get the library version, if any 1343 1344 if For_Project.Lib_Internal_Name /= No_Name then 1345 Lib_Version := 1346 new String'(Get_Name_String (For_Project.Lib_Internal_Name)); 1347 end if; 1348 1349 -- Add the objects found in the object directory and the object 1350 -- directories of the extended files, if any, except for generated 1351 -- object files (b~.. or B__..) from extended projects. 1352 -- When there are one or more extended files, only add an object file 1353 -- if no object file with the same name have already been added. 1354 1355 In_Main_Object_Directory := True; 1356 1357 -- For gnatmake, when the project specifies more than just Ada as a 1358 -- language (even if course we could not find any source file for 1359 -- the other languages), we will take all object files found in the 1360 -- object directories. Since we know the project supports at least 1361 -- Ada, we just have to test whether it has at least two languages, 1362 -- and not care about the sources. 1363 1364 Foreign_Sources := For_Project.Languages.Next /= null; 1365 Current_Proj := For_Project; 1366 loop 1367 if Current_Proj.Object_Directory /= No_Path_Information then 1368 1369 -- The following code gets far too indented ... suggest some 1370 -- procedural abstraction here. How about making this declare 1371 -- block a named procedure??? 1372 1373 declare 1374 Object_Dir_Path : constant String := 1375 Get_Name_String 1376 (Current_Proj.Object_Directory 1377 .Display_Name); 1378 1379 Object_Dir : Dir_Type; 1380 Filename : String (1 .. 255); 1381 Last : Natural; 1382 Id : Name_Id; 1383 1384 begin 1385 Open (Dir => Object_Dir, Dir_Name => Object_Dir_Path); 1386 1387 -- For all entries in the object directory 1388 1389 loop 1390 Read (Object_Dir, Filename, Last); 1391 1392 exit when Last = 0; 1393 1394 -- Check if it is an object file 1395 1396 if Is_Obj (Filename (1 .. Last)) then 1397 declare 1398 Object_Path : constant String := 1399 Normalize_Pathname 1400 (Object_Dir_Path 1401 & Directory_Separator 1402 & Filename (1 .. Last)); 1403 Object_File : constant String := 1404 Filename (1 .. Last); 1405 1406 C_Filename : String := Object_File; 1407 1408 begin 1409 Canonical_Case_File_Name (C_Filename); 1410 1411 -- If in the object directory of an extended 1412 -- project, do not consider generated object files. 1413 1414 if In_Main_Object_Directory 1415 or else Last < 5 1416 or else 1417 C_Filename (1 .. B_Start'Length) /= B_Start 1418 then 1419 Name_Len := 0; 1420 Add_Str_To_Name_Buffer (C_Filename); 1421 Id := Name_Find; 1422 1423 if not Objects_Htable.Get (Id) then 1424 declare 1425 ALI_File : constant String := 1426 Ext_To (C_Filename, "ali"); 1427 1428 ALI_Path : constant String := 1429 Ext_To (Object_Path, "ali"); 1430 1431 Add_It : Boolean; 1432 Fname : File_Name_Type; 1433 Proj : Project_Id; 1434 Index : Unit_Index; 1435 1436 begin 1437 -- The following assignment could use 1438 -- a comment ??? 1439 1440 Add_It := 1441 Foreign_Sources 1442 or else 1443 (Last >= 5 1444 and then 1445 C_Filename (1 .. B_Start'Length) 1446 = B_Start); 1447 1448 if Is_Regular_File (ALI_Path) then 1449 1450 -- If there is an ALI file, check if 1451 -- the object file should be added to 1452 -- the library. If there are foreign 1453 -- sources we put all object files in 1454 -- the library. 1455 1456 if not Add_It then 1457 Index := 1458 Units_Htable.Get_First 1459 (In_Tree.Units_HT); 1460 while Index /= null loop 1461 if Index.File_Names (Impl) /= 1462 null 1463 then 1464 Proj := 1465 Index.File_Names (Impl) 1466 .Project; 1467 Fname := 1468 Index.File_Names (Impl).File; 1469 1470 elsif Index.File_Names (Spec) /= 1471 null 1472 then 1473 Proj := 1474 Index.File_Names (Spec) 1475 .Project; 1476 Fname := 1477 Index.File_Names (Spec).File; 1478 1479 else 1480 Proj := No_Project; 1481 end if; 1482 1483 Add_It := Proj /= No_Project; 1484 1485 -- If the source is in the 1486 -- project or a project it 1487 -- extends, we may put it in 1488 -- the library. 1489 1490 if Add_It then 1491 Add_It := Check_Project (Proj); 1492 end if; 1493 1494 -- But we don't, if the ALI file 1495 -- does not correspond to the 1496 -- unit. 1497 1498 if Add_It then 1499 declare 1500 F : constant String := 1501 Ext_To 1502 (Get_Name_String 1503 (Fname), "ali"); 1504 begin 1505 Add_It := F = ALI_File; 1506 end; 1507 end if; 1508 1509 exit when Add_It; 1510 1511 Index := 1512 Units_Htable.Get_Next 1513 (In_Tree.Units_HT); 1514 end loop; 1515 end if; 1516 1517 if Add_It then 1518 Objects_Htable.Set (Id, True); 1519 Objects.Append 1520 (new String'(Object_Path)); 1521 1522 -- Record the ALI file 1523 1524 ALIs.Append (new String'(ALI_Path)); 1525 1526 -- Find out if for this ALI file, 1527 -- libgnarl is necessary. 1528 1529 Check_Libs (ALI_Path, True); 1530 end if; 1531 1532 elsif Foreign_Sources then 1533 Objects.Append 1534 (new String'(Object_Path)); 1535 end if; 1536 end; 1537 end if; 1538 end if; 1539 end; 1540 end if; 1541 end loop; 1542 1543 Close (Dir => Object_Dir); 1544 1545 exception 1546 when Directory_Error => 1547 Com.Fail ("cannot find object directory """ 1548 & Get_Name_String 1549 (Current_Proj.Object_Directory.Display_Name) 1550 & """"); 1551 end; 1552 end if; 1553 1554 exit when Current_Proj.Extends = No_Project; 1555 1556 In_Main_Object_Directory := False; 1557 Current_Proj := Current_Proj.Extends; 1558 end loop; 1559 1560 -- Add the -L and -l switches for the imported Library Project Files, 1561 -- and, if Path Option is supported, the library directory path names 1562 -- to Rpath. 1563 1564 Process_Imported_Libraries; 1565 1566 -- Link with libgnat and possibly libgnarl 1567 1568 Opts.Increment_Last; 1569 Opts.Table (Opts.Last) := new String'("-L" & Lib_Directory); 1570 1571 -- If Path Option supported, add libgnat directory path name to Rpath 1572 1573 if Path_Option /= null then 1574 declare 1575 Libdir : constant String := Lib_Directory; 1576 GCC_Index : Natural := 0; 1577 1578 begin 1579 Add_Rpath (Libdir); 1580 1581 -- For shared libraries, add to the Path Option the directory 1582 -- of the shared version of libgcc. 1583 1584 if The_Build_Mode /= Static then 1585 GCC_Index := Index (Libdir, "/lib/"); 1586 1587 if GCC_Index = 0 then 1588 GCC_Index := 1589 Index 1590 (Libdir, 1591 Directory_Separator & "lib" & Directory_Separator); 1592 end if; 1593 1594 if GCC_Index /= 0 then 1595 Add_Rpath (Libdir (Libdir'First .. GCC_Index + 3)); 1596 end if; 1597 end if; 1598 end; 1599 end if; 1600 1601 if Libgnarl_Needed = Yes then 1602 Opts.Increment_Last; 1603 1604 if The_Build_Mode = Static then 1605 Opts.Table (Opts.Last) := new String'("-lgnarl"); 1606 else 1607 Opts.Table (Opts.Last) := new String'(Shared_Lib ("gnarl")); 1608 end if; 1609 end if; 1610 1611 Opts.Increment_Last; 1612 1613 if The_Build_Mode = Static then 1614 Opts.Table (Opts.Last) := new String'("-lgnat"); 1615 else 1616 Opts.Table (Opts.Last) := new String'(Shared_Lib ("gnat")); 1617 end if; 1618 1619 -- If Path Option is supported, add the necessary switch with the 1620 -- content of Rpath. As Rpath contains at least libgnat directory 1621 -- path name, it is guaranteed that it is not null. 1622 1623 if Opt.Run_Path_Option and then Path_Option /= null then 1624 Opts.Increment_Last; 1625 Opts.Table (Opts.Last) := 1626 new String'(Path_Option.all & Rpath (1 .. Rpath_Last)); 1627 Free (Path_Option); 1628 Free (Rpath); 1629 end if; 1630 1631 Object_Files := 1632 new Argument_List' 1633 (Argument_List (Objects.Table (1 .. Objects.Last))); 1634 1635 Ali_Files := 1636 new Argument_List'(Argument_List (ALIs.Table (1 .. ALIs.Last))); 1637 1638 Options := 1639 new Argument_List'(Argument_List (Opts.Table (1 .. Opts.Last))); 1640 1641 -- We fail if there are no object to put in the library 1642 -- (Ada or foreign objects). 1643 1644 if Object_Files'Length = 0 then 1645 Com.Fail ("no object files for library """ & 1646 Lib_Filename.all & '"'); 1647 end if; 1648 1649 if not Opt.Quiet_Output then 1650 Write_Eol; 1651 Write_Str ("building "); 1652 Write_Str (Ada.Characters.Handling.To_Lower 1653 (Build_Mode_State'Image (The_Build_Mode))); 1654 Write_Str (" library for project "); 1655 Write_Line (Project_Name); 1656 1657 -- Only output list of object files and ALI files in verbose mode 1658 1659 if Opt.Verbose_Mode then 1660 Write_Eol; 1661 1662 Write_Line ("object files:"); 1663 1664 for Index in Object_Files'Range loop 1665 Write_Str (" "); 1666 Write_Line (Object_Files (Index).all); 1667 end loop; 1668 1669 Write_Eol; 1670 1671 if Ali_Files'Length = 0 then 1672 Write_Line ("NO ALI files"); 1673 1674 else 1675 Write_Line ("ALI files:"); 1676 1677 for Index in Ali_Files'Range loop 1678 Write_Str (" "); 1679 Write_Line (Ali_Files (Index).all); 1680 end loop; 1681 end if; 1682 1683 Write_Eol; 1684 end if; 1685 end if; 1686 1687 -- We check that all object files are regular files 1688 1689 Check_Context; 1690 1691 -- Delete the existing library file, if it exists. Fail if the 1692 -- library file is not writable, or if it is not possible to delete 1693 -- the file. 1694 1695 declare 1696 DLL_Name : aliased String := 1697 Lib_Dirpath.all & Directory_Separator & DLL_Prefix & 1698 Lib_Filename.all & "." & DLL_Ext; 1699 1700 Archive_Name : aliased String := 1701 Lib_Dirpath.all & Directory_Separator & "lib" & 1702 Lib_Filename.all & "." & Archive_Ext; 1703 1704 type Str_Ptr is access all String; 1705 -- This type is necessary to meet the accessibility rules of Ada. 1706 -- It is not possible to use String_Access here. 1707 1708 Full_Lib_Name : Str_Ptr; 1709 -- Designates the full library path name. Either DLL_Name or 1710 -- Archive_Name, depending on the library kind. 1711 1712 Success : Boolean; 1713 pragma Warnings (Off, Success); 1714 -- Used to call Delete_File 1715 1716 begin 1717 if The_Build_Mode = Static then 1718 Full_Lib_Name := Archive_Name'Access; 1719 else 1720 Full_Lib_Name := DLL_Name'Access; 1721 end if; 1722 1723 if Is_Regular_File (Full_Lib_Name.all) then 1724 if Is_Writable_File (Full_Lib_Name.all) then 1725 Delete_File (Full_Lib_Name.all, Success); 1726 end if; 1727 1728 if Is_Regular_File (Full_Lib_Name.all) then 1729 Com.Fail ("could not delete """ & Full_Lib_Name.all & """"); 1730 end if; 1731 end if; 1732 end; 1733 1734 Argument_Number := 0; 1735 1736 -- If we have a standalone library, gather all the interface ALI. 1737 -- They are flagged as Interface when we copy them to the library 1738 -- directory (by Copy_ALI_Files, below). 1739 1740 if Standalone then 1741 Current_Proj := For_Project; 1742 1743 declare 1744 Iface : String_List_Id := For_Project.Lib_Interface_ALIs; 1745 ALI : File_Name_Type; 1746 1747 begin 1748 while Iface /= Nil_String loop 1749 ALI := 1750 File_Name_Type 1751 (In_Tree.Shared.String_Elements.Table (Iface).Value); 1752 Interface_ALIs.Set (ALI, True); 1753 Get_Name_String 1754 (In_Tree.Shared.String_Elements.Table (Iface).Value); 1755 Add_Argument (Name_Buffer (1 .. Name_Len)); 1756 Iface := In_Tree.Shared.String_Elements.Table (Iface).Next; 1757 end loop; 1758 1759 Iface := For_Project.Lib_Interface_ALIs; 1760 1761 if not Opt.Quiet_Output then 1762 1763 -- Check that the interface set is complete: any unit in the 1764 -- library that is needed by an interface should also be an 1765 -- interface. If it is not the case, output a warning. 1766 1767 while Iface /= Nil_String loop 1768 ALI := 1769 File_Name_Type 1770 (In_Tree.Shared.String_Elements.Table (Iface).Value); 1771 Process (ALI); 1772 Iface := 1773 In_Tree.Shared.String_Elements.Table (Iface).Next; 1774 end loop; 1775 end if; 1776 end; 1777 end if; 1778 1779 declare 1780 Current_Dir : constant String := Get_Current_Dir; 1781 Dir : Dir_Type; 1782 1783 Name : String (1 .. 200); 1784 Last : Natural; 1785 1786 Disregard : Boolean; 1787 pragma Warnings (Off, Disregard); 1788 1789 DLL_Name : aliased constant String := 1790 Lib_Filename.all & "." & DLL_Ext; 1791 1792 Archive_Name : aliased constant String := 1793 Lib_Filename.all & "." & Archive_Ext; 1794 1795 Delete : Boolean := False; 1796 1797 begin 1798 -- Clean the library directory: remove any file with the name of 1799 -- the library file and any ALI file of a source of the project. 1800 1801 begin 1802 Get_Name_String (For_Project.Library_Dir.Display_Name); 1803 Change_Dir (Name_Buffer (1 .. Name_Len)); 1804 1805 exception 1806 when others => 1807 Com.Fail 1808 ("unable to access library directory """ 1809 & Name_Buffer (1 .. Name_Len) 1810 & """"); 1811 end; 1812 1813 Open (Dir, "."); 1814 1815 loop 1816 Read (Dir, Name, Last); 1817 exit when Last = 0; 1818 1819 declare 1820 Filename : constant String := Name (1 .. Last); 1821 1822 begin 1823 if Is_Regular_File (Filename) then 1824 Canonical_Case_File_Name (Name (1 .. Last)); 1825 Delete := False; 1826 1827 if (The_Build_Mode = Static 1828 and then Name (1 .. Last) = Archive_Name) 1829 or else 1830 ((The_Build_Mode = Dynamic 1831 or else 1832 The_Build_Mode = Relocatable) 1833 and then Name (1 .. Last) = DLL_Name) 1834 then 1835 Delete := True; 1836 1837 elsif Last > 4 1838 and then Name (Last - 3 .. Last) = ".ali" 1839 then 1840 declare 1841 Unit : Unit_Index; 1842 1843 begin 1844 -- Compare with ALI file names of the project 1845 1846 Unit := Units_Htable.Get_First (In_Tree.Units_HT); 1847 while Unit /= No_Unit_Index loop 1848 if Unit.File_Names (Impl) /= null 1849 and then Unit.File_Names (Impl).Project /= 1850 No_Project 1851 then 1852 if Ultimate_Extending_Project_Of 1853 (Unit.File_Names (Impl).Project) = 1854 For_Project 1855 then 1856 Get_Name_String 1857 (Unit.File_Names (Impl).File); 1858 Name_Len := 1859 Name_Len - 1860 File_Extension 1861 (Name (1 .. Name_Len))'Length; 1862 1863 if Name_Buffer (1 .. Name_Len) = 1864 Name (1 .. Last - 4) 1865 then 1866 Delete := True; 1867 exit; 1868 end if; 1869 end if; 1870 1871 elsif Unit.File_Names (Spec) /= null 1872 and then Ultimate_Extending_Project_Of 1873 (Unit.File_Names (Spec).Project) = 1874 For_Project 1875 then 1876 Get_Name_String (Unit.File_Names (Spec).File); 1877 Name_Len := 1878 Name_Len - 1879 File_Extension (Name (1 .. Last))'Length; 1880 1881 if Name_Buffer (1 .. Name_Len) = 1882 Name (1 .. Last - 4) 1883 then 1884 Delete := True; 1885 exit; 1886 end if; 1887 end if; 1888 1889 Unit := Units_Htable.Get_Next (In_Tree.Units_HT); 1890 end loop; 1891 end; 1892 end if; 1893 1894 if Delete then 1895 Set_Writable (Filename); 1896 Delete_File (Filename, Disregard); 1897 end if; 1898 end if; 1899 end; 1900 end loop; 1901 1902 Close (Dir); 1903 1904 Change_Dir (Current_Dir); 1905 end; 1906 1907 -- Call procedure to build the library, depending on the build mode 1908 1909 case The_Build_Mode is 1910 when Dynamic | Relocatable => 1911 Build_Dynamic_Library 1912 (Ofiles => Object_Files.all, 1913 Options => Options.all, 1914 Interfaces => Arguments (1 .. Argument_Number), 1915 Lib_Filename => Lib_Filename.all, 1916 Lib_Dir => Lib_Dirpath.all, 1917 Symbol_Data => Current_Proj.Symbol_Data, 1918 Driver_Name => Driver_Name, 1919 Lib_Version => Lib_Version.all, 1920 Auto_Init => Current_Proj.Lib_Auto_Init); 1921 1922 when Static => 1923 MLib.Build_Library 1924 (Object_Files.all, 1925 Lib_Filename.all, 1926 Lib_Dirpath.all); 1927 1928 when None => 1929 null; 1930 end case; 1931 1932 -- We need to copy the ALI files from the object directory to the 1933 -- library ALI directory, so that the linker find them there, and 1934 -- does not need to look in the object directory where it would also 1935 -- find the object files; and we don't want that: we want the linker 1936 -- to use the library. 1937 1938 -- Copy the ALI files and make the copies read-only. For interfaces, 1939 -- mark the copies as interfaces. 1940 1941 Copy_ALI_Files 1942 (Files => Ali_Files.all, 1943 To => For_Project.Library_ALI_Dir.Display_Name, 1944 Interfaces => Arguments (1 .. Argument_Number)); 1945 1946 -- Copy interface sources if Library_Src_Dir specified 1947 1948 if Standalone 1949 and then For_Project.Library_Src_Dir /= No_Path_Information 1950 then 1951 -- Clean the interface copy directory: remove any source that 1952 -- could be a source of the project. 1953 1954 begin 1955 Get_Name_String (For_Project.Library_Src_Dir.Display_Name); 1956 Change_Dir (Name_Buffer (1 .. Name_Len)); 1957 1958 exception 1959 when others => 1960 Com.Fail 1961 ("unable to access library source copy directory """ 1962 & Name_Buffer (1 .. Name_Len) 1963 & """"); 1964 end; 1965 1966 declare 1967 Dir : Dir_Type; 1968 Delete : Boolean := False; 1969 Unit : Unit_Index; 1970 1971 Name : String (1 .. 200); 1972 Last : Natural; 1973 1974 Disregard : Boolean; 1975 pragma Warnings (Off, Disregard); 1976 1977 begin 1978 Open (Dir, "."); 1979 1980 loop 1981 Read (Dir, Name, Last); 1982 exit when Last = 0; 1983 1984 if Is_Regular_File (Name (1 .. Last)) then 1985 Canonical_Case_File_Name (Name (1 .. Last)); 1986 Delete := False; 1987 1988 -- Compare with source file names of the project 1989 1990 Unit := Units_Htable.Get_First (In_Tree.Units_HT); 1991 while Unit /= No_Unit_Index loop 1992 if Unit.File_Names (Impl) /= null 1993 and then Ultimate_Extending_Project_Of 1994 (Unit.File_Names (Impl).Project) = For_Project 1995 and then 1996 Get_Name_String 1997 (Unit.File_Names (Impl).File) = 1998 Name (1 .. Last) 1999 then 2000 Delete := True; 2001 exit; 2002 end if; 2003 2004 if Unit.File_Names (Spec) /= null 2005 and then Ultimate_Extending_Project_Of 2006 (Unit.File_Names (Spec).Project) = 2007 For_Project 2008 and then 2009 Get_Name_String 2010 (Unit.File_Names (Spec).File) = 2011 Name (1 .. Last) 2012 then 2013 Delete := True; 2014 exit; 2015 end if; 2016 2017 Unit := Units_Htable.Get_Next (In_Tree.Units_HT); 2018 end loop; 2019 end if; 2020 2021 if Delete then 2022 Set_Writable (Name (1 .. Last)); 2023 Delete_File (Name (1 .. Last), Disregard); 2024 end if; 2025 end loop; 2026 2027 Close (Dir); 2028 end; 2029 2030 Copy_Interface_Sources 2031 (For_Project => For_Project, 2032 In_Tree => In_Tree, 2033 Interfaces => Arguments (1 .. Argument_Number), 2034 To_Dir => For_Project.Library_Src_Dir.Display_Name); 2035 end if; 2036 end if; 2037 2038 -- Reset the current working directory to its previous value 2039 2040 Change_Dir (Current_Dir); 2041 end Build_Library; 2042 2043 ----------- 2044 -- Check -- 2045 ----------- 2046 2047 procedure Check (Filename : String) is 2048 begin 2049 if not Is_Regular_File (Filename) then 2050 Com.Fail (Filename & " not found."); 2051 end if; 2052 end Check; 2053 2054 ------------------- 2055 -- Check_Context -- 2056 ------------------- 2057 2058 procedure Check_Context is 2059 begin 2060 -- Check that each object file exists 2061 2062 for F in Object_Files'Range loop 2063 Check (Object_Files (F).all); 2064 end loop; 2065 end Check_Context; 2066 2067 ------------------- 2068 -- Check_Library -- 2069 ------------------- 2070 2071 procedure Check_Library 2072 (For_Project : Project_Id; In_Tree : Project_Tree_Ref) 2073 is 2074 Lib_TS : Time_Stamp_Type; 2075 Current : constant Dir_Name_Str := Get_Current_Dir; 2076 2077 begin 2078 -- No need to build the library if there is no object directory, 2079 -- hence no object files to build the library. 2080 2081 if For_Project.Library then 2082 declare 2083 Lib_Name : constant File_Name_Type := 2084 Library_File_Name_For (For_Project, In_Tree); 2085 begin 2086 Change_Dir 2087 (Get_Name_String (For_Project.Library_Dir.Display_Name)); 2088 Lib_TS := File_Stamp (Lib_Name); 2089 For_Project.Library_TS := Lib_TS; 2090 end; 2091 2092 if not For_Project.Externally_Built 2093 and then not For_Project.Need_To_Build_Lib 2094 and then For_Project.Object_Directory /= No_Path_Information 2095 then 2096 declare 2097 Obj_TS : Time_Stamp_Type; 2098 Object_Dir : Dir_Type; 2099 2100 begin 2101 -- If the library file does not exist, then the time stamp will 2102 -- be Empty_Time_Stamp, earlier than any other time stamp. 2103 2104 Change_Dir 2105 (Get_Name_String (For_Project.Object_Directory.Display_Name)); 2106 Open (Dir => Object_Dir, Dir_Name => "."); 2107 2108 -- For all entries in the object directory 2109 2110 loop 2111 Read (Object_Dir, Name_Buffer, Name_Len); 2112 exit when Name_Len = 0; 2113 2114 -- Check if it is an object file, but ignore any binder 2115 -- generated file. 2116 2117 if Is_Obj (Name_Buffer (1 .. Name_Len)) 2118 and then Name_Buffer (1 .. B_Start'Length) /= B_Start 2119 then 2120 -- Get the object file time stamp 2121 2122 Obj_TS := File_Stamp (File_Name_Type'(Name_Find)); 2123 2124 -- If library file time stamp is earlier, set 2125 -- Need_To_Build_Lib and return. String comparison is 2126 -- used, otherwise time stamps may be too close and the 2127 -- comparison would return True, which would trigger 2128 -- an unnecessary rebuild of the library. 2129 2130 if String (Lib_TS) < String (Obj_TS) then 2131 2132 -- Library must be rebuilt 2133 2134 For_Project.Need_To_Build_Lib := True; 2135 exit; 2136 end if; 2137 end if; 2138 end loop; 2139 2140 Close (Object_Dir); 2141 end; 2142 end if; 2143 2144 Change_Dir (Current); 2145 end if; 2146 end Check_Library; 2147 2148 ---------------------------- 2149 -- Copy_Interface_Sources -- 2150 ---------------------------- 2151 2152 procedure Copy_Interface_Sources 2153 (For_Project : Project_Id; 2154 In_Tree : Project_Tree_Ref; 2155 Interfaces : Argument_List; 2156 To_Dir : Path_Name_Type) 2157 is 2158 Current : constant Dir_Name_Str := Get_Current_Dir; 2159 -- The current directory, where to return to at the end 2160 2161 Target : constant Dir_Name_Str := Get_Name_String (To_Dir); 2162 -- The directory where to copy sources 2163 2164 Text : Text_Buffer_Ptr; 2165 The_ALI : ALI.ALI_Id; 2166 Lib_File : File_Name_Type; 2167 2168 First_Unit : ALI.Unit_Id; 2169 Second_Unit : ALI.Unit_Id; 2170 2171 Copy_Subunits : Boolean := False; 2172 -- When True, indicates that subunits, if any, need to be copied too 2173 2174 procedure Copy (File_Name : File_Name_Type); 2175 -- Copy one source of the project to the target directory 2176 2177 ---------- 2178 -- Copy -- 2179 ---------- 2180 2181 procedure Copy (File_Name : File_Name_Type) is 2182 Success : Boolean; 2183 pragma Warnings (Off, Success); 2184 2185 Source : Standard.Prj.Source_Id; 2186 begin 2187 Source := Find_Source 2188 (In_Tree, For_Project, 2189 In_Extended_Only => True, 2190 Base_Name => File_Name); 2191 2192 if Source /= No_Source 2193 and then not Source.Locally_Removed 2194 and then Source.Replaced_By = No_Source 2195 then 2196 Copy_File 2197 (Get_Name_String (Source.Path.Name), 2198 Target, 2199 Success, 2200 Mode => Overwrite, 2201 Preserve => Preserve); 2202 end if; 2203 end Copy; 2204 2205 -- Start of processing for Copy_Interface_Sources 2206 2207 begin 2208 -- Change the working directory to the object directory 2209 2210 Change_Dir (Get_Name_String (For_Project.Object_Directory.Display_Name)); 2211 2212 for Index in Interfaces'Range loop 2213 2214 -- First, load the ALI file 2215 2216 Name_Len := 0; 2217 Add_Str_To_Name_Buffer (Interfaces (Index).all); 2218 Lib_File := Name_Find; 2219 Text := Read_Library_Info (Lib_File); 2220 The_ALI := Scan_ALI (Lib_File, Text, Ignore_ED => False, Err => True); 2221 Free (Text); 2222 2223 Second_Unit := No_Unit_Id; 2224 First_Unit := ALI.ALIs.Table (The_ALI).First_Unit; 2225 Copy_Subunits := True; 2226 2227 -- If there is both a spec and a body, check if they are both needed 2228 2229 if ALI.Units.Table (First_Unit).Utype = Is_Body then 2230 Second_Unit := ALI.ALIs.Table (The_ALI).Last_Unit; 2231 2232 -- If the body is not needed, then reset First_Unit 2233 2234 if not ALI.Units.Table (Second_Unit).Body_Needed_For_SAL then 2235 First_Unit := No_Unit_Id; 2236 Copy_Subunits := False; 2237 end if; 2238 2239 elsif ALI.Units.Table (First_Unit).Utype = Is_Spec_Only then 2240 Copy_Subunits := False; 2241 end if; 2242 2243 -- Copy the file(s) that need to be copied 2244 2245 if First_Unit /= No_Unit_Id then 2246 Copy (File_Name => ALI.Units.Table (First_Unit).Sfile); 2247 end if; 2248 2249 if Second_Unit /= No_Unit_Id then 2250 Copy (File_Name => ALI.Units.Table (Second_Unit).Sfile); 2251 end if; 2252 2253 -- Copy all the separates, if any 2254 2255 if Copy_Subunits then 2256 for Dep in ALI.ALIs.Table (The_ALI).First_Sdep .. 2257 ALI.ALIs.Table (The_ALI).Last_Sdep 2258 loop 2259 if Sdep.Table (Dep).Subunit_Name /= No_Name then 2260 Copy (File_Name => Sdep.Table (Dep).Sfile); 2261 end if; 2262 end loop; 2263 end if; 2264 end loop; 2265 2266 -- Restore the initial working directory 2267 2268 Change_Dir (Current); 2269 end Copy_Interface_Sources; 2270 2271 ------------- 2272 -- Display -- 2273 ------------- 2274 2275 procedure Display (Executable : String) is 2276 begin 2277 if not Opt.Quiet_Output then 2278 Write_Str (Executable); 2279 2280 for Index in 1 .. Argument_Number loop 2281 Write_Char (' '); 2282 Write_Str (Arguments (Index).all); 2283 2284 if not Opt.Verbose_Mode and then Index > 4 then 2285 Write_Str (" ..."); 2286 exit; 2287 end if; 2288 end loop; 2289 2290 Write_Eol; 2291 end if; 2292 end Display; 2293 2294 ----------- 2295 -- Index -- 2296 ----------- 2297 2298 function Index (S, Pattern : String) return Natural is 2299 Len : constant Natural := Pattern'Length; 2300 2301 begin 2302 for J in reverse S'First .. S'Last - Len + 1 loop 2303 if Pattern = S (J .. J + Len - 1) then 2304 return J; 2305 end if; 2306 end loop; 2307 2308 return 0; 2309 end Index; 2310 2311 ------------------------- 2312 -- Process_Binder_File -- 2313 ------------------------- 2314 2315 procedure Process_Binder_File (Name : String) is 2316 Fd : FILEs; 2317 -- Binder file's descriptor 2318 2319 Read_Mode : constant String := "r" & ASCII.NUL; 2320 -- For fopen 2321 2322 Status : Interfaces.C_Streams.int; 2323 pragma Unreferenced (Status); 2324 -- For fclose 2325 2326 Begin_Info : constant String := "-- BEGIN Object file/option list"; 2327 End_Info : constant String := "-- END Object file/option list "; 2328 2329 Next_Line : String (1 .. 1000); 2330 -- Current line value 2331 -- Where does this odd constant 1000 come from, looks suspicious ??? 2332 2333 Nlast : Integer; 2334 -- End of line slice (the slice does not contain the line terminator) 2335 2336 procedure Get_Next_Line; 2337 -- Read the next line from the binder file without the line terminator 2338 2339 ------------------- 2340 -- Get_Next_Line -- 2341 ------------------- 2342 2343 procedure Get_Next_Line is 2344 Fchars : chars; 2345 2346 begin 2347 Fchars := fgets (Next_Line'Address, Next_Line'Length, Fd); 2348 2349 if Fchars = System.Null_Address then 2350 Fail ("Error reading binder output"); 2351 end if; 2352 2353 Nlast := 1; 2354 while Nlast <= Next_Line'Last 2355 and then Next_Line (Nlast) /= ASCII.LF 2356 and then Next_Line (Nlast) /= ASCII.CR 2357 loop 2358 Nlast := Nlast + 1; 2359 end loop; 2360 2361 Nlast := Nlast - 1; 2362 end Get_Next_Line; 2363 2364 -- Start of processing for Process_Binder_File 2365 2366 begin 2367 Fd := fopen (Name'Address, Read_Mode'Address); 2368 2369 if Fd = NULL_Stream then 2370 Fail ("Failed to open binder output"); 2371 end if; 2372 2373 -- Skip up to the Begin Info line 2374 2375 loop 2376 Get_Next_Line; 2377 exit when Next_Line (1 .. Nlast) = Begin_Info; 2378 end loop; 2379 2380 -- Find the first switch 2381 2382 loop 2383 Get_Next_Line; 2384 2385 exit when Next_Line (1 .. Nlast) = End_Info; 2386 2387 -- As the binder generated file is in Ada, remove the first eight 2388 -- characters " -- ". 2389 2390 Next_Line (1 .. Nlast - 8) := Next_Line (9 .. Nlast); 2391 Nlast := Nlast - 8; 2392 2393 -- Stop when the first switch is found 2394 2395 exit when Next_Line (1) = '-'; 2396 end loop; 2397 2398 if Next_Line (1 .. Nlast) /= End_Info then 2399 loop 2400 -- Ignore -static and -shared, since -shared will be used 2401 -- in any case. 2402 2403 -- Ignore -lgnat and -lgnarl as they will be added later, 2404 -- because they are also needed for non Stand-Alone shared 2405 -- libraries. 2406 2407 -- Also ignore the shared libraries which are: 2408 2409 -- -lgnat-<version> (7 + version'length chars) 2410 -- -lgnarl-<version> (8 + version'length chars) 2411 2412 if Next_Line (1 .. Nlast) /= "-static" and then 2413 Next_Line (1 .. Nlast) /= "-shared" and then 2414 Next_Line (1 .. Nlast) /= "-lgnarl" and then 2415 Next_Line (1 .. Nlast) /= "-lgnat" 2416 and then 2417 Next_Line 2418 (1 .. Natural'Min (Nlast, 8 + Library_Version'Length)) /= 2419 Shared_Lib ("gnarl") 2420 and then 2421 Next_Line 2422 (1 .. Natural'Min (Nlast, 7 + Library_Version'Length)) /= 2423 Shared_Lib ("gnat") 2424 then 2425 if Next_Line (1) /= '-' then 2426 2427 -- This is not an option, should we add it? 2428 2429 if Add_Object_Files then 2430 Opts.Increment_Last; 2431 Opts.Table (Opts.Last) := 2432 new String'(Next_Line (1 .. Nlast)); 2433 end if; 2434 2435 else 2436 -- Add all other options 2437 2438 Opts.Increment_Last; 2439 Opts.Table (Opts.Last) := 2440 new String'(Next_Line (1 .. Nlast)); 2441 end if; 2442 end if; 2443 2444 -- Next option, if any 2445 2446 Get_Next_Line; 2447 exit when Next_Line (1 .. Nlast) = End_Info; 2448 2449 -- Remove first eight characters " -- " 2450 2451 Next_Line (1 .. Nlast - 8) := Next_Line (9 .. Nlast); 2452 Nlast := Nlast - 8; 2453 end loop; 2454 end if; 2455 2456 Status := fclose (Fd); 2457 2458 -- Is it really right to ignore any close error ??? 2459 2460 end Process_Binder_File; 2461 2462 ------------------ 2463 -- Reset_Tables -- 2464 ------------------ 2465 2466 procedure Reset_Tables is 2467 begin 2468 Objects.Init; 2469 Objects_Htable.Reset; 2470 ALIs.Init; 2471 Opts.Init; 2472 Processed_Projects.Reset; 2473 Library_Projs.Init; 2474 end Reset_Tables; 2475 2476 --------------------------- 2477 -- SALs_Use_Constructors -- 2478 --------------------------- 2479 2480 function SALs_Use_Constructors return Boolean is 2481 function C_SALs_Init_Using_Constructors return Integer; 2482 pragma Import (C, C_SALs_Init_Using_Constructors, 2483 "__gnat_sals_init_using_constructors"); 2484 begin 2485 return C_SALs_Init_Using_Constructors /= 0; 2486 end SALs_Use_Constructors; 2487 2488end MLib.Prj; 2489