?  search:
summary | log | graphiclog1 | graphiclog2 | commit | commitdiff | tree | refs | edit | fork
blame | history | raw | HEAD
Makefile.in: Rebuilt.
[official-gcc.git] / gcc / ada / gnatlink.adb
blob5e5f144790fef25d471821a9bd1cd668fef9d29e
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-2006, 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 2, 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 COPYING. If not, write --
19 -- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
20 -- Boston, MA 02110-1301, USA. --
21 -- --
22 -- GNAT was originally developed by the GNAT team at New York University. --
23 -- Extensive contributions were provided by Ada Core Technologies Inc. --
24 -- --
25 ------------------------------------------------------------------------------
26
27 -- Gnatlink usage: please consult the gnat documentation
28
29 with ALI; use ALI;
30 with Csets;
31 with Gnatvsn; use Gnatvsn;
32 with Hostparm;
33 with Indepsw; use Indepsw;
34 with Namet; use Namet;
35 with Opt;
36 with Osint; use Osint;
37 with Output; use Output;
38 with Snames;
39 with Switch; use Switch;
40 with System; use System;
41 with Table;
42 with Targparm; use Targparm;
43 with Types;
44
45 with Ada.Command_Line; use Ada.Command_Line;
46 with Ada.Exceptions; use Ada.Exceptions;
47 with GNAT.OS_Lib; use GNAT.OS_Lib;
48 with Interfaces.C_Streams; use Interfaces.C_Streams;
49 with Interfaces.C.Strings; use Interfaces.C.Strings;
50 with System.CRTL;
51
52 procedure Gnatlink is
53 pragma Ident (Gnatvsn.Gnat_Static_Version_String);
54
55 Shared_Libgcc_String : constant String := "-shared-libgcc";
56 Shared_Libgcc : constant String_Access :=
57 new String'(Shared_Libgcc_String);
58 -- Used to invoke gcc when the binder is invoked with -shared
59
60 Static_Libgcc_String : constant String := "-static-libgcc";
61 Static_Libgcc : constant String_Access :=
62 new String'(Static_Libgcc_String);
63 -- Used to invoke gcc when shared libs are not used
64
65 package Gcc_Linker_Options is new Table.Table (
66 Table_Component_Type => String_Access,
67 Table_Index_Type => Integer,
68 Table_Low_Bound => 1,
69 Table_Initial => 20,
70 Table_Increment => 100,
71 Table_Name => "Gnatlink.Gcc_Linker_Options");
72 -- Comments needed ???
73
74 package Libpath is new Table.Table (
75 Table_Component_Type => Character,
76 Table_Index_Type => Integer,
77 Table_Low_Bound => 1,
78 Table_Initial => 4096,
79 Table_Increment => 100,
80 Table_Name => "Gnatlink.Libpath");
81 -- Comments needed ???
82
83 package Linker_Options is new Table.Table (
84 Table_Component_Type => String_Access,
85 Table_Index_Type => Integer,
86 Table_Low_Bound => 1,
87 Table_Initial => 20,
88 Table_Increment => 100,
89 Table_Name => "Gnatlink.Linker_Options");
90 -- Comments needed ???
91
92 package Linker_Objects is new Table.Table (
93 Table_Component_Type => String_Access,
94 Table_Index_Type => Integer,
95 Table_Low_Bound => 1,
96 Table_Initial => 20,
97 Table_Increment => 100,
98 Table_Name => "Gnatlink.Linker_Objects");
99 -- This table collects the objects file to be passed to the linker. In the
100 -- case where the linker command line is too long then programs objects
101 -- are put on the Response_File_Objects table. Note that the binder object
102 -- file and the user's objects remain in this table. This is very
103 -- important because on the GNU linker command line the -L switch is not
104 -- used to look for objects files but -L switch is used to look for
105 -- objects listed in the response file. This is not a problem with the
106 -- applications objects as they are specified with a fullname.
107
108 package Response_File_Objects is new Table.Table (
109 Table_Component_Type => String_Access,
110 Table_Index_Type => Integer,
111 Table_Low_Bound => 1,
112 Table_Initial => 20,
113 Table_Increment => 100,
114 Table_Name => "Gnatlink.Response_File_Objects");
115 -- This table collects the objects file that are to be put in the response
116 -- file. Only application objects are collected there (see details in
117 -- Linker_Objects table comments)
118
119 package Binder_Options_From_ALI is new Table.Table (
120 Table_Component_Type => String_Access,
121 Table_Index_Type => Integer,
122 Table_Low_Bound => 1, -- equals low bound of Argument_List for Spawn
123 Table_Initial => 20,
124 Table_Increment => 100,
125 Table_Name => "Gnatlink.Binder_Options_From_ALI");
126 -- This table collects the switches from the ALI file of the main
127 -- subprogram.
128
129 package Binder_Options is new Table.Table (
130 Table_Component_Type => String_Access,
131 Table_Index_Type => Integer,
132 Table_Low_Bound => 1, -- equals low bound of Argument_List for Spawn
133 Table_Initial => 20,
134 Table_Increment => 100,
135 Table_Name => "Gnatlink.Binder_Options");
136 -- This table collects the arguments to be passed to compile the binder
137 -- generated file.
138
139 Gcc : String_Access := Program_Name ("gcc");
140
141 Read_Mode : constant String := "r" & ASCII.Nul;
142
143 Begin_Info : String := "-- BEGIN Object file/option list";
144 End_Info : String := "-- END Object file/option list ";
145 -- Note: above lines are modified in C mode, see option processing
146
147 Gcc_Path : String_Access;
148 Linker_Path : String_Access;
149
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 pragma Import
180 (C, Object_List_File_Supported, "__gnat_objlist_file_supported");
181 -- Predicate indicating whether the linker has an option whereby the
182 -- names of object files can be passed to the linker in a file.
183
184 Object_List_File_Required : Boolean := False;
185 -- Set to True to force generation of a response file
186
187 function Base_Name (File_Name : String) return String;
188 -- Return just the file name part without the extension (if present)
189
190 procedure Delete (Name : String);
191 -- Wrapper to unlink as status is ignored by this application
192
193 procedure Error_Msg (Message : String);
194 -- Output the error or warning Message
195
196 procedure Exit_With_Error (Error : String);
197 -- Output Error and exit program with a fatal condition
198
199 procedure Process_Args;
200 -- Go through all the arguments and build option tables
201
202 procedure Process_Binder_File (Name : String);
203 -- Reads the binder file and extracts linker arguments
204
205 procedure Write_Header;
206 -- Show user the program name, version and copyright
207
208 procedure Write_Usage;
209 -- Show user the program options
210
211 ---------------
212 -- Base_Name --
213 ---------------
214
215 function Base_Name (File_Name : String) return String is
216 Findex1 : Natural;
217 Findex2 : Natural;
218
219 begin
220 Findex1 := File_Name'First;
221
222 -- The file might be specified by a full path name. However,
223 -- we want the path to be stripped away.
224
225 for J in reverse File_Name'Range loop
226 if Is_Directory_Separator (File_Name (J)) then
227 Findex1 := J + 1;
228 exit;
229 end if;
230 end loop;
231
232 Findex2 := File_Name'Last;
233 while Findex2 > Findex1
234 and then File_Name (Findex2) /= '.'
235 loop
236 Findex2 := Findex2 - 1;
237 end loop;
238
239 if Findex2 = Findex1 then
240 Findex2 := File_Name'Last + 1;
241 end if;
242
243 return File_Name (Findex1 .. Findex2 - 1);
244 end Base_Name;
245
246 ------------
247 -- Delete --
248 ------------
249
250 procedure Delete (Name : String) is
251 Status : int;
252 pragma Unreferenced (Status);
253 begin
254 Status := unlink (Name'Address);
255 -- Is it really right to ignore an error here ???
256 end Delete;
257
258 ---------------
259 -- Error_Msg --
260 ---------------
261
262 procedure Error_Msg (Message : String) is
263 begin
264 Write_Str (Base_Name (Command_Name));
265 Write_Str (": ");
266 Write_Str (Message);
267 Write_Eol;
268 end Error_Msg;
269
270 ---------------------
271 -- Exit_With_Error --
272 ---------------------
273
274 procedure Exit_With_Error (Error : String) is
275 begin
276 Error_Msg (Error);
277 Exit_Program (E_Fatal);
278 end Exit_With_Error;
279
280 ------------------
281 -- Process_Args --
282 ------------------
283
284 procedure Process_Args is
285 Next_Arg : Integer;
286 Skip_Next : Boolean := False;
287 -- Set to true if the next argument is to be added into the list of
288 -- linker's argument without parsing it.
289
290 begin
291 -- Loop through arguments of gnatlink command
292
293 Next_Arg := 1;
294 loop
295 exit when Next_Arg > Argument_Count;
296
297 Process_One_Arg : declare
298 Arg : constant String := Argument (Next_Arg);
299
300 begin
301 -- Case of argument which is a switch
302
303 -- We definitely need section by section comments here ???
304
305 if Skip_Next then
306
307 -- This argument must not be parsed, just add it to the
308 -- list of linker's options.
309
310 Skip_Next := False;
311
312 Linker_Options.Increment_Last;
313 Linker_Options.Table (Linker_Options.Last) :=
314 new String'(Arg);
315
316 elsif Arg'Length /= 0 and then Arg (1) = '-' then
317 if Arg'Length > 4 and then Arg (2 .. 5) = "gnat" then
318 Exit_With_Error
319 ("invalid switch: """ & Arg & """ (gnat not needed here)");
320 end if;
321
322 if Arg = "-Xlinker" then
323
324 -- Next argument should be sent directly to the linker.
325 -- We do not want to parse it here.
326
327 Skip_Next := True;
328
329 Linker_Options.Increment_Last;
330 Linker_Options.Table (Linker_Options.Last) :=
331 new String'(Arg);
332
333 elsif Arg (2) = 'g'
334 and then (Arg'Length < 5 or else Arg (2 .. 5) /= "gnat")
335 then
336 Debug_Flag_Present := True;
337
338 Linker_Options.Increment_Last;
339 Linker_Options.Table (Linker_Options.Last) :=
340 new String'(Arg);
341
342 Binder_Options.Increment_Last;
343 Binder_Options.Table (Binder_Options.Last) :=
344 Linker_Options.Table (Linker_Options.Last);
345
346 elsif Arg'Length >= 3 and then Arg (2) = 'M' then
347 declare
348 Switches : String_List_Access;
349
350 begin
351 Convert (Map_File, Arg (3 .. Arg'Last), Switches);
352
353 if Switches /= null then
354 for J in Switches'Range loop
355 Linker_Options.Increment_Last;
356 Linker_Options.Table (Linker_Options.Last) :=
357 Switches (J);
358 end loop;
359 end if;
360 end;
361
362 elsif Arg'Length = 2 then
363 case Arg (2) is
364 when 'A' =>
365 Ada_Bind_File := True;
366 Begin_Info := "-- BEGIN Object file/option list";
367 End_Info := "-- END Object file/option list ";
368
369 when 'b' =>
370 Linker_Options.Increment_Last;
371 Linker_Options.Table (Linker_Options.Last) :=
372 new String'(Arg);
373
374 Binder_Options.Increment_Last;
375 Binder_Options.Table (Binder_Options.Last) :=
376 Linker_Options.Table (Linker_Options.Last);
377
378 Next_Arg := Next_Arg + 1;
379
380 if Next_Arg > Argument_Count then
381 Exit_With_Error ("Missing argument for -b");
382 end if;
383
384 Get_Machine_Name : declare
385 Name_Arg : constant String_Access :=
386 new String'(Argument (Next_Arg));
387
388 begin
389 Linker_Options.Increment_Last;
390 Linker_Options.Table (Linker_Options.Last) :=
391 Name_Arg;
392
393 Binder_Options.Increment_Last;
394 Binder_Options.Table (Binder_Options.Last) :=
395 Name_Arg;
396
397 end Get_Machine_Name;
398
399 when 'C' =>
400 Ada_Bind_File := False;
401 Begin_Info := "/* BEGIN Object file/option list";
402 End_Info := " END Object file/option list */";
403
404 when 'f' =>
405 if Object_List_File_Supported then
406 Object_List_File_Required := True;
407 else
408 Exit_With_Error
409 ("Object list file not supported on this target");
410 end if;
411
412 when 'M' =>
413 Create_Map_File := True;
414
415 when 'n' =>
416 Compile_Bind_File := False;
417
418 when 'o' =>
419 Linker_Options.Increment_Last;
420 Linker_Options.Table (Linker_Options.Last) :=
421 new String'(Arg);
422
423 Next_Arg := Next_Arg + 1;
424
425 if Next_Arg > Argument_Count then
426 Exit_With_Error ("Missing argument for -o");
427 end if;
428
429 Output_File_Name := new String'(Argument (Next_Arg));
430
431 Linker_Options.Increment_Last;
432 Linker_Options.Table (Linker_Options.Last) :=
433 Output_File_Name;
434
435 when 'R' =>
436 Opt.Run_Path_Option := False;
437
438 when 'v' =>
439
440 -- Support "double" verbose mode. Second -v
441 -- gets sent to the linker and binder phases.
442
443 if Verbose_Mode then
444 Very_Verbose_Mode := True;
445
446 Linker_Options.Increment_Last;
447 Linker_Options.Table (Linker_Options.Last) :=
448 new String'(Arg);
449
450 Binder_Options.Increment_Last;
451 Binder_Options.Table (Binder_Options.Last) :=
452 Linker_Options.Table (Linker_Options.Last);
453
454 else
455 Verbose_Mode := True;
456
457 end if;
458
459 when others =>
460 Linker_Options.Increment_Last;
461 Linker_Options.Table (Linker_Options.Last) :=
462 new String'(Arg);
463
464 end case;
465
466 elsif Arg (2) = 'B' then
467 Linker_Options.Increment_Last;
468 Linker_Options.Table (Linker_Options.Last) :=
469 new String'(Arg);
470
471 Binder_Options.Increment_Last;
472 Binder_Options.Table (Binder_Options.Last) :=
473 Linker_Options.Table (Linker_Options.Last);
474
475 elsif Arg'Length >= 7 and then Arg (1 .. 7) = "--LINK=" then
476 if Arg'Length = 7 then
477 Exit_With_Error ("Missing argument for --LINK=");
478 end if;
479
480 Linker_Path :=
481 GNAT.OS_Lib.Locate_Exec_On_Path (Arg (8 .. Arg'Last));
482
483 if Linker_Path = null then
484 Exit_With_Error
485 ("Could not locate linker: " & Arg (8 .. Arg'Last));
486 end if;
487
488 elsif Arg'Length > 6 and then Arg (1 .. 6) = "--GCC=" then
489 declare
490 Program_Args : constant Argument_List_Access :=
491 Argument_String_To_List
492 (Arg (7 .. Arg'Last));
493
494 begin
495 Gcc := new String'(Program_Args.all (1).all);
496 Standard_Gcc := False;
497
498 -- Set appropriate flags for switches passed
499
500 for J in 2 .. Program_Args.all'Last loop
501 declare
502 Arg : constant String := Program_Args.all (J).all;
503 AF : constant Integer := Arg'First;
504
505 begin
506 if Arg'Length /= 0 and then Arg (AF) = '-' then
507 if Arg (AF + 1) = 'g'
508 and then (Arg'Length = 2
509 or else Arg (AF + 2) in '0' .. '3'
510 or else Arg (AF + 2 .. Arg'Last) = "coff")
511 then
512 Debug_Flag_Present := True;
513 end if;
514 end if;
515
516 -- Add directory to source search dirs so that
517 -- Get_Target_Parameters can find system.ads
518
519 if Arg (AF .. AF + 1) = "-I"
520 and then Arg'Length > 2
521 then
522 Add_Src_Search_Dir (Arg (AF + 2 .. Arg'Last));
523 end if;
524
525 -- Pass to gcc for compiling binder generated file
526 -- No use passing libraries, it will just generate
527 -- a warning
528
529 if not (Arg (AF .. AF + 1) = "-l"
530 or else Arg (AF .. AF + 1) = "-L")
531 then
532 Binder_Options.Increment_Last;
533 Binder_Options.Table (Binder_Options.Last) :=
534 new String'(Arg);
535 end if;
536
537 -- Pass to gcc for linking program
538
539 Gcc_Linker_Options.Increment_Last;
540 Gcc_Linker_Options.Table
541 (Gcc_Linker_Options.Last) := new String'(Arg);
542 end;
543 end loop;
544 end;
545
546 -- Send all multi-character switches not recognized as
547 -- a special case by gnatlink to the linker/loader stage.
548
549 else
550 Linker_Options.Increment_Last;
551 Linker_Options.Table (Linker_Options.Last) :=
552 new String'(Arg);
553 end if;
554
555 -- Here if argument is a file name rather than a switch
556
557 else
558 -- If explicit ali file, capture it
559
560 if Arg'Length > 4
561 and then Arg (Arg'Last - 3 .. Arg'Last) = ".ali"
562 then
563 if Ali_File_Name = null then
564 Ali_File_Name := new String'(Arg);
565 else
566 Exit_With_Error ("cannot handle more than one ALI file");
567 end if;
568
569 -- If target object file, record object file
570
571 elsif Arg'Length > Get_Target_Object_Suffix.all'Length
572 and then Arg
573 (Arg'Last -
574 Get_Target_Object_Suffix.all'Length + 1 .. Arg'Last)
575 = Get_Target_Object_Suffix.all
576 then
577 Linker_Objects.Increment_Last;
578 Linker_Objects.Table (Linker_Objects.Last) :=
579 new String'(Arg);
580
581 -- If host object file, record object file
582 -- e.g. accept foo.o as well as foo.obj on VMS target
583
584 elsif Arg'Length > Get_Object_Suffix.all'Length
585 and then Arg
586 (Arg'Last - Get_Object_Suffix.all'Length + 1 .. Arg'Last)
587 = Get_Object_Suffix.all
588 then
589 Linker_Objects.Increment_Last;
590 Linker_Objects.Table (Linker_Objects.Last) :=
591 new String'(Arg);
592
593 -- If corresponding ali file exists, capture it
594
595 elsif Ali_File_Name = null
596 and then Is_Regular_File (Arg & ".ali")
597 then
598 Ali_File_Name := new String'(Arg & ".ali");
599
600 -- Otherwise assume this is a linker options entry, but
601 -- see below for interesting adjustment to this assumption.
602
603 else
604 Linker_Options.Increment_Last;
605 Linker_Options.Table (Linker_Options.Last) :=
606 new String'(Arg);
607 end if;
608 end if;
609 end Process_One_Arg;
610
611 Next_Arg := Next_Arg + 1;
612 end loop;
613
614 -- If Ada bind file, then compile it with warnings suppressed, because
615 -- otherwise the with of the main program may cause junk warnings.
616
617 if Ada_Bind_File then
618 Binder_Options.Increment_Last;
619 Binder_Options.Table (Binder_Options.Last) := new String'("-gnatws");
620 end if;
621
622 -- If we did not get an ali file at all, and we had at least one
623 -- linker option, then assume that was the intended ali file after
624 -- all, so that we get a nicer message later on.
625
626 if Ali_File_Name = null
627 and then Linker_Options.Last >= Linker_Options.First
628 then
629 Ali_File_Name :=
630 new String'(Linker_Options.Table (Linker_Options.First).all &
631 ".ali");
632 end if;
633 end Process_Args;
634
635 -------------------------
636 -- Process_Binder_File --
637 -------------------------
638
639 procedure Process_Binder_File (Name : String) is
640 Fd : FILEs;
641 -- Binder file's descriptor
642
643 Link_Bytes : Integer := 0;
644 -- Projected number of bytes for the linker command line
645
646 Link_Max : Integer;
647 pragma Import (C, Link_Max, "__gnat_link_max");
648 -- Maximum number of bytes on the command line supported by the OS
649 -- linker. Passed this limit the response file mechanism must be used
650 -- if supported.
651
652 Next_Line : String (1 .. 1000);
653 -- Current line value
654
655 Nlast : Integer;
656 Nfirst : Integer;
657 -- Current line slice (the slice does not contain line terminator)
658
659 Last : Integer;
660 -- Current line last character for shared libraries (without version)
661
662 Objs_Begin : Integer := 0;
663 -- First object file index in Linker_Objects table
664
665 Objs_End : Integer := 0;
666 -- Last object file index in Linker_Objects table
667
668 Status : int;
669 pragma Warnings (Off, Status);
670 -- Used for various Interfaces.C_Streams calls
671
672 Closing_Status : Boolean;
673 -- For call to Close
674
675 GNAT_Static : Boolean := False;
676 -- Save state of -static option
677
678 GNAT_Shared : Boolean := False;
679 -- Save state of -shared option
680
681 Xlinker_Was_Previous : Boolean := False;
682 -- Indicate that "-Xlinker" was the option preceding the current
683 -- option. If True, then the current option is never suppressed.
684
685 -- Rollback data
686
687 -- These data items are used to store current binder file context.
688 -- The context is composed of the file descriptor position and the
689 -- current line together with the slice indexes (first and last
690 -- position) for this line. The rollback data are used by the
691 -- Store_File_Context and Rollback_File_Context routines below.
692 -- The file context mechanism interact only with the Get_Next_Line
693 -- call. For example:
694
695 -- Store_File_Context;
696 -- Get_Next_Line;
697 -- Rollback_File_Context;
698 -- Get_Next_Line;
699
700 -- Both Get_Next_Line calls above will read the exact same data from
701 -- the file. In other words, Next_Line, Nfirst and Nlast variables
702 -- will be set with the exact same values.
703
704 RB_File_Pos : long; -- File position
705 RB_Next_Line : String (1 .. 1000); -- Current line content
706 RB_Nlast : Integer; -- Slice last index
707 RB_Nfirst : Integer; -- Slice first index
708
709 Run_Path_Option_Ptr : Interfaces.C.Strings.chars_ptr;
710 pragma Import (C, Run_Path_Option_Ptr, "__gnat_run_path_option");
711 -- Pointer to string representing the native linker option which
712 -- specifies the path where the dynamic loader should find shared
713 -- libraries. Equal to null string if this system doesn't support it.
714
715 Object_Library_Ext_Ptr : Interfaces.C.Strings.chars_ptr;
716 pragma Import
717 (C, Object_Library_Ext_Ptr, "__gnat_object_library_extension");
718 -- Pointer to string specifying the default extension for
719 -- object libraries, e.g. Unix uses ".a", VMS uses ".olb".
720
721 Object_File_Option_Ptr : Interfaces.C.Strings.chars_ptr;
722 pragma Import (C, Object_File_Option_Ptr, "__gnat_object_file_option");
723 -- Pointer to a string representing the linker option which specifies
724 -- the response file.
725
726 Using_GNU_Linker : Boolean;
727 pragma Import (C, Using_GNU_Linker, "__gnat_using_gnu_linker");
728 -- Predicate indicating whether this target uses the GNU linker. In
729 -- this case we must output a GNU linker compatible response file.
730
731 Opening : aliased constant String := """";
732 Closing : aliased constant String := '"' & ASCII.LF;
733 -- Needed to quote object paths in object list files when GNU linker
734 -- is used.
735
736 procedure Get_Next_Line;
737 -- Read the next line from the binder file without the line
738 -- terminator.
739
740 function Index (S, Pattern : String) return Natural;
741 -- Return the last occurrence of Pattern in S, or 0 if none
742
743 function Is_Option_Present (Opt : String) return Boolean;
744 -- Return true if the option Opt is already present in
745 -- Linker_Options table.
746
747 procedure Store_File_Context;
748 -- Store current file context, Fd position and current line data.
749 -- The file context is stored into the rollback data above (RB_*).
750 -- Store_File_Context can be called at any time, only the last call
751 -- will be used (i.e. this routine overwrites the file context).
752
753 procedure Rollback_File_Context;
754 -- Restore file context from rollback data. This routine must be called
755 -- after Store_File_Context. The binder file context will be restored
756 -- with the data stored by the last Store_File_Context call.
757
758 -------------------
759 -- Get_Next_Line --
760 -------------------
761
762 procedure Get_Next_Line is
763 Fchars : chars;
764
765 begin
766 Fchars := fgets (Next_Line'Address, Next_Line'Length, Fd);
767
768 if Fchars = System.Null_Address then
769 Exit_With_Error ("Error reading binder output");
770 end if;
771
772 Nfirst := Next_Line'First;
773 Nlast := Nfirst;
774 while Nlast <= Next_Line'Last
775 and then Next_Line (Nlast) /= ASCII.LF
776 and then Next_Line (Nlast) /= ASCII.CR
777 loop
778 Nlast := Nlast + 1;
779 end loop;
780
781 Nlast := Nlast - 1;
782 end Get_Next_Line;
783
784 -----------
785 -- Index --
786 -----------
787
788 function Index (S, Pattern : String) return Natural is
789 Len : constant Natural := Pattern'Length;
790
791 begin
792 for J in reverse S'First .. S'Last - Len + 1 loop
793 if Pattern = S (J .. J + Len - 1) then
794 return J;
795 end if;
796 end loop;
797
798 return 0;
799 end Index;
800
801 -----------------------
802 -- Is_Option_Present --
803 -----------------------
804
805 function Is_Option_Present (Opt : String) return Boolean is
806 begin
807 for I in 1 .. Linker_Options.Last loop
808
809 if Linker_Options.Table (I).all = Opt then
810 return True;
811 end if;
812
813 end loop;
814
815 return False;
816 end Is_Option_Present;
817
818 ---------------------------
819 -- Rollback_File_Context --
820 ---------------------------
821
822 procedure Rollback_File_Context is
823 begin
824 Next_Line := RB_Next_Line;
825 Nfirst := RB_Nfirst;
826 Nlast := RB_Nlast;
827 Status := fseek (Fd, RB_File_Pos, Interfaces.C_Streams.SEEK_SET);
828
829 if Status = -1 then
830 Exit_With_Error ("Error setting file position");
831 end if;
832 end Rollback_File_Context;
833
834 ------------------------
835 -- Store_File_Context --
836 ------------------------
837
838 procedure Store_File_Context is
839 use type System.CRTL.long;
840 begin
841 RB_Next_Line := Next_Line;
842 RB_Nfirst := Nfirst;
843 RB_Nlast := Nlast;
844 RB_File_Pos := ftell (Fd);
845
846 if RB_File_Pos = -1 then
847 Exit_With_Error ("Error getting file position");
848 end if;
849 end Store_File_Context;
850
851 -- Start of processing for Process_Binder_File
852
853 begin
854 Fd := fopen (Name'Address, Read_Mode'Address);
855
856 if Fd = NULL_Stream then
857 Exit_With_Error ("Failed to open binder output");
858 end if;
859
860 -- Skip up to the Begin Info line
861
862 loop
863 Get_Next_Line;
864 exit when Next_Line (Nfirst .. Nlast) = Begin_Info;
865 end loop;
866
867 loop
868 Get_Next_Line;
869
870 -- Go to end when end line is reached (this will happen in
871 -- High_Integrity_Mode where no -L switches are generated)
872
873 exit when Next_Line (Nfirst .. Nlast) = End_Info;
874
875 if Ada_Bind_File then
876 Next_Line (Nfirst .. Nlast - 8) :=
877 Next_Line (Nfirst + 8 .. Nlast);
878 Nlast := Nlast - 8;
879 end if;
880
881 -- Go to next section when switches are reached
882
883 exit when Next_Line (1) = '-';
884
885 -- Otherwise we have another object file to collect
886
887 Linker_Objects.Increment_Last;
888
889 -- Mark the positions of first and last object files in case
890 -- they need to be placed with a named file on systems having
891 -- linker line limitations.
892
893 if Objs_Begin = 0 then
894 Objs_Begin := Linker_Objects.Last;
895 end if;
896
897 Linker_Objects.Table (Linker_Objects.Last) :=
898 new String'(Next_Line (Nfirst .. Nlast));
899
900 Link_Bytes := Link_Bytes + Nlast - Nfirst + 2;
901 -- Nlast - Nfirst + 1, for the size, plus one for the space between
902 -- each arguments.
903 end loop;
904
905 Objs_End := Linker_Objects.Last;
906
907 -- Let's continue to compute the Link_Bytes, the linker options are
908 -- part of command line length.
909
910 Store_File_Context;
911
912 while Next_Line (Nfirst .. Nlast) /= End_Info loop
913 Link_Bytes := Link_Bytes + Nlast - Nfirst + 2;
914 -- See comment above
915 Get_Next_Line;
916 end loop;
917
918 Rollback_File_Context;
919
920 -- On systems that have limitations on handling very long linker lines
921 -- we make use of the system linker option which takes a list of object
922 -- file names from a file instead of the command line itself. What we do
923 -- is to replace the list of object files by the special linker option
924 -- which then reads the object file list from a file instead. The option
925 -- to read from a file instead of the command line is only triggered if
926 -- a conservative threshold is passed.
927
928 if Object_List_File_Required
929 or else (Object_List_File_Supported
930 and then Link_Bytes > Link_Max)
931 then
932 -- Create a temporary file containing the Ada user object files
933 -- needed by the link. This list is taken from the bind file
934 -- and is output one object per line for maximal compatibility with
935 -- linkers supporting this option.
936
937 Create_Temp_File (Tname_FD, Tname);
938
939 -- ??? File descriptor should be checked to not be Invalid_FD.
940 -- ??? Status of Write and Close operations should be checked, and
941 -- failure should occur if a status is wrong.
942
943 -- If target is using the GNU linker we must add a special header
944 -- and footer in the response file.
945
946 -- The syntax is : INPUT (object1.o object2.o ... )
947
948 -- Because the GNU linker does not like name with characters such
949 -- as '!', we must put the object paths between double quotes.
950
951 if Using_GNU_Linker then
952 declare
953 GNU_Header : aliased constant String := "INPUT (";
954
955 begin
956 Status := Write (Tname_FD, GNU_Header'Address,
957 GNU_Header'Length);
958 end;
959 end if;
960
961 for J in Objs_Begin .. Objs_End loop
962
963 -- Opening quote for GNU linker
964
965 if Using_GNU_Linker then
966 Status := Write (Tname_FD, Opening'Address, 1);
967 end if;
968
969 Status := Write (Tname_FD, Linker_Objects.Table (J).all'Address,
970 Linker_Objects.Table (J).all'Length);
971
972 -- Closing quote for GNU linker
973
974 if Using_GNU_Linker then
975 Status := Write (Tname_FD, Closing'Address, 2);
976
977 else
978 Status := Write (Tname_FD, ASCII.LF'Address, 1);
979 end if;
980
981 Response_File_Objects.Increment_Last;
982 Response_File_Objects.Table (Response_File_Objects.Last) :=
983 Linker_Objects.Table (J);
984 end loop;
985
986 -- Handle GNU linker response file footer
987
988 if Using_GNU_Linker then
989 declare
990 GNU_Footer : aliased constant String := ")";
991
992 begin
993 Status := Write (Tname_FD, GNU_Footer'Address,
994 GNU_Footer'Length);
995 end;
996 end if;
997
998 Close (Tname_FD, Closing_Status);
999
1000 -- Add the special objects list file option together with the name
1001 -- of the temporary file (removing the null character) to the objects
1002 -- file table.
1003
1004 Linker_Objects.Table (Objs_Begin) :=
1005 new String'(Value (Object_File_Option_Ptr) &
1006 Tname (Tname'First .. Tname'Last - 1));
1007
1008 -- The slots containing these object file names are then removed
1009 -- from the objects table so they do not appear in the link. They
1010 -- are removed by moving up the linker options and non-Ada object
1011 -- files appearing after the Ada object list in the table.
1012
1013 declare
1014 N : Integer;
1015
1016 begin
1017 N := Objs_End - Objs_Begin + 1;
1018
1019 for J in Objs_End + 1 .. Linker_Objects.Last loop
1020 Linker_Objects.Table (J - N + 1) := Linker_Objects.Table (J);
1021 end loop;
1022
1023 Linker_Objects.Set_Last (Linker_Objects.Last - N + 1);
1024 end;
1025 end if;
1026
1027 -- Process switches and options
1028
1029 if Next_Line (Nfirst .. Nlast) /= End_Info then
1030 Xlinker_Was_Previous := False;
1031
1032 loop
1033 if Xlinker_Was_Previous
1034 or else Next_Line (Nfirst .. Nlast) = "-Xlinker"
1035 then
1036 Linker_Options.Increment_Last;
1037 Linker_Options.Table (Linker_Options.Last) :=
1038 new String'(Next_Line (Nfirst .. Nlast));
1039
1040 elsif Next_Line (Nfirst .. Nlast) = "-static" then
1041 GNAT_Static := True;
1042
1043 elsif Next_Line (Nfirst .. Nlast) = "-shared" then
1044 GNAT_Shared := True;
1045
1046 -- Add binder options only if not already set on the command
1047 -- line. This rule is a way to control the linker options order.
1048
1049 -- The following test needs comments, why is it VMS specific.
1050 -- The above comment looks out of date ???
1051
1052 elsif not (OpenVMS_On_Target
1053 and then
1054 Is_Option_Present (Next_Line (Nfirst .. Nlast)))
1055 then
1056 if Nlast > Nfirst + 2 and then
1057 Next_Line (Nfirst .. Nfirst + 1) = "-L"
1058 then
1059 -- Construct a library search path for use later
1060 -- to locate static gnatlib libraries.
1061
1062 if Libpath.Last > 1 then
1063 Libpath.Increment_Last;
1064 Libpath.Table (Libpath.Last) := Path_Separator;
1065 end if;
1066
1067 for I in Nfirst + 2 .. Nlast loop
1068 Libpath.Increment_Last;
1069 Libpath.Table (Libpath.Last) := Next_Line (I);
1070 end loop;
1071
1072 Linker_Options.Increment_Last;
1073
1074 Linker_Options.Table (Linker_Options.Last) :=
1075 new String'(Next_Line (Nfirst .. Nlast));
1076
1077 elsif Next_Line (Nfirst .. Nlast) = "-ldecgnat"
1078 or else Next_Line (Nfirst .. Nlast) = "-lgnarl"
1079 or else Next_Line (Nfirst .. Nlast) = "-lgnat"
1080 or else Next_Line
1081 (1 .. Natural'Min (Nlast, 8 + Library_Version'Length)) =
1082 Shared_Lib ("gnarl")
1083 or else Next_Line
1084 (1 .. Natural'Min (Nlast, 7 + Library_Version'Length)) =
1085 Shared_Lib ("gnat")
1086 then
1087 -- If it is a shared library, remove the library version.
1088 -- We will be looking for the static version of the library
1089 -- as it is in the same directory as the shared version.
1090
1091 if Next_Line (Nlast - Library_Version'Length + 1 .. Nlast)
1092 = Library_Version
1093 then
1094 -- Set Last to point to last character before the
1095 -- library version.
1096
1097 Last := Nlast - Library_Version'Length - 1;
1098 else
1099 Last := Nlast;
1100 end if;
1101
1102 -- Given a Gnat standard library, search the
1103 -- library path to find the library location
1104
1105 declare
1106 File_Path : String_Access;
1107
1108 Object_Lib_Extension : constant String :=
1109 Value (Object_Library_Ext_Ptr);
1110
1111 File_Name : constant String := "lib" &
1112 Next_Line (Nfirst + 2 .. Last) &
1113 Object_Lib_Extension;
1114
1115 Run_Path_Opt : constant String :=
1116 Value (Run_Path_Option_Ptr);
1117
1118 GCC_Index : Natural;
1119 Run_Path_Opt_Index : Natural := 0;
1120
1121 begin
1122 File_Path :=
1123 Locate_Regular_File (File_Name,
1124 String (Libpath.Table (1 .. Libpath.Last)));
1125
1126 if File_Path /= null then
1127 if GNAT_Static then
1128
1129 -- If static gnatlib found, explicitly
1130 -- specify to overcome possible linker
1131 -- default usage of shared version.
1132
1133 Linker_Options.Increment_Last;
1134
1135 Linker_Options.Table (Linker_Options.Last) :=
1136 new String'(File_Path.all);
1137
1138 elsif GNAT_Shared then
1139 if Opt.Run_Path_Option then
1140 -- If shared gnatlib desired, add the
1141 -- appropriate system specific switch
1142 -- so that it can be located at runtime.
1143
1144 if Run_Path_Opt'Length /= 0 then
1145 -- Output the system specific linker command
1146 -- that allows the image activator to find
1147 -- the shared library at runtime.
1148 -- Also add path to find libgcc_s.so, if
1149 -- relevant.
1150
1151 -- To find the location of the shared version
1152 -- of libgcc, we look for "gcc-lib" in the
1153 -- path of the library. However, this
1154 -- subdirectory is no longer present in
1155 -- in recent version of GCC. So, we look for
1156 -- the last subdirectory "lib" in the path.
1157
1158 GCC_Index :=
1159 Index (File_Path.all, "gcc-lib");
1160
1161 if GCC_Index /= 0 then
1162 -- The shared version of libgcc is
1163 -- located in the parent directory.
1164
1165 GCC_Index := GCC_Index - 1;
1166
1167 else
1168 GCC_Index :=
1169 Index (File_Path.all, "/lib/");
1170
1171 if GCC_Index = 0 then
1172 GCC_Index :=
1173 Index (File_Path.all,
1174 Directory_Separator &
1175 "lib" &
1176 Directory_Separator);
1177 end if;
1178
1179 -- We have found a subdirectory "lib",
1180 -- this is where the shared version of
1181 -- libgcc should be located.
1182
1183 if GCC_Index /= 0 then
1184 GCC_Index := GCC_Index + 3;
1185 end if;
1186 end if;
1187
1188 -- Look for an eventual run_path_option in
1189 -- the linker switches.
1190
1191 for J in reverse 1 .. Linker_Options.Last loop
1192 if Linker_Options.Table (J) /= null
1193 and then
1194 Linker_Options.Table (J)'Length
1195 > Run_Path_Opt'Length
1196 and then
1197 Linker_Options.Table (J)
1198 (1 .. Run_Path_Opt'Length) =
1199 Run_Path_Opt
1200 then
1201 -- We have found a already specified
1202 -- run_path_option: we will add to this
1203 -- switch, because only one
1204 -- run_path_option should be specified.
1205
1206 Run_Path_Opt_Index := J;
1207 exit;
1208 end if;
1209 end loop;
1210
1211 -- If there is no run_path_option, we need
1212 -- to add one.
1213
1214 if Run_Path_Opt_Index = 0 then
1215 Linker_Options.Increment_Last;
1216 end if;
1217
1218 if GCC_Index = 0 then
1219 if Run_Path_Opt_Index = 0 then
1220 Linker_Options.Table
1221 (Linker_Options.Last) :=
1222 new String'
1223 (Run_Path_Opt
1224 & File_Path
1225 (1 .. File_Path'Length
1226 - File_Name'Length));
1227
1228 else
1229 Linker_Options.Table
1230 (Run_Path_Opt_Index) :=
1231 new String'
1232 (Linker_Options.Table
1233 (Run_Path_Opt_Index).all
1234 & Path_Separator
1235 & File_Path
1236 (1 .. File_Path'Length
1237 - File_Name'Length));
1238 end if;
1239
1240 else
1241 if Run_Path_Opt_Index = 0 then
1242 Linker_Options.Table
1243 (Linker_Options.Last) :=
1244 new String'(Run_Path_Opt
1245 & File_Path
1246 (1 .. File_Path'Length
1247 - File_Name'Length)
1248 & Path_Separator
1249 & File_Path (1 .. GCC_Index));
1250
1251 else
1252 Linker_Options.Table
1253 (Run_Path_Opt_Index) :=
1254 new String'
1255 (Linker_Options.Table
1256 (Run_Path_Opt_Index).all
1257 & Path_Separator
1258 & File_Path
1259 (1 .. File_Path'Length
1260 - File_Name'Length)
1261 & Path_Separator
1262 & File_Path (1 .. GCC_Index));
1263 end if;
1264 end if;
1265 end if;
1266 end if;
1267
1268 -- Then we add the appropriate -l switch
1269
1270 Linker_Options.Increment_Last;
1271 Linker_Options.Table (Linker_Options.Last) :=
1272 new String'(Next_Line (Nfirst .. Nlast));
1273 end if;
1274
1275 else
1276 -- If gnatlib library not found, then
1277 -- add it anyway in case some other
1278 -- mechanimsm may find it.
1279
1280 Linker_Options.Increment_Last;
1281 Linker_Options.Table (Linker_Options.Last) :=
1282 new String'(Next_Line (Nfirst .. Nlast));
1283 end if;
1284 end;
1285 else
1286 Linker_Options.Increment_Last;
1287 Linker_Options.Table (Linker_Options.Last) :=
1288 new String'(Next_Line (Nfirst .. Nlast));
1289 end if;
1290 end if;
1291
1292 Xlinker_Was_Previous := Next_Line (Nfirst .. Nlast) = "-Xlinker";
1293
1294 Get_Next_Line;
1295 exit when Next_Line (Nfirst .. Nlast) = End_Info;
1296
1297 if Ada_Bind_File then
1298 Next_Line (Nfirst .. Nlast - 8) :=
1299 Next_Line (Nfirst + 8 .. Nlast);
1300 Nlast := Nlast - 8;
1301 end if;
1302 end loop;
1303 end if;
1304
1305 -- If -shared was specified, invoke gcc with -shared-libgcc
1306
1307 if GNAT_Shared then
1308 Linker_Options.Increment_Last;
1309 Linker_Options.Table (Linker_Options.Last) := Shared_Libgcc;
1310 end if;
1311
1312 Status := fclose (Fd);
1313 end Process_Binder_File;
1314
1315 ------------------
1316 -- Write_Header --
1317 ------------------
1318
1319 procedure Write_Header is
1320 begin
1321 if Verbose_Mode then
1322 Write_Eol;
1323 Write_Str ("GNATLINK ");
1324 Write_Str (Gnat_Version_String);
1325 Write_Eol;
1326 Write_Str ("Copyright 1995-" &
1327 Current_Year &
1328 ", Free Software Foundation, Inc");
1329 Write_Eol;
1330 end if;
1331 end Write_Header;
1332
1333 -----------------
1334 -- Write_Usage --
1335 -----------------
1336
1337 procedure Write_Usage is
1338 begin
1339 Write_Header;
1340
1341 Write_Str ("Usage: ");
1342 Write_Str (Base_Name (Command_Name));
1343 Write_Str (" switches mainprog.ali [non-Ada-objects] [linker-options]");
1344 Write_Eol;
1345 Write_Eol;
1346 Write_Line (" mainprog.ali the ALI file of the main program");
1347 Write_Eol;
1348 Write_Line (" -A Binder generated source file is in Ada (default)");
1349 Write_Line (" -C Binder generated source file is in C");
1350 Write_Line (" -f force object file list to be generated");
1351 Write_Line (" -g Compile binder source file with debug information");
1352 Write_Line (" -n Do not compile the binder source file");
1353 Write_Line (" -R Do not use a run_path_option");
1354 Write_Line (" -v verbose mode");
1355 Write_Line (" -v -v very verbose mode");
1356 Write_Eol;
1357 Write_Line (" -o nam Use 'nam' as the name of the executable");
1358 Write_Line (" -b target Compile the binder source to run on target");
1359 Write_Line (" -Bdir Load compiler executables from dir");
1360
1361 if Is_Supported (Map_File) then
1362 Write_Line (" -Mmap Create map file map");
1363 Write_Line (" -M Create map file mainprog.map");
1364 end if;
1365
1366 Write_Line (" --GCC=comp Use comp as the compiler");
1367 Write_Line (" --LINK=nam Use 'nam' for the linking rather than 'gcc'");
1368 Write_Eol;
1369 Write_Line (" [non-Ada-objects] list of non Ada object files");
1370 Write_Line (" [linker-options] other options for the linker");
1371 end Write_Usage;
1372
1373 -- Start of processing for Gnatlink
1374
1375 begin
1376 -- Add the directory where gnatlink is invoked in front of the
1377 -- path, if gnatlink is invoked with directory information.
1378 -- Only do this if the platform is not VMS, where the notion of path
1379 -- does not really exist.
1380
1381 if not Hostparm.OpenVMS then
1382 declare
1383 Command : constant String := Command_Name;
1384
1385 begin
1386 for Index in reverse Command'Range loop
1387 if Command (Index) = Directory_Separator then
1388 declare
1389 Absolute_Dir : constant String :=
1390 Normalize_Pathname
1391 (Command (Command'First .. Index));
1392
1393 PATH : constant String :=
1394 Absolute_Dir &
1395 Path_Separator &
1396 Getenv ("PATH").all;
1397
1398 begin
1399 Setenv ("PATH", PATH);
1400 end;
1401
1402 exit;
1403 end if;
1404 end loop;
1405 end;
1406 end if;
1407
1408 Process_Args;
1409
1410 if Argument_Count = 0
1411 or else
1412 (Verbose_Mode and then Argument_Count = 1)
1413 then
1414 Write_Usage;
1415 Exit_Program (E_Fatal);
1416 end if;
1417
1418 if Hostparm.Java_VM then
1419 Gcc := new String'("jgnat");
1420 Ada_Bind_File := True;
1421 Begin_Info := "-- BEGIN Object file/option list";
1422 End_Info := "-- END Object file/option list ";
1423 end if;
1424
1425 -- We always compile with -c
1426
1427 Binder_Options_From_ALI.Increment_Last;
1428 Binder_Options_From_ALI.Table (Binder_Options_From_ALI.Last) :=
1429 new String'("-c");
1430
1431 -- If the main program is in Ada it is compiled with the following
1432 -- switches:
1433
1434 -- -gnatA stops reading gnat.adc, since we don't know what
1435 -- pagmas would work, and we do not need it anyway.
1436
1437 -- -gnatWb allows brackets coding for wide characters
1438
1439 -- -gnatiw allows wide characters in identifiers. This is needed
1440 -- because bindgen uses brackets encoding for all upper
1441 -- half and wide characters in identifier names.
1442
1443 if Ada_Bind_File then
1444 Binder_Options_From_ALI.Increment_Last;
1445 Binder_Options_From_ALI.Table (Binder_Options_From_ALI.Last) :=
1446 new String'("-gnatA");
1447 Binder_Options_From_ALI.Increment_Last;
1448 Binder_Options_From_ALI.Table (Binder_Options_From_ALI.Last) :=
1449 new String'("-gnatWb");
1450 Binder_Options_From_ALI.Increment_Last;
1451 Binder_Options_From_ALI.Table (Binder_Options_From_ALI.Last) :=
1452 new String'("-gnatiw");
1453 end if;
1454
1455 -- Locate all the necessary programs and verify required files are present
1456
1457 Gcc_Path := GNAT.OS_Lib.Locate_Exec_On_Path (Gcc.all);
1458
1459 if Gcc_Path = null then
1460 Exit_With_Error ("Couldn't locate " & Gcc.all);
1461 end if;
1462
1463 if Linker_Path = null then
1464 Linker_Path := Gcc_Path;
1465 end if;
1466
1467 if Ali_File_Name = null then
1468 Exit_With_Error ("no ali file given for link");
1469 end if;
1470
1471 if not Is_Regular_File (Ali_File_Name.all) then
1472 Exit_With_Error (Ali_File_Name.all & " not found");
1473 end if;
1474
1475 -- Get target parameters
1476
1477 Namet.Initialize;
1478 Csets.Initialize;
1479 Snames.Initialize;
1480 Osint.Add_Default_Search_Dirs;
1481 Targparm.Get_Target_Parameters;
1482
1483 -- Read the ALI file of the main subprogram if the binder generated
1484 -- file needs to be compiled and no --GCC= switch has been specified.
1485 -- Fetch the back end switches from this ALI file and use these switches
1486 -- to compile the binder generated file
1487
1488 if Compile_Bind_File and then Standard_Gcc then
1489
1490 Initialize_ALI;
1491 Name_Len := Ali_File_Name'Length;
1492 Name_Buffer (1 .. Name_Len) := Ali_File_Name.all;
1493
1494 declare
1495 use Types;
1496 F : constant File_Name_Type := Name_Find;
1497 T : Text_Buffer_Ptr;
1498 A : ALI_Id;
1499
1500 begin
1501 -- Load the ALI file
1502
1503 T := Read_Library_Info (F, True);
1504
1505 -- Read it. Note that we ignore errors, since we only want very
1506 -- limited information from the ali file, and likely a slightly
1507 -- wrong version will be just fine, though in normal operation
1508 -- we don't expect this to happen!
1509
1510 A := Scan_ALI
1511 (F,
1512 T,
1513 Ignore_ED => False,
1514 Err => False,
1515 Ignore_Errors => True);
1516
1517 if A /= No_ALI_Id then
1518 for
1519 Index in Units.Table (ALIs.Table (A).First_Unit).First_Arg ..
1520 Units.Table (ALIs.Table (A).First_Unit).Last_Arg
1521 loop
1522 -- Do not compile with the front end switches except for --RTS
1523 -- if the binder generated file is in Ada.
1524
1525 declare
1526 Arg : String_Ptr renames Args.Table (Index);
1527 begin
1528 if not Is_Front_End_Switch (Arg.all)
1529 or else
1530 (Ada_Bind_File
1531 and then Arg'Length > 5
1532 and then Arg (Arg'First + 2 .. Arg'First + 5) = "RTS=")
1533 then
1534 Binder_Options_From_ALI.Increment_Last;
1535 Binder_Options_From_ALI.Table
1536 (Binder_Options_From_ALI.Last) := String_Access (Arg);
1537 end if;
1538 end;
1539 end loop;
1540 end if;
1541 end;
1542 end if;
1543
1544 Write_Header;
1545
1546 -- If no output name specified, then use the base name of .ali file name
1547
1548 if Output_File_Name = null then
1549 Output_File_Name :=
1550 new String'(Base_Name (Ali_File_Name.all)
1551 & Get_Target_Debuggable_Suffix.all);
1552
1553 Linker_Options.Increment_Last;
1554 Linker_Options.Table (Linker_Options.Last) :=
1555 new String'("-o");
1556
1557 Linker_Options.Increment_Last;
1558 Linker_Options.Table (Linker_Options.Last) :=
1559 new String'(Output_File_Name.all);
1560 end if;
1561
1562 -- Warn if main program is called "test", as that may be a built-in command
1563 -- on Unix. On non-Unix systems executables have a suffix, so the warning
1564 -- will not appear. However, do not warn in the case of a cross compiler.
1565
1566 -- Assume this is a cross tool if the executable name is not gnatlink
1567
1568 if Base_Name (Command_Name) = "gnatlink"
1569 and then Output_File_Name.all = "test"
1570 then
1571 Error_Msg ("warning: executable name """ & Output_File_Name.all
1572 & """ may conflict with shell command");
1573 end if;
1574
1575 -- If -M switch was specified, add the switches to create the map file
1576
1577 if Create_Map_File then
1578 declare
1579 Map_Name : constant String := Base_Name (Ali_File_Name.all) & ".map";
1580 Switches : String_List_Access;
1581
1582 begin
1583 Convert (Map_File, Map_Name, Switches);
1584
1585 if Switches /= null then
1586 for J in Switches'Range loop
1587 Linker_Options.Increment_Last;
1588 Linker_Options.Table (Linker_Options.Last) := Switches (J);
1589 end loop;
1590 end if;
1591 end;
1592 end if;
1593
1594 -- Perform consistency checks
1595
1596 -- Transform the .ali file name into the binder output file name
1597
1598 Make_Binder_File_Names : declare
1599 Fname : constant String := Base_Name (Ali_File_Name.all);
1600 Fname_Len : Integer := Fname'Length;
1601
1602 function Get_Maximum_File_Name_Length return Integer;
1603 pragma Import (C, Get_Maximum_File_Name_Length,
1604 "__gnat_get_maximum_file_name_length");
1605
1606 Maximum_File_Name_Length : constant Integer :=
1607 Get_Maximum_File_Name_Length;
1608
1609 Bind_File_Prefix : Types.String_Ptr;
1610 -- Contains prefix used for bind files
1611
1612 begin
1613 -- Set prefix
1614
1615 if not Ada_Bind_File then
1616 Bind_File_Prefix := new String'("b_");
1617 elsif OpenVMS_On_Target then
1618 Bind_File_Prefix := new String'("b__");
1619 else
1620 Bind_File_Prefix := new String'("b~");
1621 end if;
1622
1623 -- If the length of the binder file becomes too long due to
1624 -- the addition of the "b?" prefix, then truncate it.
1625
1626 if Maximum_File_Name_Length > 0 then
1627 while Fname_Len >
1628 Maximum_File_Name_Length - Bind_File_Prefix.all'Length
1629 loop
1630 Fname_Len := Fname_Len - 1;
1631 end loop;
1632 end if;
1633
1634 declare
1635 Fnam : constant String :=
1636 Bind_File_Prefix.all &
1637 Fname (Fname'First .. Fname'First + Fname_Len - 1);
1638
1639 begin
1640 if Ada_Bind_File then
1641 Binder_Spec_Src_File := new String'(Fnam & ".ads");
1642 Binder_Body_Src_File := new String'(Fnam & ".adb");
1643 Binder_Ali_File := new String'(Fnam & ".ali");
1644 else
1645 Binder_Body_Src_File := new String'(Fnam & ".c");
1646 end if;
1647
1648 Binder_Obj_File := new String'(Fnam & Get_Target_Object_Suffix.all);
1649 end;
1650
1651 if Fname_Len /= Fname'Length then
1652 Binder_Options.Increment_Last;
1653 Binder_Options.Table (Binder_Options.Last) := new String'("-o");
1654 Binder_Options.Increment_Last;
1655 Binder_Options.Table (Binder_Options.Last) := Binder_Obj_File;
1656 end if;
1657 end Make_Binder_File_Names;
1658
1659 Process_Binder_File (Binder_Body_Src_File.all & ASCII.NUL);
1660
1661 -- Compile the binder file. This is fast, so we always do it, unless
1662 -- specifically told not to by the -n switch
1663
1664 if Compile_Bind_File then
1665 Bind_Step : declare
1666 Success : Boolean;
1667 Args : Argument_List
1668 (1 .. Binder_Options_From_ALI.Last + Binder_Options.Last + 1);
1669
1670 begin
1671 for J in 1 .. Binder_Options_From_ALI.Last loop
1672 Args (J) := Binder_Options_From_ALI.Table (J);
1673 end loop;
1674
1675 for J in 1 .. Binder_Options.Last loop
1676 Args (Binder_Options_From_ALI.Last + J) :=
1677 Binder_Options.Table (J);
1678 end loop;
1679
1680 Args (Args'Last) := Binder_Body_Src_File;
1681
1682 if Verbose_Mode then
1683 Write_Str (Base_Name (Gcc_Path.all));
1684
1685 for J in Args'Range loop
1686 Write_Str (" ");
1687 Write_Str (Args (J).all);
1688 end loop;
1689
1690 Write_Eol;
1691 end if;
1692
1693 GNAT.OS_Lib.Spawn (Gcc_Path.all, Args, Success);
1694
1695 if not Success then
1696 Exit_Program (E_Fatal);
1697 end if;
1698 end Bind_Step;
1699 end if;
1700
1701 -- Now, actually link the program
1702
1703 -- Skip this step for now on the JVM since the Java interpreter will do
1704 -- the actual link at run time. We might consider packing all class files
1705 -- in a .zip file during this step.
1706
1707 if not Hostparm.Java_VM then
1708 Link_Step : declare
1709 Num_Args : Natural :=
1710 (Linker_Options.Last - Linker_Options.First + 1) +
1711 (Gcc_Linker_Options.Last - Gcc_Linker_Options.First + 1) +
1712 (Linker_Objects.Last - Linker_Objects.First + 1);
1713 Stack_Op : Boolean := False;
1714 IDENT_Op : Boolean := False;
1715
1716 begin
1717 -- Remove duplicate stack size setting from the Linker_Options
1718 -- table. The stack setting option "-Xlinker --stack=R,C" can be
1719 -- found in one line when set by a pragma Linker_Options or in two
1720 -- lines ("-Xlinker" then "--stack=R,C") when set on the command
1721 -- line. We also check for the "-Wl,--stack=R" style option.
1722
1723 -- We must remove the second stack setting option instance
1724 -- because the one on the command line will always be the first
1725 -- one. And any subsequent stack setting option will overwrite the
1726 -- previous one. This is done especially for GNAT/NT where we set
1727 -- the stack size for tasking programs by a pragma in the NT
1728 -- specific tasking package System.Task_Primitives.Oparations.
1729
1730 -- Note: This is not a FOR loop that runs from Linker_Options.First
1731 -- to Linker_Options.Last, since operations within the loop can
1732 -- modify the length of the table.
1733
1734 Clean_Link_Option_Set : declare
1735 J : Natural := Linker_Options.First;
1736 Shared_Libgcc_Seen : Boolean := False;
1737
1738 begin
1739 while J <= Linker_Options.Last loop
1740
1741 if Linker_Options.Table (J).all = "-Xlinker"
1742 and then J < Linker_Options.Last
1743 and then Linker_Options.Table (J + 1)'Length > 8
1744 and then Linker_Options.Table (J + 1) (1 .. 8) = "--stack="
1745 then
1746 if Stack_Op then
1747 Linker_Options.Table (J .. Linker_Options.Last - 2) :=
1748 Linker_Options.Table (J + 2 .. Linker_Options.Last);
1749 Linker_Options.Decrement_Last;
1750 Linker_Options.Decrement_Last;
1751 Num_Args := Num_Args - 2;
1752
1753 else
1754 Stack_Op := True;
1755 end if;
1756 end if;
1757
1758 -- Remove duplicate -shared-libgcc switch
1759
1760 if Linker_Options.Table (J).all = Shared_Libgcc_String then
1761 if Shared_Libgcc_Seen then
1762 Linker_Options.Table (J .. Linker_Options.Last - 1) :=
1763 Linker_Options.Table (J + 1 .. Linker_Options.Last);
1764 Linker_Options.Decrement_Last;
1765 Num_Args := Num_Args - 1;
1766
1767 else
1768 Shared_Libgcc_Seen := True;
1769 end if;
1770 end if;
1771
1772 -- Here we just check for a canonical form that matches the
1773 -- pragma Linker_Options set in the NT runtime.
1774
1775 if (Linker_Options.Table (J)'Length > 17
1776 and then Linker_Options.Table (J) (1 .. 17)
1777 = "-Xlinker --stack=")
1778 or else
1779 (Linker_Options.Table (J)'Length > 12
1780 and then Linker_Options.Table (J) (1 .. 12)
1781 = "-Wl,--stack=")
1782 then
1783 if Stack_Op then
1784 Linker_Options.Table (J .. Linker_Options.Last - 1) :=
1785 Linker_Options.Table (J + 1 .. Linker_Options.Last);
1786 Linker_Options.Decrement_Last;
1787 Num_Args := Num_Args - 1;
1788
1789 else
1790 Stack_Op := True;
1791 end if;
1792 end if;
1793
1794 -- Remove duplicate IDENTIFICATION directives (VMS)
1795
1796 if Linker_Options.Table (J)'Length > 27
1797 and then Linker_Options.Table (J) (1 .. 28)
1798 = "--for-linker=IDENTIFICATION="
1799 then
1800 if IDENT_Op then
1801 Linker_Options.Table (J .. Linker_Options.Last - 1) :=
1802 Linker_Options.Table (J + 1 .. Linker_Options.Last);
1803 Linker_Options.Decrement_Last;
1804 Num_Args := Num_Args - 1;
1805 else
1806 IDENT_Op := True;
1807 end if;
1808 end if;
1809
1810 J := J + 1;
1811 end loop;
1812
1813 -- If gcc is not called with -shared-libgcc, call it with
1814 -- -static-libgcc, as there are some platforms where one of these
1815 -- two switches is compulsory to link.
1816
1817 if not Shared_Libgcc_Seen then
1818 Linker_Options.Increment_Last;
1819 Linker_Options.Table (Linker_Options.Last) := Static_Libgcc;
1820 Num_Args := Num_Args + 1;
1821 end if;
1822
1823 end Clean_Link_Option_Set;
1824
1825 -- Prepare arguments for call to linker
1826
1827 Call_Linker : declare
1828 Success : Boolean;
1829 Args : Argument_List (1 .. Num_Args + 1);
1830 Index : Integer := Args'First;
1831
1832 begin
1833 Args (Index) := Binder_Obj_File;
1834
1835 -- Add the object files and any -largs libraries
1836
1837 for J in Linker_Objects.First .. Linker_Objects.Last loop
1838 Index := Index + 1;
1839 Args (Index) := Linker_Objects.Table (J);
1840 end loop;
1841
1842 -- Add the linker options from the binder file
1843
1844 for J in Linker_Options.First .. Linker_Options.Last loop
1845 Index := Index + 1;
1846 Args (Index) := Linker_Options.Table (J);
1847 end loop;
1848
1849 -- Finally add the libraries from the --GCC= switch
1850
1851 for J in Gcc_Linker_Options.First .. Gcc_Linker_Options.Last loop
1852 Index := Index + 1;
1853 Args (Index) := Gcc_Linker_Options.Table (J);
1854 end loop;
1855
1856 if Verbose_Mode then
1857 Write_Str (Linker_Path.all);
1858
1859 for J in Args'Range loop
1860 Write_Str (" ");
1861 Write_Str (Args (J).all);
1862 end loop;
1863
1864 Write_Eol;
1865
1866 -- If we are on very verbose mode (-v -v) and a response file
1867 -- is used we display its content.
1868
1869 if Very_Verbose_Mode and then Tname_FD /= Invalid_FD then
1870 Write_Eol;
1871 Write_Str ("Response file (" &
1872 Tname (Tname'First .. Tname'Last - 1) &
1873 ") content : ");
1874 Write_Eol;
1875
1876 for J in
1877 Response_File_Objects.First ..
1878 Response_File_Objects.Last
1879 loop
1880 Write_Str (Response_File_Objects.Table (J).all);
1881 Write_Eol;
1882 end loop;
1883
1884 Write_Eol;
1885 end if;
1886 end if;
1887
1888 GNAT.OS_Lib.Spawn (Linker_Path.all, Args, Success);
1889
1890 -- Delete the temporary file used in conjuction with linking if
1891 -- one was created. See Process_Bind_File for details.
1892
1893 if Tname_FD /= Invalid_FD then
1894 Delete (Tname);
1895 end if;
1896
1897 if not Success then
1898 Error_Msg ("cannot call " & Linker_Path.all);
1899 Exit_Program (E_Fatal);
1900 end if;
1901 end Call_Linker;
1902 end Link_Step;
1903 end if;
1904
1905 -- Only keep the binder output file and it's associated object
1906 -- file if compiling with the -g option. These files are only
1907 -- useful if debugging.
1908
1909 if not Debug_Flag_Present then
1910 if Binder_Ali_File /= null then
1911 Delete (Binder_Ali_File.all & ASCII.NUL);
1912 end if;
1913
1914 if Binder_Spec_Src_File /= null then
1915 Delete (Binder_Spec_Src_File.all & ASCII.NUL);
1916 end if;
1917
1918 Delete (Binder_Body_Src_File.all & ASCII.NUL);
1919
1920 if not Hostparm.Java_VM then
1921 Delete (Binder_Obj_File.all & ASCII.NUL);
1922 end if;
1923 end if;
1924
1925 Exit_Program (E_Success);
1926
1927 exception
1928 when X : others =>
1929 Write_Line (Exception_Information (X));
1930 Exit_With_Error ("INTERNAL ERROR. Please report");
1931 end Gnatlink;
Mirror of the offical gcc git repository hosted at gcc.gnu.org