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