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