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

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [ada/] [gnatlink.adb] - Blame information for rev 801

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

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

powered by: WebSVN 2.1.0

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