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