1------------------------------------------------------------------------------ 2-- -- 3-- GNAT COMPILER COMPONENTS -- 4-- -- 5-- G N A T L I N K -- 6-- -- 7-- B o d y -- 8-- -- 9-- Copyright (C) 1996-2013, Free Software Foundation, Inc. -- 10-- -- 11-- GNAT is free software; you can redistribute it and/or modify it under -- 12-- terms of the GNU General Public License as published by the Free Soft- -- 13-- ware Foundation; either version 3, or (at your option) any later ver- -- 14-- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- 15-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- 16-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- 17-- for more details. You should have received a copy of the GNU General -- 18-- Public License distributed with GNAT; see file COPYING3. If not, go to -- 19-- http://www.gnu.org/licenses for a complete copy of the license. -- 20-- -- 21-- GNAT was originally developed by the GNAT team at New York University. -- 22-- Extensive contributions were provided by Ada Core Technologies Inc. -- 23-- -- 24------------------------------------------------------------------------------ 25 26-- Gnatlink usage: please consult the gnat documentation 27 28with ALI; use ALI; 29with Csets; 30with Gnatvsn; use Gnatvsn; 31with Hostparm; 32with Indepsw; use Indepsw; 33with Namet; use Namet; 34with Opt; 35with Osint; use Osint; 36with Output; use Output; 37with Snames; 38with Switch; use Switch; 39with System; use System; 40with Table; 41with Targparm; use Targparm; 42with Types; 43 44with Ada.Command_Line; use Ada.Command_Line; 45with Ada.Exceptions; use Ada.Exceptions; 46 47with System.OS_Lib; use System.OS_Lib; 48with System.CRTL; 49 50with Interfaces.C_Streams; use Interfaces.C_Streams; 51with Interfaces.C.Strings; use Interfaces.C.Strings; 52 53procedure Gnatlink is 54 pragma Ident (Gnatvsn.Gnat_Static_Version_String); 55 56 Shared_Libgcc_String : constant String := "-shared-libgcc"; 57 Shared_Libgcc : constant String_Access := 58 new String'(Shared_Libgcc_String); 59 -- Used to invoke gcc when the binder is invoked with -shared 60 61 Static_Libgcc_String : constant String := "-static-libgcc"; 62 Static_Libgcc : constant String_Access := 63 new String'(Static_Libgcc_String); 64 -- Used to invoke gcc when shared libs are not used 65 66 package Gcc_Linker_Options is new Table.Table ( 67 Table_Component_Type => String_Access, 68 Table_Index_Type => Integer, 69 Table_Low_Bound => 1, 70 Table_Initial => 20, 71 Table_Increment => 100, 72 Table_Name => "Gnatlink.Gcc_Linker_Options"); 73 -- Comments needed ??? 74 75 package Libpath is new Table.Table ( 76 Table_Component_Type => Character, 77 Table_Index_Type => Integer, 78 Table_Low_Bound => 1, 79 Table_Initial => 4096, 80 Table_Increment => 100, 81 Table_Name => "Gnatlink.Libpath"); 82 -- Comments needed ??? 83 84 package Linker_Options is new Table.Table ( 85 Table_Component_Type => String_Access, 86 Table_Index_Type => Integer, 87 Table_Low_Bound => 1, 88 Table_Initial => 20, 89 Table_Increment => 100, 90 Table_Name => "Gnatlink.Linker_Options"); 91 -- Comments needed ??? 92 93 package Linker_Objects is new Table.Table ( 94 Table_Component_Type => String_Access, 95 Table_Index_Type => Integer, 96 Table_Low_Bound => 1, 97 Table_Initial => 20, 98 Table_Increment => 100, 99 Table_Name => "Gnatlink.Linker_Objects"); 100 -- This table collects the objects file to be passed to the linker. In the 101 -- case where the linker command line is too long then programs objects 102 -- are put on the Response_File_Objects table. Note that the binder object 103 -- file and the user's objects remain in this table. This is very 104 -- important because on the GNU linker command line the -L switch is not 105 -- used to look for objects files but -L switch is used to look for 106 -- objects listed in the response file. This is not a problem with the 107 -- applications objects as they are specified with a full name. 108 109 package Response_File_Objects is new Table.Table ( 110 Table_Component_Type => String_Access, 111 Table_Index_Type => Integer, 112 Table_Low_Bound => 1, 113 Table_Initial => 20, 114 Table_Increment => 100, 115 Table_Name => "Gnatlink.Response_File_Objects"); 116 -- This table collects the objects file that are to be put in the response 117 -- file. Only application objects are collected there (see details in 118 -- Linker_Objects table comments) 119 120 package Binder_Options_From_ALI is new Table.Table ( 121 Table_Component_Type => String_Access, 122 Table_Index_Type => Integer, 123 Table_Low_Bound => 1, -- equals low bound of Argument_List for Spawn 124 Table_Initial => 20, 125 Table_Increment => 100, 126 Table_Name => "Gnatlink.Binder_Options_From_ALI"); 127 -- This table collects the switches from the ALI file of the main 128 -- subprogram. 129 130 package Binder_Options is new Table.Table ( 131 Table_Component_Type => String_Access, 132 Table_Index_Type => Integer, 133 Table_Low_Bound => 1, -- equals low bound of Argument_List for Spawn 134 Table_Initial => 20, 135 Table_Increment => 100, 136 Table_Name => "Gnatlink.Binder_Options"); 137 -- This table collects the arguments to be passed to compile the binder 138 -- generated file. 139 140 Gcc : String_Access := Program_Name ("gcc", "gnatlink"); 141 142 Read_Mode : constant String := "r" & ASCII.NUL; 143 144 Begin_Info : constant String := "-- BEGIN Object file/option list"; 145 End_Info : constant String := "-- END Object file/option list "; 146 147 Gcc_Path : String_Access; 148 Linker_Path : String_Access; 149 Output_File_Name : String_Access; 150 Ali_File_Name : String_Access; 151 Binder_Spec_Src_File : String_Access; 152 Binder_Body_Src_File : String_Access; 153 Binder_Ali_File : String_Access; 154 Binder_Obj_File : String_Access; 155 156 Base_Command_Name : String_Access; 157 158 Tname : Temp_File_Name; 159 Tname_FD : File_Descriptor := Invalid_FD; 160 -- Temporary file used by linker to pass list of object files on 161 -- certain systems with limitations on size of arguments. 162 163 Debug_Flag_Present : Boolean := False; 164 Verbose_Mode : Boolean := False; 165 Very_Verbose_Mode : Boolean := False; 166 167 Standard_Gcc : Boolean := True; 168 169 Compile_Bind_File : Boolean := True; 170 -- Set to False if bind file is not to be compiled 171 172 Create_Map_File : Boolean := False; 173 -- Set to True by switch -M. The map file name is derived from 174 -- the ALI file name (mainprog.ali => mainprog.map). 175 176 Object_List_File_Supported : Boolean; 177 for Object_List_File_Supported'Size use Character'Size; 178 pragma Import 179 (C, Object_List_File_Supported, "__gnat_objlist_file_supported"); 180 -- Predicate indicating whether the linker has an option whereby the 181 -- names of object files can be passed to the linker in a file. 182 183 Object_File_Option_Ptr : Interfaces.C.Strings.chars_ptr; 184 pragma Import (C, Object_File_Option_Ptr, "__gnat_object_file_option"); 185 -- Pointer to a string representing the linker option which specifies 186 -- the response file. 187 188 Object_File_Option : constant String := Value (Object_File_Option_Ptr); 189 -- The linker option which specifies the response file as a string 190 191 Using_GNU_response_file : constant Boolean := 192 Object_File_Option'Length > 0 193 and then Object_File_Option (Object_File_Option'Last) = '@'; 194 -- Whether a GNU response file is used 195 196 Object_List_File_Required : Boolean := False; 197 -- Set to True to force generation of a response file 198 199 Shared_Libgcc_Default : Character; 200 for Shared_Libgcc_Default'Size use Character'Size; 201 pragma Import 202 (C, Shared_Libgcc_Default, "__gnat_shared_libgcc_default"); 203 -- Indicates wether libgcc should be statically linked (use 'T') or 204 -- dynamically linked (use 'H') by default. 205 206 function Base_Name (File_Name : String) return String; 207 -- Return just the file name part without the extension (if present) 208 209 procedure Check_Existing_Executable (File_Name : String); 210 -- Delete any existing executable to avoid accidentally updating the target 211 -- of a symbolic link, but produce a Fatail_Error if File_Name matches any 212 -- of the source file names. This avoids overwriting of extensionless 213 -- source files by accident on systems where executables do not have 214 -- extensions. 215 216 procedure Delete (Name : String); 217 -- Wrapper to unlink as status is ignored by this application 218 219 procedure Error_Msg (Message : String); 220 -- Output the error or warning Message 221 222 procedure Exit_With_Error (Error : String); 223 -- Output Error and exit program with a fatal condition 224 225 procedure Process_Args; 226 -- Go through all the arguments and build option tables 227 228 procedure Process_Binder_File (Name : String); 229 -- Reads the binder file and extracts linker arguments 230 231 function To_Lower (A : Character) return Character; 232 -- Fold a character to lower case; 233 234 procedure To_Lower (A : in out String); 235 -- Fold a string to lower case; 236 237 procedure Usage; 238 -- Display usage 239 240 procedure Write_Header; 241 -- Show user the program name, version and copyright 242 243 procedure Write_Usage; 244 -- Show user the program options 245 246 --------------- 247 -- Base_Name -- 248 --------------- 249 250 function Base_Name (File_Name : String) return String is 251 Findex1 : Natural; 252 Findex2 : Natural; 253 254 begin 255 Findex1 := File_Name'First; 256 257 -- The file might be specified by a full path name. However, 258 -- we want the path to be stripped away. 259 260 for J in reverse File_Name'Range loop 261 if Is_Directory_Separator (File_Name (J)) then 262 Findex1 := J + 1; 263 exit; 264 end if; 265 end loop; 266 267 Findex2 := File_Name'Last; 268 while Findex2 > Findex1 and then File_Name (Findex2) /= '.' loop 269 Findex2 := Findex2 - 1; 270 end loop; 271 272 if Findex2 = Findex1 then 273 Findex2 := File_Name'Last + 1; 274 end if; 275 276 return File_Name (Findex1 .. Findex2 - 1); 277 end Base_Name; 278 279 ------------------------------- 280 -- Check_Existing_Executable -- 281 ------------------------------- 282 283 procedure Check_Existing_Executable (File_Name : String) is 284 Ename : String := File_Name; 285 Efile : File_Name_Type; 286 Sfile : File_Name_Type; 287 288 begin 289 Canonical_Case_File_Name (Ename); 290 Name_Len := 0; 291 Add_Str_To_Name_Buffer (Ename); 292 Efile := Name_Find; 293 294 for J in Units.Table'First .. Units.Last loop 295 Sfile := Units.Table (J).Sfile; 296 if Sfile = Efile then 297 Exit_With_Error 298 ("executable name """ & File_Name & """ matches " 299 & "source file name """ & Get_Name_String (Sfile) & """"); 300 end if; 301 end loop; 302 303 Delete (File_Name); 304 end Check_Existing_Executable; 305 306 ------------ 307 -- Delete -- 308 ------------ 309 310 procedure Delete (Name : String) is 311 Status : int; 312 pragma Unreferenced (Status); 313 begin 314 Status := unlink (Name'Address); 315 -- Is it really right to ignore an error here ??? 316 end Delete; 317 318 --------------- 319 -- Error_Msg -- 320 --------------- 321 322 procedure Error_Msg (Message : String) is 323 begin 324 Write_Str (Base_Command_Name.all); 325 Write_Str (": "); 326 Write_Str (Message); 327 Write_Eol; 328 end Error_Msg; 329 330 --------------------- 331 -- Exit_With_Error -- 332 --------------------- 333 334 procedure Exit_With_Error (Error : String) is 335 begin 336 Error_Msg (Error); 337 Exit_Program (E_Fatal); 338 end Exit_With_Error; 339 340 ------------------ 341 -- Process_Args -- 342 ------------------ 343 344 procedure Process_Args is 345 Next_Arg : Integer; 346 347 Skip_Next : Boolean := False; 348 -- Set to true if the next argument is to be added into the list of 349 -- linker's argument without parsing it. 350 351 procedure Check_Version_And_Help is new Check_Version_And_Help_G (Usage); 352 353 -- Start of processing for Process_Args 354 355 begin 356 -- First, check for --version and --help 357 358 Check_Version_And_Help ("GNATLINK", "1996"); 359 360 -- Loop through arguments of gnatlink command 361 362 Next_Arg := 1; 363 loop 364 exit when Next_Arg > Argument_Count; 365 366 Process_One_Arg : declare 367 Arg : constant String := Argument (Next_Arg); 368 369 begin 370 -- Case of argument which is a switch 371 372 -- We definitely need section by section comments here ??? 373 374 if Skip_Next then 375 376 -- This argument must not be parsed, just add it to the 377 -- list of linker's options. 378 379 Skip_Next := False; 380 381 Linker_Options.Increment_Last; 382 Linker_Options.Table (Linker_Options.Last) := 383 new String'(Arg); 384 385 elsif Arg'Length /= 0 and then Arg (1) = '-' then 386 if Arg'Length > 4 and then Arg (2 .. 5) = "gnat" then 387 Exit_With_Error 388 ("invalid switch: """ & Arg & """ (gnat not needed here)"); 389 end if; 390 391 if Arg = "-Xlinker" then 392 393 -- Next argument should be sent directly to the linker. 394 -- We do not want to parse it here. 395 396 Skip_Next := True; 397 398 Linker_Options.Increment_Last; 399 Linker_Options.Table (Linker_Options.Last) := 400 new String'(Arg); 401 402 elsif Arg (2) = 'g' 403 and then (Arg'Length < 5 or else Arg (2 .. 5) /= "gnat") 404 then 405 Debug_Flag_Present := True; 406 407 Linker_Options.Increment_Last; 408 Linker_Options.Table (Linker_Options.Last) := 409 new String'(Arg); 410 411 Binder_Options.Increment_Last; 412 Binder_Options.Table (Binder_Options.Last) := 413 Linker_Options.Table (Linker_Options.Last); 414 415 elsif Arg'Length >= 3 and then Arg (2) = 'M' then 416 declare 417 Switches : String_List_Access; 418 419 begin 420 Convert (Map_File, Arg (3 .. Arg'Last), Switches); 421 422 if Switches /= null then 423 for J in Switches'Range loop 424 Linker_Options.Increment_Last; 425 Linker_Options.Table (Linker_Options.Last) := 426 Switches (J); 427 end loop; 428 end if; 429 end; 430 431 elsif Arg'Length = 2 then 432 case Arg (2) is 433 when 'b' => 434 Linker_Options.Increment_Last; 435 Linker_Options.Table (Linker_Options.Last) := 436 new String'(Arg); 437 438 Binder_Options.Increment_Last; 439 Binder_Options.Table (Binder_Options.Last) := 440 Linker_Options.Table (Linker_Options.Last); 441 442 Next_Arg := Next_Arg + 1; 443 444 if Next_Arg > Argument_Count then 445 Exit_With_Error ("Missing argument for -b"); 446 end if; 447 448 Get_Machine_Name : declare 449 Name_Arg : constant String_Access := 450 new String'(Argument (Next_Arg)); 451 452 begin 453 Linker_Options.Increment_Last; 454 Linker_Options.Table (Linker_Options.Last) := 455 Name_Arg; 456 457 Binder_Options.Increment_Last; 458 Binder_Options.Table (Binder_Options.Last) := 459 Name_Arg; 460 461 end Get_Machine_Name; 462 463 when 'f' => 464 if Object_List_File_Supported then 465 Object_List_File_Required := True; 466 else 467 Exit_With_Error 468 ("Object list file not supported on this target"); 469 end if; 470 471 when 'M' => 472 Create_Map_File := True; 473 474 when 'n' => 475 Compile_Bind_File := False; 476 477 when 'o' => 478 Next_Arg := Next_Arg + 1; 479 480 if Next_Arg > Argument_Count then 481 Exit_With_Error ("Missing argument for -o"); 482 end if; 483 484 Output_File_Name := 485 new String'(Executable_Name 486 (Argument (Next_Arg), 487 Only_If_No_Suffix => True)); 488 489 when 'P' => 490 Opt.CodePeer_Mode := True; 491 492 when 'R' => 493 Opt.Run_Path_Option := False; 494 495 when 'v' => 496 497 -- Support "double" verbose mode. Second -v 498 -- gets sent to the linker and binder phases. 499 500 if Verbose_Mode then 501 Very_Verbose_Mode := True; 502 503 Linker_Options.Increment_Last; 504 Linker_Options.Table (Linker_Options.Last) := 505 new String'(Arg); 506 507 Binder_Options.Increment_Last; 508 Binder_Options.Table (Binder_Options.Last) := 509 Linker_Options.Table (Linker_Options.Last); 510 511 else 512 Verbose_Mode := True; 513 514 end if; 515 516 when others => 517 Linker_Options.Increment_Last; 518 Linker_Options.Table (Linker_Options.Last) := 519 new String'(Arg); 520 521 end case; 522 523 elsif Arg (2) = 'B' then 524 Linker_Options.Increment_Last; 525 Linker_Options.Table (Linker_Options.Last) := 526 new String'(Arg); 527 528 Binder_Options.Increment_Last; 529 Binder_Options.Table (Binder_Options.Last) := 530 Linker_Options.Table (Linker_Options.Last); 531 532 elsif Arg'Length >= 7 and then Arg (1 .. 7) = "--LINK=" then 533 if Arg'Length = 7 then 534 Exit_With_Error ("Missing argument for --LINK="); 535 end if; 536 537 Linker_Path := 538 System.OS_Lib.Locate_Exec_On_Path (Arg (8 .. Arg'Last)); 539 540 if Linker_Path = null then 541 Exit_With_Error 542 ("Could not locate linker: " & Arg (8 .. Arg'Last)); 543 end if; 544 545 elsif Arg'Length > 6 and then Arg (1 .. 6) = "--GCC=" then 546 declare 547 Program_Args : constant Argument_List_Access := 548 Argument_String_To_List 549 (Arg (7 .. Arg'Last)); 550 551 begin 552 if Program_Args.all (1).all /= Gcc.all then 553 Gcc := new String'(Program_Args.all (1).all); 554 Standard_Gcc := False; 555 end if; 556 557 -- Set appropriate flags for switches passed 558 559 for J in 2 .. Program_Args.all'Last loop 560 declare 561 Arg : constant String := Program_Args.all (J).all; 562 AF : constant Integer := Arg'First; 563 564 begin 565 if Arg'Length /= 0 and then Arg (AF) = '-' then 566 if Arg (AF + 1) = 'g' 567 and then (Arg'Length = 2 568 or else Arg (AF + 2) in '0' .. '3' 569 or else Arg (AF + 2 .. Arg'Last) = "coff") 570 then 571 Debug_Flag_Present := True; 572 end if; 573 end if; 574 575 -- Add directory to source search dirs so that 576 -- Get_Target_Parameters can find system.ads 577 578 if Arg (AF .. AF + 1) = "-I" 579 and then Arg'Length > 2 580 then 581 Add_Src_Search_Dir (Arg (AF + 2 .. Arg'Last)); 582 end if; 583 584 -- Pass to gcc for compiling binder generated file 585 -- No use passing libraries, it will just generate 586 -- a warning 587 588 if not (Arg (AF .. AF + 1) = "-l" 589 or else Arg (AF .. AF + 1) = "-L") 590 then 591 Binder_Options.Increment_Last; 592 Binder_Options.Table (Binder_Options.Last) := 593 new String'(Arg); 594 end if; 595 596 -- Pass to gcc for linking program 597 598 Gcc_Linker_Options.Increment_Last; 599 Gcc_Linker_Options.Table 600 (Gcc_Linker_Options.Last) := new String'(Arg); 601 end; 602 end loop; 603 end; 604 605 -- Send all multi-character switches not recognized as 606 -- a special case by gnatlink to the linker/loader stage. 607 608 else 609 Linker_Options.Increment_Last; 610 Linker_Options.Table (Linker_Options.Last) := 611 new String'(Arg); 612 end if; 613 614 -- Here if argument is a file name rather than a switch 615 616 else 617 -- If explicit ali file, capture it 618 619 if Arg'Length > 4 620 and then Arg (Arg'Last - 3 .. Arg'Last) = ".ali" 621 then 622 if Ali_File_Name = null then 623 Ali_File_Name := new String'(Arg); 624 else 625 Exit_With_Error ("cannot handle more than one ALI file"); 626 end if; 627 628 -- If target object file, record object file 629 630 elsif Arg'Length > Get_Target_Object_Suffix.all'Length 631 and then Arg 632 (Arg'Last - 633 Get_Target_Object_Suffix.all'Length + 1 .. Arg'Last) 634 = Get_Target_Object_Suffix.all 635 then 636 Linker_Objects.Increment_Last; 637 Linker_Objects.Table (Linker_Objects.Last) := 638 new String'(Arg); 639 640 -- If host object file, record object file e.g. accept foo.o 641 -- as well as foo.obj on VMS target. 642 643 elsif Arg'Length > Get_Object_Suffix.all'Length 644 and then Arg 645 (Arg'Last - Get_Object_Suffix.all'Length + 1 .. Arg'Last) 646 = Get_Object_Suffix.all 647 then 648 Linker_Objects.Increment_Last; 649 Linker_Objects.Table (Linker_Objects.Last) := 650 new String'(Arg); 651 652 -- If corresponding ali file exists, capture it 653 654 elsif Ali_File_Name = null 655 and then Is_Regular_File (Arg & ".ali") 656 then 657 Ali_File_Name := new String'(Arg & ".ali"); 658 659 -- Otherwise assume this is a linker options entry, but 660 -- see below for interesting adjustment to this assumption. 661 662 else 663 Linker_Options.Increment_Last; 664 Linker_Options.Table (Linker_Options.Last) := 665 new String'(Arg); 666 end if; 667 end if; 668 end Process_One_Arg; 669 670 Next_Arg := Next_Arg + 1; 671 end loop; 672 673 -- Compile the bind file with warnings suppressed, because 674 -- otherwise the with of the main program may cause junk warnings. 675 676 Binder_Options.Increment_Last; 677 Binder_Options.Table (Binder_Options.Last) := new String'("-gnatws"); 678 679 -- If we did not get an ali file at all, and we had at least one 680 -- linker option, then assume that was the intended ali file after 681 -- all, so that we get a nicer message later on. 682 683 if Ali_File_Name = null 684 and then Linker_Options.Last >= Linker_Options.First 685 then 686 Ali_File_Name := 687 new String'(Linker_Options.Table (Linker_Options.First).all 688 & ".ali"); 689 end if; 690 end Process_Args; 691 692 ------------------------- 693 -- Process_Binder_File -- 694 ------------------------- 695 696 procedure Process_Binder_File (Name : String) is 697 Fd : FILEs; 698 -- Binder file's descriptor 699 700 Link_Bytes : Integer := 0; 701 -- Projected number of bytes for the linker command line 702 703 Link_Max : Integer; 704 pragma Import (C, Link_Max, "__gnat_link_max"); 705 -- Maximum number of bytes on the command line supported by the OS 706 -- linker. Passed this limit the response file mechanism must be used 707 -- if supported. 708 709 Next_Line : String (1 .. 1000); 710 -- Current line value 711 712 Nlast : Integer; 713 Nfirst : Integer; 714 -- Current line slice (the slice does not contain line terminator) 715 716 Last : Integer; 717 -- Current line last character for shared libraries (without version) 718 719 Objs_Begin : Integer := 0; 720 -- First object file index in Linker_Objects table 721 722 Objs_End : Integer := 0; 723 -- Last object file index in Linker_Objects table 724 725 Status : int; 726 pragma Warnings (Off, Status); 727 -- Used for various Interfaces.C_Streams calls 728 729 Closing_Status : Boolean; 730 pragma Warnings (Off, Closing_Status); 731 -- For call to Close 732 733 GNAT_Static : Boolean := False; 734 -- Save state of -static option 735 736 GNAT_Shared : Boolean := False; 737 -- Save state of -shared option 738 739 Xlinker_Was_Previous : Boolean := False; 740 -- Indicate that "-Xlinker" was the option preceding the current 741 -- option. If True, then the current option is never suppressed. 742 743 -- Rollback data 744 745 -- These data items are used to store current binder file context. 746 -- The context is composed of the file descriptor position and the 747 -- current line together with the slice indexes (first and last 748 -- position) for this line. The rollback data are used by the 749 -- Store_File_Context and Rollback_File_Context routines below. 750 -- The file context mechanism interact only with the Get_Next_Line 751 -- call. For example: 752 753 -- Store_File_Context; 754 -- Get_Next_Line; 755 -- Rollback_File_Context; 756 -- Get_Next_Line; 757 758 -- Both Get_Next_Line calls above will read the exact same data from 759 -- the file. In other words, Next_Line, Nfirst and Nlast variables 760 -- will be set with the exact same values. 761 762 RB_File_Pos : long; -- File position 763 RB_Next_Line : String (1 .. 1000); -- Current line content 764 RB_Nlast : Integer; -- Slice last index 765 RB_Nfirst : Integer; -- Slice first index 766 767 Run_Path_Option_Ptr : Interfaces.C.Strings.chars_ptr; 768 pragma Import (C, Run_Path_Option_Ptr, "__gnat_run_path_option"); 769 -- Pointer to string representing the native linker option which 770 -- specifies the path where the dynamic loader should find shared 771 -- libraries. Equal to null string if this system doesn't support it. 772 773 Libgcc_Subdir_Ptr : Interfaces.C.Strings.chars_ptr; 774 pragma Import (C, Libgcc_Subdir_Ptr, "__gnat_default_libgcc_subdir"); 775 -- Pointer to string indicating the installation subdirectory where 776 -- a default shared libgcc might be found. 777 778 Object_Library_Ext_Ptr : Interfaces.C.Strings.chars_ptr; 779 pragma Import 780 (C, Object_Library_Ext_Ptr, "__gnat_object_library_extension"); 781 -- Pointer to string specifying the default extension for 782 -- object libraries, e.g. Unix uses ".a", VMS uses ".olb". 783 784 Separate_Run_Path_Options : Boolean; 785 for Separate_Run_Path_Options'Size use Character'Size; 786 pragma Import 787 (C, Separate_Run_Path_Options, "__gnat_separate_run_path_options"); 788 -- Whether separate rpath options should be emitted for each directory 789 790 procedure Get_Next_Line; 791 -- Read the next line from the binder file without the line 792 -- terminator. 793 794 function Index (S, Pattern : String) return Natural; 795 -- Return the last occurrence of Pattern in S, or 0 if none 796 797 function Is_Option_Present (Opt : String) return Boolean; 798 -- Return true if the option Opt is already present in 799 -- Linker_Options table. 800 801 procedure Store_File_Context; 802 -- Store current file context, Fd position and current line data. 803 -- The file context is stored into the rollback data above (RB_*). 804 -- Store_File_Context can be called at any time, only the last call 805 -- will be used (i.e. this routine overwrites the file context). 806 807 procedure Rollback_File_Context; 808 -- Restore file context from rollback data. This routine must be called 809 -- after Store_File_Context. The binder file context will be restored 810 -- with the data stored by the last Store_File_Context call. 811 812 procedure Write_RF (S : String); 813 -- Write a string to the response file and check if it was successful. 814 -- Fail the program if it was not successful (disk full). 815 816 ------------------- 817 -- Get_Next_Line -- 818 ------------------- 819 820 procedure Get_Next_Line is 821 Fchars : chars; 822 823 begin 824 Fchars := fgets (Next_Line'Address, Next_Line'Length, Fd); 825 826 if Fchars = System.Null_Address then 827 Exit_With_Error ("Error reading binder output"); 828 end if; 829 830 Nfirst := Next_Line'First; 831 Nlast := Nfirst; 832 while Nlast <= Next_Line'Last 833 and then Next_Line (Nlast) /= ASCII.LF 834 and then Next_Line (Nlast) /= ASCII.CR 835 loop 836 Nlast := Nlast + 1; 837 end loop; 838 839 Nlast := Nlast - 1; 840 end Get_Next_Line; 841 842 ----------- 843 -- Index -- 844 ----------- 845 846 function Index (S, Pattern : String) return Natural is 847 Len : constant Natural := Pattern'Length; 848 849 begin 850 for J in reverse S'First .. S'Last - Len + 1 loop 851 if Pattern = S (J .. J + Len - 1) then 852 return J; 853 end if; 854 end loop; 855 856 return 0; 857 end Index; 858 859 ----------------------- 860 -- Is_Option_Present -- 861 ----------------------- 862 863 function Is_Option_Present (Opt : String) return Boolean is 864 begin 865 for I in 1 .. Linker_Options.Last loop 866 867 if Linker_Options.Table (I).all = Opt then 868 return True; 869 end if; 870 871 end loop; 872 873 return False; 874 end Is_Option_Present; 875 876 --------------------------- 877 -- Rollback_File_Context -- 878 --------------------------- 879 880 procedure Rollback_File_Context is 881 begin 882 Next_Line := RB_Next_Line; 883 Nfirst := RB_Nfirst; 884 Nlast := RB_Nlast; 885 Status := fseek (Fd, RB_File_Pos, Interfaces.C_Streams.SEEK_SET); 886 887 if Status = -1 then 888 Exit_With_Error ("Error setting file position"); 889 end if; 890 end Rollback_File_Context; 891 892 ------------------------ 893 -- Store_File_Context -- 894 ------------------------ 895 896 procedure Store_File_Context is 897 use type System.CRTL.long; 898 899 begin 900 RB_Next_Line := Next_Line; 901 RB_Nfirst := Nfirst; 902 RB_Nlast := Nlast; 903 RB_File_Pos := ftell (Fd); 904 905 if RB_File_Pos = -1 then 906 Exit_With_Error ("Error getting file position"); 907 end if; 908 end Store_File_Context; 909 910 -------------- 911 -- Write_RF -- 912 -------------- 913 914 procedure Write_RF (S : String) is 915 Success : Boolean := True; 916 Back_Slash : constant Character := '\'; 917 918 begin 919 -- If a GNU response file is used, space and backslash need to be 920 -- escaped because they are interpreted as a string separator and 921 -- an escape character respectively by the underlying mechanism. 922 -- On the other hand, quote and double-quote are not escaped since 923 -- they are interpreted as string delimiters on both sides. 924 925 if Using_GNU_response_file then 926 for J in S'Range loop 927 if S (J) = ' ' or else S (J) = '\' then 928 if Write (Tname_FD, Back_Slash'Address, 1) /= 1 then 929 Success := False; 930 end if; 931 end if; 932 933 if Write (Tname_FD, S (J)'Address, 1) /= 1 then 934 Success := False; 935 end if; 936 end loop; 937 938 else 939 if Write (Tname_FD, S'Address, S'Length) /= S'Length then 940 Success := False; 941 end if; 942 end if; 943 944 if Write (Tname_FD, ASCII.LF'Address, 1) /= 1 then 945 Success := False; 946 end if; 947 948 if not Success then 949 Exit_With_Error ("Error generating response file: disk full"); 950 end if; 951 end Write_RF; 952 953 -- Start of processing for Process_Binder_File 954 955 begin 956 Fd := fopen (Name'Address, Read_Mode'Address); 957 958 if Fd = NULL_Stream then 959 Exit_With_Error ("Failed to open binder output"); 960 end if; 961 962 -- Skip up to the Begin Info line 963 964 loop 965 Get_Next_Line; 966 exit when Next_Line (Nfirst .. Nlast) = Begin_Info; 967 end loop; 968 969 loop 970 Get_Next_Line; 971 972 -- Go to end when end line is reached (this will happen in 973 -- High_Integrity_Mode where no -L switches are generated) 974 975 exit when Next_Line (Nfirst .. Nlast) = End_Info; 976 977 Next_Line (Nfirst .. Nlast - 8) := Next_Line (Nfirst + 8 .. Nlast); 978 Nlast := Nlast - 8; 979 980 -- Go to next section when switches are reached 981 982 exit when Next_Line (1) = '-'; 983 984 -- Otherwise we have another object file to collect 985 986 Linker_Objects.Increment_Last; 987 988 -- Mark the positions of first and last object files in case they 989 -- need to be placed with a named file on systems having linker 990 -- line limitations. 991 992 if Objs_Begin = 0 then 993 Objs_Begin := Linker_Objects.Last; 994 end if; 995 996 Linker_Objects.Table (Linker_Objects.Last) := 997 new String'(Next_Line (Nfirst .. Nlast)); 998 999 -- Nlast - Nfirst + 1, for the size, plus one for the space between 1000 -- each arguments. 1001 1002 Link_Bytes := Link_Bytes + Nlast - Nfirst + 2; 1003 end loop; 1004 1005 Objs_End := Linker_Objects.Last; 1006 1007 -- Continue to compute the Link_Bytes, the linker options are part of 1008 -- command line length. 1009 1010 Store_File_Context; 1011 1012 while Next_Line (Nfirst .. Nlast) /= End_Info loop 1013 Link_Bytes := Link_Bytes + Nlast - Nfirst + 2; 1014 Get_Next_Line; 1015 end loop; 1016 1017 Rollback_File_Context; 1018 1019 -- On systems that have limitations on handling very long linker lines 1020 -- we make use of the system linker option which takes a list of object 1021 -- file names from a file instead of the command line itself. What we do 1022 -- is to replace the list of object files by the special linker option 1023 -- which then reads the object file list from a file instead. The option 1024 -- to read from a file instead of the command line is only triggered if 1025 -- a conservative threshold is passed. 1026 1027 if Object_List_File_Required 1028 or else (Object_List_File_Supported 1029 and then Link_Bytes > Link_Max) 1030 then 1031 -- Create a temporary file containing the Ada user object files 1032 -- needed by the link. This list is taken from the bind file and is 1033 -- output one object per line for maximal compatibility with linkers 1034 -- supporting this option. 1035 1036 Create_Temp_File (Tname_FD, Tname); 1037 1038 -- ??? File descriptor should be checked to not be Invalid_FD. 1039 -- ??? Status of Write and Close operations should be checked, and 1040 -- failure should occur if a status is wrong. 1041 1042 for J in Objs_Begin .. Objs_End loop 1043 Write_RF (Linker_Objects.Table (J).all); 1044 1045 Response_File_Objects.Increment_Last; 1046 Response_File_Objects.Table (Response_File_Objects.Last) := 1047 Linker_Objects.Table (J); 1048 end loop; 1049 1050 Close (Tname_FD, Closing_Status); 1051 1052 -- Add the special objects list file option together with the name 1053 -- of the temporary file (removing the null character) to the objects 1054 -- file table. 1055 1056 Linker_Objects.Table (Objs_Begin) := 1057 new String'(Object_File_Option & 1058 Tname (Tname'First .. Tname'Last - 1)); 1059 1060 -- The slots containing these object file names are then removed 1061 -- from the objects table so they do not appear in the link. They are 1062 -- removed by moving up the linker options and non-Ada object files 1063 -- appearing after the Ada object list in the table. 1064 1065 declare 1066 N : Integer; 1067 1068 begin 1069 N := Objs_End - Objs_Begin + 1; 1070 1071 for J in Objs_End + 1 .. Linker_Objects.Last loop 1072 Linker_Objects.Table (J - N + 1) := Linker_Objects.Table (J); 1073 end loop; 1074 1075 Linker_Objects.Set_Last (Linker_Objects.Last - N + 1); 1076 end; 1077 end if; 1078 1079 -- Process switches and options 1080 1081 if Next_Line (Nfirst .. Nlast) /= End_Info then 1082 Xlinker_Was_Previous := False; 1083 1084 loop 1085 if Xlinker_Was_Previous 1086 or else Next_Line (Nfirst .. Nlast) = "-Xlinker" 1087 then 1088 Linker_Options.Increment_Last; 1089 Linker_Options.Table (Linker_Options.Last) := 1090 new String'(Next_Line (Nfirst .. Nlast)); 1091 1092 elsif Next_Line (Nfirst .. Nlast) = "-static" then 1093 GNAT_Static := True; 1094 1095 elsif Next_Line (Nfirst .. Nlast) = "-shared" then 1096 GNAT_Shared := True; 1097 1098 -- Add binder options only if not already set on the command line. 1099 -- This rule is a way to control the linker options order. 1100 1101 -- The following test needs comments, why is it VMS specific. 1102 -- The above comment looks out of date ??? 1103 1104 elsif not 1105 (OpenVMS_On_Target 1106 and then Is_Option_Present (Next_Line (Nfirst .. Nlast))) 1107 then 1108 if Nlast > Nfirst + 2 and then 1109 Next_Line (Nfirst .. Nfirst + 1) = "-L" 1110 then 1111 -- Construct a library search path for use later to locate 1112 -- static gnatlib libraries. 1113 1114 if Libpath.Last > 1 then 1115 Libpath.Increment_Last; 1116 Libpath.Table (Libpath.Last) := Path_Separator; 1117 end if; 1118 1119 for I in Nfirst + 2 .. Nlast loop 1120 Libpath.Increment_Last; 1121 Libpath.Table (Libpath.Last) := Next_Line (I); 1122 end loop; 1123 1124 Linker_Options.Increment_Last; 1125 1126 Linker_Options.Table (Linker_Options.Last) := 1127 new String'(Next_Line (Nfirst .. Nlast)); 1128 1129 elsif Next_Line (Nfirst .. Nlast) = "-ldecgnat" 1130 or else Next_Line (Nfirst .. Nlast) = "-lgnarl" 1131 or else Next_Line (Nfirst .. Nlast) = "-lgnat" 1132 or else 1133 Next_Line 1134 (1 .. Natural'Min (Nlast, 8 + Library_Version'Length)) = 1135 Shared_Lib ("gnarl") 1136 or else 1137 Next_Line 1138 (1 .. Natural'Min (Nlast, 7 + Library_Version'Length)) = 1139 Shared_Lib ("gnat") 1140 then 1141 -- If it is a shared library, remove the library version. 1142 -- We will be looking for the static version of the library 1143 -- as it is in the same directory as the shared version. 1144 1145 if Next_Line (Nlast - Library_Version'Length + 1 .. Nlast) = 1146 Library_Version 1147 then 1148 -- Set Last to point to last character before the 1149 -- library version. 1150 1151 Last := Nlast - Library_Version'Length - 1; 1152 else 1153 Last := Nlast; 1154 end if; 1155 1156 -- Given a Gnat standard library, search the library path to 1157 -- find the library location. 1158 1159 -- Shouldn't we abstract a proc here, we are getting awfully 1160 -- heavily nested ??? 1161 1162 declare 1163 File_Path : String_Access; 1164 1165 Object_Lib_Extension : constant String := 1166 Value (Object_Library_Ext_Ptr); 1167 1168 File_Name : constant String := "lib" & 1169 Next_Line (Nfirst + 2 .. Last) & Object_Lib_Extension; 1170 1171 Run_Path_Opt : constant String := 1172 Value (Run_Path_Option_Ptr); 1173 1174 GCC_Index : Natural; 1175 Run_Path_Opt_Index : Natural := 0; 1176 1177 begin 1178 File_Path := 1179 Locate_Regular_File (File_Name, 1180 String (Libpath.Table (1 .. Libpath.Last))); 1181 1182 if File_Path /= null then 1183 if GNAT_Static then 1184 1185 -- If static gnatlib found, explicitly specify to 1186 -- overcome possible linker default usage of shared 1187 -- version. 1188 1189 Linker_Options.Increment_Last; 1190 1191 Linker_Options.Table (Linker_Options.Last) := 1192 new String'(File_Path.all); 1193 1194 elsif GNAT_Shared then 1195 if Opt.Run_Path_Option then 1196 1197 -- If shared gnatlib desired, add appropriate 1198 -- system specific switch so that it can be 1199 -- located at runtime. 1200 1201 if Run_Path_Opt'Length /= 0 then 1202 1203 -- Output the system specific linker command 1204 -- that allows the image activator to find 1205 -- the shared library at runtime. Also add 1206 -- path to find libgcc_s.so, if relevant. 1207 1208 declare 1209 Path : String (1 .. File_Path'Length + 15); 1210 1211 Path_Last : constant Natural := 1212 File_Path'Length; 1213 1214 begin 1215 Path (1 .. File_Path'Length) := 1216 File_Path.all; 1217 1218 -- To find the location of the shared version 1219 -- of libgcc, we look for "gcc-lib" in the 1220 -- path of the library. However, this 1221 -- subdirectory is no longer present in 1222 -- recent versions of GCC. So, we look for 1223 -- the last subdirectory "lib" in the path. 1224 1225 GCC_Index := 1226 Index (Path (1 .. Path_Last), "gcc-lib"); 1227 1228 if GCC_Index /= 0 then 1229 1230 -- The shared version of libgcc is 1231 -- located in the parent directory. 1232 1233 GCC_Index := GCC_Index - 1; 1234 1235 else 1236 GCC_Index := 1237 Index 1238 (Path (1 .. Path_Last), 1239 "/lib/"); 1240 1241 if GCC_Index = 0 then 1242 GCC_Index := 1243 Index (Path (1 .. Path_Last), 1244 Directory_Separator & 1245 "lib" & 1246 Directory_Separator); 1247 end if; 1248 1249 -- If we have found a "lib" subdir in 1250 -- the path to libgnat, the possible 1251 -- shared libgcc of interest by default 1252 -- is in libgcc_subdir at the same 1253 -- level. 1254 1255 if GCC_Index /= 0 then 1256 declare 1257 Subdir : constant String := 1258 Value (Libgcc_Subdir_Ptr); 1259 begin 1260 Path 1261 (GCC_Index + 1 .. 1262 GCC_Index + Subdir'Length) := 1263 Subdir; 1264 GCC_Index := 1265 GCC_Index + Subdir'Length; 1266 end; 1267 end if; 1268 end if; 1269 1270 -- Look for an eventual run_path_option in 1271 -- the linker switches. 1272 1273 if Separate_Run_Path_Options then 1274 Linker_Options.Increment_Last; 1275 Linker_Options.Table 1276 (Linker_Options.Last) := 1277 new String' 1278 (Run_Path_Opt 1279 & File_Path 1280 (1 .. File_Path'Length 1281 - File_Name'Length)); 1282 1283 if GCC_Index /= 0 then 1284 Linker_Options.Increment_Last; 1285 Linker_Options.Table 1286 (Linker_Options.Last) := 1287 new String' 1288 (Run_Path_Opt 1289 & Path (1 .. GCC_Index)); 1290 end if; 1291 1292 else 1293 for J in reverse 1294 1 .. Linker_Options.Last 1295 loop 1296 if Linker_Options.Table (J) /= null 1297 and then 1298 Linker_Options.Table (J)'Length 1299 > Run_Path_Opt'Length 1300 and then 1301 Linker_Options.Table (J) 1302 (1 .. Run_Path_Opt'Length) = 1303 Run_Path_Opt 1304 then 1305 -- We have found an already 1306 -- specified run_path_option: 1307 -- we will add to this 1308 -- switch, because only one 1309 -- run_path_option should be 1310 -- specified. 1311 1312 Run_Path_Opt_Index := J; 1313 exit; 1314 end if; 1315 end loop; 1316 1317 -- If there is no run_path_option, we 1318 -- need to add one. 1319 1320 if Run_Path_Opt_Index = 0 then 1321 Linker_Options.Increment_Last; 1322 end if; 1323 1324 if GCC_Index = 0 then 1325 if Run_Path_Opt_Index = 0 then 1326 Linker_Options.Table 1327 (Linker_Options.Last) := 1328 new String' 1329 (Run_Path_Opt 1330 & File_Path 1331 (1 .. File_Path'Length 1332 - File_Name'Length)); 1333 1334 else 1335 Linker_Options.Table 1336 (Run_Path_Opt_Index) := 1337 new String' 1338 (Linker_Options.Table 1339 (Run_Path_Opt_Index).all 1340 & Path_Separator 1341 & File_Path 1342 (1 .. File_Path'Length 1343 - File_Name'Length)); 1344 end if; 1345 1346 else 1347 if Run_Path_Opt_Index = 0 then 1348 Linker_Options.Table 1349 (Linker_Options.Last) := 1350 new String' 1351 (Run_Path_Opt 1352 & File_Path 1353 (1 .. File_Path'Length 1354 - File_Name'Length) 1355 & Path_Separator 1356 & Path (1 .. GCC_Index)); 1357 1358 else 1359 Linker_Options.Table 1360 (Run_Path_Opt_Index) := 1361 new String' 1362 (Linker_Options.Table 1363 (Run_Path_Opt_Index).all 1364 & Path_Separator 1365 & File_Path 1366 (1 .. File_Path'Length 1367 - File_Name'Length) 1368 & Path_Separator 1369 & Path (1 .. GCC_Index)); 1370 end if; 1371 end if; 1372 end if; 1373 end; 1374 end if; 1375 end if; 1376 1377 -- Then we add the appropriate -l switch 1378 1379 Linker_Options.Increment_Last; 1380 Linker_Options.Table (Linker_Options.Last) := 1381 new String'(Next_Line (Nfirst .. Nlast)); 1382 end if; 1383 1384 else 1385 -- If gnatlib library not found, then add it anyway in 1386 -- case some other mechanism may find it. 1387 1388 Linker_Options.Increment_Last; 1389 Linker_Options.Table (Linker_Options.Last) := 1390 new String'(Next_Line (Nfirst .. Nlast)); 1391 end if; 1392 end; 1393 else 1394 Linker_Options.Increment_Last; 1395 Linker_Options.Table (Linker_Options.Last) := 1396 new String'(Next_Line (Nfirst .. Nlast)); 1397 end if; 1398 end if; 1399 1400 Xlinker_Was_Previous := Next_Line (Nfirst .. Nlast) = "-Xlinker"; 1401 1402 Get_Next_Line; 1403 exit when Next_Line (Nfirst .. Nlast) = End_Info; 1404 1405 Next_Line (Nfirst .. Nlast - 8) := Next_Line (Nfirst + 8 .. Nlast); 1406 Nlast := Nlast - 8; 1407 end loop; 1408 end if; 1409 1410 -- If -shared was specified, invoke gcc with -shared-libgcc 1411 1412 if GNAT_Shared then 1413 Linker_Options.Increment_Last; 1414 Linker_Options.Table (Linker_Options.Last) := Shared_Libgcc; 1415 end if; 1416 1417 Status := fclose (Fd); 1418 end Process_Binder_File; 1419 1420 -------------- 1421 -- To_Lower -- 1422 -------------- 1423 1424 function To_Lower (A : Character) return Character is 1425 A_Val : constant Natural := Character'Pos (A); 1426 1427 begin 1428 if A in 'A' .. 'Z' 1429 or else A_Val in 16#C0# .. 16#D6# 1430 or else A_Val in 16#D8# .. 16#DE# 1431 then 1432 return Character'Val (A_Val + 16#20#); 1433 else 1434 return A; 1435 end if; 1436 end To_Lower; 1437 1438 procedure To_Lower (A : in out String) is 1439 begin 1440 for J in A'Range loop 1441 A (J) := To_Lower (A (J)); 1442 end loop; 1443 end To_Lower; 1444 1445 ----------- 1446 -- Usage -- 1447 ----------- 1448 1449 procedure Usage is 1450 begin 1451 Write_Str ("Usage: "); 1452 Write_Str (Base_Command_Name.all); 1453 Write_Str (" switches mainprog.ali [non-Ada-objects] [linker-options]"); 1454 Write_Eol; 1455 Write_Eol; 1456 Write_Line (" mainprog.ali the ALI file of the main program"); 1457 Write_Eol; 1458 Write_Eol; 1459 Display_Usage_Version_And_Help; 1460 Write_Line (" -f Force object file list to be generated"); 1461 Write_Line (" -g Compile binder source file with debug information"); 1462 Write_Line (" -n Do not compile the binder source file"); 1463 Write_Line (" -P Process files for use by CodePeer"); 1464 Write_Line (" -R Do not use a run_path_option"); 1465 Write_Line (" -v Verbose mode"); 1466 Write_Line (" -v -v Very verbose mode"); 1467 Write_Eol; 1468 Write_Line (" -o nam Use 'nam' as the name of the executable"); 1469 Write_Line (" -b target Compile the binder source to run on target"); 1470 Write_Line (" -Bdir Load compiler executables from dir"); 1471 1472 if Is_Supported (Map_File) then 1473 Write_Line (" -Mmap Create map file map"); 1474 Write_Line (" -M Create map file mainprog.map"); 1475 end if; 1476 1477 Write_Line (" --GCC=comp Use comp as the compiler"); 1478 Write_Line (" --LINK=nam Use 'nam' for the linking rather than 'gcc'"); 1479 Write_Eol; 1480 Write_Line (" [non-Ada-objects] list of non Ada object files"); 1481 Write_Line (" [linker-options] other options for the linker"); 1482 end Usage; 1483 1484 ------------------ 1485 -- Write_Header -- 1486 ------------------ 1487 1488 procedure Write_Header is 1489 begin 1490 if Verbose_Mode then 1491 Write_Eol; 1492 Display_Version ("GNATLINK", "1995"); 1493 end if; 1494 end Write_Header; 1495 1496 ----------------- 1497 -- Write_Usage -- 1498 ----------------- 1499 1500 procedure Write_Usage is 1501 begin 1502 Write_Header; 1503 Usage; 1504 end Write_Usage; 1505 1506-- Start of processing for Gnatlink 1507 1508begin 1509 -- Add the directory where gnatlink is invoked in front of the path, if 1510 -- gnatlink is invoked with directory information. Only do this if the 1511 -- platform is not VMS, where the notion of path does not really exist. 1512 1513 if not Hostparm.OpenVMS then 1514 declare 1515 Command : constant String := Command_Name; 1516 1517 begin 1518 for Index in reverse Command'Range loop 1519 if Command (Index) = Directory_Separator then 1520 declare 1521 Absolute_Dir : constant String := 1522 Normalize_Pathname 1523 (Command (Command'First .. Index)); 1524 1525 PATH : constant String := 1526 Absolute_Dir & 1527 Path_Separator & 1528 Getenv ("PATH").all; 1529 1530 begin 1531 Setenv ("PATH", PATH); 1532 end; 1533 1534 exit; 1535 end if; 1536 end loop; 1537 end; 1538 end if; 1539 1540 Base_Command_Name := new String'(Base_Name (Command_Name)); 1541 1542 -- Fold to lower case "GNATLINK" on VMS to be consistent with output 1543 -- from other GNAT utilities. 1544 1545 if Hostparm.OpenVMS then 1546 To_Lower (Base_Command_Name.all); 1547 end if; 1548 1549 Process_Args; 1550 1551 if Argument_Count = 0 1552 or else (Verbose_Mode and then Argument_Count = 1) 1553 then 1554 Write_Usage; 1555 Exit_Program (E_Fatal); 1556 end if; 1557 1558 -- Initialize packages to be used 1559 1560 Csets.Initialize; 1561 Snames.Initialize; 1562 1563 -- We always compile with -c 1564 1565 Binder_Options_From_ALI.Increment_Last; 1566 Binder_Options_From_ALI.Table (Binder_Options_From_ALI.Last) := 1567 new String'("-c"); 1568 1569 if Ali_File_Name = null then 1570 Exit_With_Error ("no ali file given for link"); 1571 end if; 1572 1573 if not Is_Regular_File (Ali_File_Name.all) then 1574 Exit_With_Error (Ali_File_Name.all & " not found"); 1575 end if; 1576 1577 -- Read the ALI file of the main subprogram if the binder generated file 1578 -- needs to be compiled and no --GCC= switch has been specified. Fetch the 1579 -- back end switches from this ALI file and use these switches to compile 1580 -- the binder generated file 1581 1582 if Compile_Bind_File and then Standard_Gcc then 1583 Initialize_ALI; 1584 Name_Len := Ali_File_Name'Length; 1585 Name_Buffer (1 .. Name_Len) := Ali_File_Name.all; 1586 1587 declare 1588 use Types; 1589 F : constant File_Name_Type := Name_Find; 1590 T : Text_Buffer_Ptr; 1591 A : ALI_Id; 1592 1593 begin 1594 -- Load the ALI file 1595 1596 T := Read_Library_Info (F, True); 1597 1598 -- Read it. Note that we ignore errors, since we only want very 1599 -- limited information from the ali file, and likely a slightly 1600 -- wrong version will be just fine, though in normal operation 1601 -- we don't expect this to happen. 1602 1603 A := Scan_ALI 1604 (F, 1605 T, 1606 Ignore_ED => False, 1607 Err => False, 1608 Ignore_Errors => True); 1609 1610 if A /= No_ALI_Id then 1611 for 1612 Index in Units.Table (ALIs.Table (A).First_Unit).First_Arg .. 1613 Units.Table (ALIs.Table (A).First_Unit).Last_Arg 1614 loop 1615 -- Do not compile with the front end switches. However, --RTS 1616 -- is to be dealt with specially because it needs to be passed 1617 -- if the binder-generated file is in Ada and may also be used 1618 -- to drive the linker. 1619 1620 declare 1621 Arg : String_Ptr renames Args.Table (Index); 1622 begin 1623 if not Is_Front_End_Switch (Arg.all) then 1624 Binder_Options_From_ALI.Increment_Last; 1625 Binder_Options_From_ALI.Table 1626 (Binder_Options_From_ALI.Last) := String_Access (Arg); 1627 1628 elsif Arg'Length > 5 1629 and then Arg (Arg'First + 2 .. Arg'First + 5) = "RTS=" 1630 then 1631 Binder_Options_From_ALI.Increment_Last; 1632 Binder_Options_From_ALI.Table 1633 (Binder_Options_From_ALI.Last) := String_Access (Arg); 1634 1635 -- Set the RTS_*_Path_Name variables, so that 1636 -- the correct directories will be set when 1637 -- Osint.Add_Default_Search_Dirs will be called later. 1638 1639 Opt.RTS_Src_Path_Name := 1640 Get_RTS_Search_Dir 1641 (Arg (Arg'First + 6 .. Arg'Last), Include); 1642 1643 Opt.RTS_Lib_Path_Name := 1644 Get_RTS_Search_Dir 1645 (Arg (Arg'First + 6 .. Arg'Last), Objects); 1646 1647 -- GNAT doesn't support the GCC multilib mechanism. 1648 -- This means that, when a multilib switch is used 1649 -- to request a particular compilation mode, the 1650 -- corresponding runtime switch (--RTS) must also be 1651 -- specified. The long-term goal is to fully support the 1652 -- multilib mechanism; however, in the meantime, it is 1653 -- convenient to eliminate the redundancy by keying the 1654 -- compilation mode on a single switch, namely --RTS. 1655 1656 -- Pass -mrtp to the linker if --RTS=rtp was passed 1657 1658 if Arg'Length > 8 1659 and then 1660 (Arg (Arg'First + 6 .. Arg'First + 8) = "rtp" 1661 or else Arg (Arg'Last - 2 .. Arg'Last) = "rtp") 1662 then 1663 Linker_Options.Increment_Last; 1664 Linker_Options.Table (Linker_Options.Last) := 1665 new String'("-mrtp"); 1666 end if; 1667 end if; 1668 end; 1669 end loop; 1670 end if; 1671 end; 1672 end if; 1673 1674 -- Get target parameters 1675 1676 Osint.Add_Default_Search_Dirs; 1677 Targparm.Get_Target_Parameters; 1678 1679 if VM_Target /= No_VM then 1680 case VM_Target is 1681 when JVM_Target => Gcc := new String'("jvm-gnatcompile"); 1682 when CLI_Target => Gcc := new String'("dotnet-gnatcompile"); 1683 when No_VM => raise Program_Error; 1684 end case; 1685 end if; 1686 1687 -- Compile the bind file with the following switches: 1688 1689 -- -gnatA stops reading gnat.adc, since we don't know what 1690 -- pragmas would work, and we do not need it anyway. 1691 1692 -- -gnatWb allows brackets coding for wide characters 1693 1694 -- -gnatiw allows wide characters in identifiers. This is needed 1695 -- because bindgen uses brackets encoding for all upper 1696 -- half and wide characters in identifier names. 1697 1698 -- In addition, in CodePeer mode compile with -x adascil -gnatcC 1699 1700 Binder_Options_From_ALI.Increment_Last; 1701 Binder_Options_From_ALI.Table (Binder_Options_From_ALI.Last) := 1702 new String'("-gnatA"); 1703 Binder_Options_From_ALI.Increment_Last; 1704 Binder_Options_From_ALI.Table (Binder_Options_From_ALI.Last) := 1705 new String'("-gnatWb"); 1706 Binder_Options_From_ALI.Increment_Last; 1707 Binder_Options_From_ALI.Table (Binder_Options_From_ALI.Last) := 1708 new String'("-gnatiw"); 1709 1710 if Opt.CodePeer_Mode then 1711 Binder_Options_From_ALI.Increment_Last; 1712 Binder_Options_From_ALI.Table (Binder_Options_From_ALI.Last) := 1713 new String'("-x"); 1714 Binder_Options_From_ALI.Increment_Last; 1715 Binder_Options_From_ALI.Table (Binder_Options_From_ALI.Last) := 1716 new String'("adascil"); 1717 Binder_Options_From_ALI.Increment_Last; 1718 Binder_Options_From_ALI.Table (Binder_Options_From_ALI.Last) := 1719 new String'("-gnatcC"); 1720 end if; 1721 1722 -- Locate all the necessary programs and verify required files are present 1723 1724 Gcc_Path := System.OS_Lib.Locate_Exec_On_Path (Gcc.all); 1725 1726 if Gcc_Path = null then 1727 Exit_With_Error ("Couldn't locate " & Gcc.all); 1728 end if; 1729 1730 if Linker_Path = null then 1731 if VM_Target = CLI_Target then 1732 Linker_Path := System.OS_Lib.Locate_Exec_On_Path ("dotnet-ld"); 1733 1734 if Linker_Path = null then 1735 Exit_With_Error ("Couldn't locate dotnet-ld"); 1736 end if; 1737 1738 elsif RTX_RTSS_Kernel_Module_On_Target then 1739 1740 -- Use Microsoft linker for RTSS modules 1741 1742 Linker_Path := System.OS_Lib.Locate_Exec_On_Path ("link"); 1743 1744 if Linker_Path = null then 1745 Exit_With_Error ("Couldn't locate link"); 1746 end if; 1747 1748 else 1749 Linker_Path := Gcc_Path; 1750 end if; 1751 end if; 1752 1753 Write_Header; 1754 1755 -- If no output name specified, then use the base name of .ali file name 1756 1757 if Output_File_Name = null then 1758 Output_File_Name := 1759 new String'(Base_Name (Ali_File_Name.all) 1760 & Get_Target_Debuggable_Suffix.all); 1761 end if; 1762 1763 if RTX_RTSS_Kernel_Module_On_Target then 1764 Linker_Options.Increment_Last; 1765 Linker_Options.Table (Linker_Options.Last) := 1766 new String'("/OUT:" & Output_File_Name.all); 1767 1768 else 1769 Linker_Options.Increment_Last; 1770 Linker_Options.Table (Linker_Options.Last) := new String'("-o"); 1771 1772 Linker_Options.Increment_Last; 1773 Linker_Options.Table (Linker_Options.Last) := 1774 new String'(Output_File_Name.all); 1775 end if; 1776 1777 Check_Existing_Executable (Output_File_Name.all); 1778 1779 -- Warn if main program is called "test", as that may be a built-in command 1780 -- on Unix. On non-Unix systems executables have a suffix, so the warning 1781 -- will not appear. However, do not warn in the case of a cross compiler. 1782 1783 -- Assume this is a cross tool if the executable name is not gnatlink. 1784 -- Note that the executable name is also gnatlink on windows, but in that 1785 -- case the output file name will be test.exe rather than test. 1786 1787 if Base_Command_Name.all = "gnatlink" 1788 and then Output_File_Name.all = "test" 1789 then 1790 Error_Msg ("warning: executable name """ & Output_File_Name.all 1791 & """ may conflict with shell command"); 1792 end if; 1793 1794 -- Special warnings for worrisome file names on windows 1795 1796 -- Windows-7 will not allow an executable file whose name contains any 1797 -- of the substrings "install", "setup", or "update" to load without 1798 -- special administration privileges. This rather incredible behavior 1799 -- is Microsoft's idea of a useful security precaution. 1800 1801 Bad_File_Names_On_Windows : declare 1802 FN : String := Output_File_Name.all; 1803 1804 procedure Check_File_Name (S : String); 1805 -- Warn if file name has the substring S 1806 1807 procedure Check_File_Name (S : String) is 1808 begin 1809 for J in 1 .. FN'Length - (S'Length - 1) loop 1810 if FN (J .. J + (S'Length - 1)) = S then 1811 Error_Msg 1812 ("warning: possible problem with executable name """ 1813 & Output_File_Name.all & '"'); 1814 Error_Msg 1815 ("file name contains substring """ & S & '"'); 1816 Error_Msg 1817 ("admin privileges may be required on Windows 7 " 1818 & "to load this file"); 1819 end if; 1820 end loop; 1821 end Check_File_Name; 1822 1823 -- Start of processing for Bad_File_Names_On_Windows 1824 1825 begin 1826 for J in FN'Range loop 1827 FN (J) := Csets.Fold_Lower (FN (J)); 1828 end loop; 1829 1830 -- For now we detect windows by an output executable name ending with 1831 -- the suffix .exe (excluding VMS which might use that same name). 1832 1833 if FN'Length > 5 1834 and then FN (FN'Last - 3 .. FN'Last) = ".exe" 1835 and then not OpenVMS_On_Target 1836 then 1837 Check_File_Name ("install"); 1838 Check_File_Name ("setup"); 1839 Check_File_Name ("update"); 1840 end if; 1841 end Bad_File_Names_On_Windows; 1842 1843 -- If -M switch was specified, add the switches to create the map file 1844 1845 if Create_Map_File then 1846 declare 1847 Map_Name : constant String := Base_Name (Ali_File_Name.all) & ".map"; 1848 Switches : String_List_Access; 1849 1850 begin 1851 Convert (Map_File, Map_Name, Switches); 1852 1853 if Switches /= null then 1854 for J in Switches'Range loop 1855 Linker_Options.Increment_Last; 1856 Linker_Options.Table (Linker_Options.Last) := Switches (J); 1857 end loop; 1858 end if; 1859 end; 1860 end if; 1861 1862 -- Perform consistency checks 1863 1864 -- Transform the .ali file name into the binder output file name 1865 1866 Make_Binder_File_Names : declare 1867 Fname : constant String := Base_Name (Ali_File_Name.all); 1868 Fname_Len : Integer := Fname'Length; 1869 1870 function Get_Maximum_File_Name_Length return Integer; 1871 pragma Import (C, Get_Maximum_File_Name_Length, 1872 "__gnat_get_maximum_file_name_length"); 1873 1874 Maximum_File_Name_Length : constant Integer := 1875 Get_Maximum_File_Name_Length; 1876 1877 Bind_File_Prefix : Types.String_Ptr; 1878 -- Contains prefix used for bind files 1879 1880 begin 1881 -- Set prefix 1882 1883 if OpenVMS_On_Target then 1884 Bind_File_Prefix := new String'("b__"); 1885 else 1886 Bind_File_Prefix := new String'("b~"); 1887 end if; 1888 1889 -- If the length of the binder file becomes too long due to 1890 -- the addition of the "b?" prefix, then truncate it. 1891 1892 if Maximum_File_Name_Length > 0 then 1893 while Fname_Len > 1894 Maximum_File_Name_Length - Bind_File_Prefix.all'Length 1895 loop 1896 Fname_Len := Fname_Len - 1; 1897 end loop; 1898 end if; 1899 1900 declare 1901 Fnam : constant String := 1902 Bind_File_Prefix.all & 1903 Fname (Fname'First .. Fname'First + Fname_Len - 1); 1904 1905 begin 1906 Binder_Spec_Src_File := new String'(Fnam & ".ads"); 1907 Binder_Body_Src_File := new String'(Fnam & ".adb"); 1908 Binder_Ali_File := new String'(Fnam & ".ali"); 1909 1910 Binder_Obj_File := new String'(Fnam & Get_Target_Object_Suffix.all); 1911 end; 1912 1913 if Fname_Len /= Fname'Length then 1914 Binder_Options.Increment_Last; 1915 Binder_Options.Table (Binder_Options.Last) := new String'("-o"); 1916 Binder_Options.Increment_Last; 1917 Binder_Options.Table (Binder_Options.Last) := Binder_Obj_File; 1918 end if; 1919 end Make_Binder_File_Names; 1920 1921 Process_Binder_File (Binder_Body_Src_File.all & ASCII.NUL); 1922 1923 -- Compile the binder file. This is fast, so we always do it, unless 1924 -- specifically told not to by the -n switch 1925 1926 if Compile_Bind_File then 1927 Bind_Step : declare 1928 Success : Boolean; 1929 1930 Args : Argument_List 1931 (1 .. Binder_Options_From_ALI.Last + Binder_Options.Last + 1); 1932 1933 begin 1934 for J in 1 .. Binder_Options_From_ALI.Last loop 1935 Args (J) := Binder_Options_From_ALI.Table (J); 1936 end loop; 1937 1938 for J in 1 .. Binder_Options.Last loop 1939 Args (Binder_Options_From_ALI.Last + J) := 1940 Binder_Options.Table (J); 1941 end loop; 1942 1943 -- Use the full path of the binder generated source, so that it is 1944 -- guaranteed that the debugger will find this source, even with 1945 -- STABS. 1946 1947 Args (Args'Last) := 1948 new String'(Normalize_Pathname (Binder_Body_Src_File.all)); 1949 1950 if Verbose_Mode then 1951 Write_Str (Base_Name (Gcc_Path.all)); 1952 1953 for J in Args'Range loop 1954 Write_Str (" "); 1955 Write_Str (Args (J).all); 1956 end loop; 1957 1958 Write_Eol; 1959 end if; 1960 1961 System.OS_Lib.Spawn (Gcc_Path.all, Args, Success); 1962 1963 if not Success then 1964 Exit_Program (E_Fatal); 1965 end if; 1966 end Bind_Step; 1967 end if; 1968 1969 -- In CodePeer mode, there's nothing left to do after the binder file has 1970 -- been compiled. 1971 1972 if Opt.CodePeer_Mode then 1973 return; 1974 end if; 1975 1976 -- Now, actually link the program 1977 1978 -- Skip this step for now on JVM since the Java interpreter will do 1979 -- the actual link at run time. We might consider packing all class files 1980 -- in a .zip file during this step. 1981 1982 if VM_Target /= JVM_Target then 1983 Link_Step : declare 1984 Num_Args : Natural := 1985 (Linker_Options.Last - Linker_Options.First + 1) + 1986 (Gcc_Linker_Options.Last - Gcc_Linker_Options.First + 1) + 1987 (Linker_Objects.Last - Linker_Objects.First + 1); 1988 Stack_Op : Boolean := False; 1989 IDENT_Op : Boolean := False; 1990 1991 begin 1992 if AAMP_On_Target then 1993 1994 -- Remove extraneous flags not relevant for AAMP 1995 1996 for J in reverse Linker_Options.First .. Linker_Options.Last loop 1997 if Linker_Options.Table (J)'Length = 0 1998 or else Linker_Options.Table (J) (1 .. 3) = "-Wl" 1999 or else Linker_Options.Table (J) (1 .. 3) = "-sh" 2000 or else Linker_Options.Table (J) (1 .. 2) = "-O" 2001 or else Linker_Options.Table (J) (1 .. 2) = "-g" 2002 then 2003 Linker_Options.Table (J .. Linker_Options.Last - 1) := 2004 Linker_Options.Table (J + 1 .. Linker_Options.Last); 2005 Linker_Options.Decrement_Last; 2006 Num_Args := Num_Args - 1; 2007 end if; 2008 end loop; 2009 2010 elsif RTX_RTSS_Kernel_Module_On_Target then 2011 2012 -- Remove irrelevant flags for Microsoft linker, adapt some others 2013 2014 for J in reverse Linker_Options.First .. Linker_Options.Last loop 2015 2016 -- Remove flags that are not accepted 2017 2018 if Linker_Options.Table (J)'Length = 0 2019 or else Linker_Options.Table (J) (1 .. 2) = "-l" 2020 or else Linker_Options.Table (J) (1 .. 3) = "-Wl" 2021 or else Linker_Options.Table (J) (1 .. 3) = "-sh" 2022 or else Linker_Options.Table (J) (1 .. 2) = "-O" 2023 or else Linker_Options.Table (J) (1 .. 8) = "-Xlinker" 2024 or else Linker_Options.Table (J) (1 .. 9) = "-mthreads" 2025 then 2026 Linker_Options.Table (J .. Linker_Options.Last - 1) := 2027 Linker_Options.Table (J + 1 .. Linker_Options.Last); 2028 Linker_Options.Decrement_Last; 2029 Num_Args := Num_Args - 1; 2030 2031 -- Replace "-L" by its counterpart "/LIBPATH:" and UNIX "/" by 2032 -- Windows "\". 2033 2034 elsif Linker_Options.Table (J) (1 .. 2) = "-L" then 2035 declare 2036 Libpath_Option : constant String_Access := new String' 2037 ("/LIBPATH:" & 2038 Linker_Options.Table 2039 (J) (3 .. Linker_Options.Table (J).all'Last)); 2040 begin 2041 for Index in 10 .. Libpath_Option'Last loop 2042 if Libpath_Option (Index) = '/' then 2043 Libpath_Option (Index) := '\'; 2044 end if; 2045 end loop; 2046 2047 Linker_Options.Table (J) := Libpath_Option; 2048 end; 2049 2050 -- Replace "-g" by "/DEBUG" 2051 2052 elsif Linker_Options.Table (J) (1 .. 2) = "-g" then 2053 Linker_Options.Table (J) := new String'("/DEBUG"); 2054 2055 -- Replace "-o" by "/OUT:" 2056 2057 elsif Linker_Options.Table (J) (1 .. 2) = "-o" then 2058 Linker_Options.Table (J + 1) := new String' 2059 ("/OUT:" & Linker_Options.Table (J + 1).all); 2060 2061 Linker_Options.Table (J .. Linker_Options.Last - 1) := 2062 Linker_Options.Table (J + 1 .. Linker_Options.Last); 2063 Linker_Options.Decrement_Last; 2064 Num_Args := Num_Args - 1; 2065 2066 -- Replace "--stack=" by "/STACK:" 2067 2068 elsif Linker_Options.Table (J) (1 .. 8) = "--stack=" then 2069 Linker_Options.Table (J) := new String' 2070 ("/STACK:" & 2071 Linker_Options.Table (J) 2072 (9 .. Linker_Options.Table (J).all'Last)); 2073 2074 -- Replace "-v" by its counterpart "/VERBOSE" 2075 2076 elsif Linker_Options.Table (J) (1 .. 2) = "-v" then 2077 Linker_Options.Table (J) := new String'("/VERBOSE"); 2078 end if; 2079 end loop; 2080 2081 -- Add some required flags to create RTSS modules 2082 2083 declare 2084 Flags_For_Linker : constant array (1 .. 17) of String_Access := 2085 (new String'("/NODEFAULTLIB"), 2086 new String'("/INCREMENTAL:NO"), 2087 new String'("/NOLOGO"), 2088 new String'("/DRIVER"), 2089 new String'("/ALIGN:0x20"), 2090 new String'("/SUBSYSTEM:NATIVE"), 2091 new String'("/ENTRY:_RtapiProcessEntryCRT@8"), 2092 new String'("/RELEASE"), 2093 new String'("startupCRT.obj"), 2094 new String'("rtxlibcmt.lib"), 2095 new String'("oldnames.lib"), 2096 new String'("rtapi_rtss.lib"), 2097 new String'("Rtx_Rtss.lib"), 2098 new String'("libkernel32.a"), 2099 new String'("libws2_32.a"), 2100 new String'("libmswsock.a"), 2101 new String'("libadvapi32.a")); 2102 -- These flags need to be passed to Microsoft linker. They 2103 -- come from the RTX documentation. 2104 2105 Gcc_Lib_Path : constant String_Access := new String' 2106 ("/LIBPATH:" & Include_Dir_Default_Prefix & "\..\"); 2107 -- Place to look for gcc related libraries, such as libgcc 2108 2109 begin 2110 -- Replace UNIX "/" by Windows "\" in the path 2111 2112 for Index in 10 .. Gcc_Lib_Path.all'Last loop 2113 if Gcc_Lib_Path (Index) = '/' then 2114 Gcc_Lib_Path (Index) := '\'; 2115 end if; 2116 end loop; 2117 2118 Linker_Options.Increment_Last; 2119 Linker_Options.Table (Linker_Options.Last) := Gcc_Lib_Path; 2120 Num_Args := Num_Args + 1; 2121 2122 for Index in Flags_For_Linker'Range loop 2123 Linker_Options.Increment_Last; 2124 Linker_Options.Table (Linker_Options.Last) := 2125 Flags_For_Linker (Index); 2126 Num_Args := Num_Args + 1; 2127 end loop; 2128 end; 2129 end if; 2130 2131 -- Remove duplicate stack size setting from the Linker_Options table. 2132 -- The stack setting option "-Xlinker --stack=R,C" can be found 2133 -- in one line when set by a pragma Linker_Options or in two lines 2134 -- ("-Xlinker" then "--stack=R,C") when set on the command line. We 2135 -- also check for the "-Wl,--stack=R" style option. 2136 2137 -- We must remove the second stack setting option instance because 2138 -- the one on the command line will always be the first one. And any 2139 -- subsequent stack setting option will overwrite the previous one. 2140 -- This is done especially for GNAT/NT where we set the stack size 2141 -- for tasking programs by a pragma in the NT specific tasking 2142 -- package System.Task_Primitives.Operations. 2143 2144 -- Note: This is not a FOR loop that runs from Linker_Options.First 2145 -- to Linker_Options.Last, since operations within the loop can 2146 -- modify the length of the table. 2147 2148 Clean_Link_Option_Set : declare 2149 J : Natural; 2150 Shared_Libgcc_Seen : Boolean := False; 2151 2152 begin 2153 J := Linker_Options.First; 2154 while J <= Linker_Options.Last loop 2155 if Linker_Options.Table (J).all = "-Xlinker" 2156 and then J < Linker_Options.Last 2157 and then Linker_Options.Table (J + 1)'Length > 8 2158 and then Linker_Options.Table (J + 1) (1 .. 8) = "--stack=" 2159 then 2160 if Stack_Op then 2161 Linker_Options.Table (J .. Linker_Options.Last - 2) := 2162 Linker_Options.Table (J + 2 .. Linker_Options.Last); 2163 Linker_Options.Decrement_Last; 2164 Linker_Options.Decrement_Last; 2165 Num_Args := Num_Args - 2; 2166 2167 else 2168 Stack_Op := True; 2169 end if; 2170 end if; 2171 2172 -- Remove duplicate -shared-libgcc switch 2173 2174 if Linker_Options.Table (J).all = Shared_Libgcc_String then 2175 if Shared_Libgcc_Seen then 2176 Linker_Options.Table (J .. Linker_Options.Last - 1) := 2177 Linker_Options.Table (J + 1 .. Linker_Options.Last); 2178 Linker_Options.Decrement_Last; 2179 Num_Args := Num_Args - 1; 2180 2181 else 2182 Shared_Libgcc_Seen := True; 2183 end if; 2184 end if; 2185 2186 -- Here we just check for a canonical form that matches the 2187 -- pragma Linker_Options set in the NT runtime. 2188 2189 if (Linker_Options.Table (J)'Length > 17 2190 and then Linker_Options.Table (J) (1 .. 17) = 2191 "-Xlinker --stack=") 2192 or else 2193 (Linker_Options.Table (J)'Length > 12 2194 and then Linker_Options.Table (J) (1 .. 12) = 2195 "-Wl,--stack=") 2196 then 2197 if Stack_Op then 2198 Linker_Options.Table (J .. Linker_Options.Last - 1) := 2199 Linker_Options.Table (J + 1 .. Linker_Options.Last); 2200 Linker_Options.Decrement_Last; 2201 Num_Args := Num_Args - 1; 2202 2203 else 2204 Stack_Op := True; 2205 end if; 2206 end if; 2207 2208 -- Remove duplicate IDENTIFICATION directives (VMS) 2209 2210 if Linker_Options.Table (J)'Length > 29 2211 and then Linker_Options.Table (J) (1 .. 30) = 2212 "--for-linker=--identification=" 2213 then 2214 if IDENT_Op then 2215 Linker_Options.Table (J .. Linker_Options.Last - 1) := 2216 Linker_Options.Table (J + 1 .. Linker_Options.Last); 2217 Linker_Options.Decrement_Last; 2218 Num_Args := Num_Args - 1; 2219 2220 else 2221 IDENT_Op := True; 2222 end if; 2223 end if; 2224 2225 J := J + 1; 2226 end loop; 2227 2228 if Linker_Path = Gcc_Path and then VM_Target = No_VM then 2229 2230 -- For systems where the default is to link statically with 2231 -- libgcc, if gcc is not called with -shared-libgcc, call it 2232 -- with -static-libgcc, as there are some platforms where one 2233 -- of these two switches is compulsory to link. 2234 2235 if Shared_Libgcc_Default = 'T' 2236 and then not Shared_Libgcc_Seen 2237 then 2238 Linker_Options.Increment_Last; 2239 Linker_Options.Table (Linker_Options.Last) := Static_Libgcc; 2240 Num_Args := Num_Args + 1; 2241 end if; 2242 2243 elsif RTX_RTSS_Kernel_Module_On_Target then 2244 2245 -- Force the use of the static libgcc for RTSS modules 2246 2247 Linker_Options.Increment_Last; 2248 Linker_Options.Table (Linker_Options.Last) := 2249 new String'("libgcc.a"); 2250 Num_Args := Num_Args + 1; 2251 end if; 2252 2253 end Clean_Link_Option_Set; 2254 2255 -- Prepare arguments for call to linker 2256 2257 Call_Linker : declare 2258 Success : Boolean; 2259 Args : Argument_List (1 .. Num_Args + 1); 2260 Index : Integer := Args'First; 2261 2262 begin 2263 Args (Index) := Binder_Obj_File; 2264 2265 -- Add the object files and any -largs libraries 2266 2267 for J in Linker_Objects.First .. Linker_Objects.Last loop 2268 Index := Index + 1; 2269 Args (Index) := Linker_Objects.Table (J); 2270 end loop; 2271 2272 -- Add the linker options from the binder file 2273 2274 for J in Linker_Options.First .. Linker_Options.Last loop 2275 Index := Index + 1; 2276 Args (Index) := Linker_Options.Table (J); 2277 end loop; 2278 2279 -- Finally add the libraries from the --GCC= switch 2280 2281 for J in Gcc_Linker_Options.First .. Gcc_Linker_Options.Last loop 2282 Index := Index + 1; 2283 Args (Index) := Gcc_Linker_Options.Table (J); 2284 end loop; 2285 2286 if Verbose_Mode then 2287 Write_Str (Linker_Path.all); 2288 2289 for J in Args'Range loop 2290 Write_Str (" "); 2291 Write_Str (Args (J).all); 2292 end loop; 2293 2294 Write_Eol; 2295 2296 -- If we are on very verbose mode (-v -v) and a response file 2297 -- is used we display its content. 2298 2299 if Very_Verbose_Mode and then Tname_FD /= Invalid_FD then 2300 Write_Eol; 2301 Write_Str ("Response file (" & 2302 Tname (Tname'First .. Tname'Last - 1) & 2303 ") content : "); 2304 Write_Eol; 2305 2306 for J in 2307 Response_File_Objects.First .. Response_File_Objects.Last 2308 loop 2309 Write_Str (Response_File_Objects.Table (J).all); 2310 Write_Eol; 2311 end loop; 2312 2313 Write_Eol; 2314 end if; 2315 end if; 2316 2317 System.OS_Lib.Spawn (Linker_Path.all, Args, Success); 2318 2319 if Success then 2320 2321 -- Delete the temporary file used in conjunction with linking 2322 -- if one was created. See Process_Bind_File for details. 2323 2324 if Tname_FD /= Invalid_FD then 2325 Delete (Tname); 2326 end if; 2327 2328 else 2329 Error_Msg ("error when calling " & Linker_Path.all); 2330 Exit_Program (E_Fatal); 2331 end if; 2332 end Call_Linker; 2333 end Link_Step; 2334 end if; 2335 2336 -- Only keep the binder output file and it's associated object 2337 -- file if compiling with the -g option. These files are only 2338 -- useful if debugging. 2339 2340 if not Debug_Flag_Present then 2341 Delete (Binder_Ali_File.all & ASCII.NUL); 2342 Delete (Binder_Spec_Src_File.all & ASCII.NUL); 2343 Delete (Binder_Body_Src_File.all & ASCII.NUL); 2344 2345 if VM_Target = No_VM then 2346 Delete (Binder_Obj_File.all & ASCII.NUL); 2347 end if; 2348 end if; 2349 2350 Exit_Program (E_Success); 2351 2352exception 2353 when X : others => 2354 Write_Line (Exception_Information (X)); 2355 Exit_With_Error ("INTERNAL ERROR. Please report"); 2356end Gnatlink; 2357