OpenCores
URL https://opencores.org/ocsvn/openrisc_me/openrisc_me/trunk

Subversion Repositories openrisc_me

[/] [openrisc/] [trunk/] [gnu-src/] [gcc-4.5.1/] [gcc/] [ada/] [gnatlink.adb] - Blame information for rev 311

Go to most recent revision | Details | Compare with Previous | View Log

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

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.