development/compilers/freepascal/compiler/t_linux.pas

   1 {
   2     $Id$
   3     Copyright (c) 1998-2000 by Peter Vreman
   4
   5     This unit implements support import,export,link routines
   6     for the (i386) Linux target
   7
   8     This program is free software; you can redistribute it and/or modify
   9     it under the terms of the GNU General Public License as published by
  10     the Free Software Foundation; either version 2 of the License, or
  11     (at your option) any later version.
  12
  13     This program is distributed in the hope that it will be useful,
  14     but WITHOUT ANY WARRANTY; without even the implied warranty of
  15     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16     GNU General Public License for more details.
  17
  18     You should have received a copy of the GNU General Public License
  19     along with this program; if not, write to the Free Software
  20     Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  21
  22  ****************************************************************************
  23 }
  24 unit t_linux;
  25 interface
  26
  27   uses
  28     import,export,link;
  29
  30   type
  31     pimportliblinux=^timportliblinux;
  32     timportliblinux=object(timportlib)
  33       procedure preparelib(const s:string);virtual;
  34       procedure importprocedure(const func,module:string;index:longint;const name:string);virtual;
  35       procedure importvariable(const varname,module:string;const name:string);virtual;
  36       procedure generatelib;virtual;
  37     end;
  38
  39     pexportliblinux=^texportliblinux;
  40     texportliblinux=object(texportlib)
  41       procedure preparelib(const s : string);virtual;
  42       procedure exportprocedure(hp : pexported_item);virtual;
  43       procedure exportvar(hp : pexported_item);virtual;
  44       procedure generatelib;virtual;
  45     end;
  46
  47     plinkerlinux=^tlinkerlinux;
  48     tlinkerlinux=object(tlinker)
  49     private
  50       Glibc2,
  51       Glibc21 : boolean;
  52       Function  WriteResponseFile(isdll:boolean) : Boolean;
  53     public
  54       constructor Init;
  55       procedure SetDefaultInfo;virtual;
  56       function  MakeExecutable:boolean;virtual;
  57       function  MakeSharedLibrary:boolean;virtual;
  58     end;
  59
  60
  61 implementation
  62
  63   uses
  64     verbose,strings,cobjects,systems,globtype,globals,
  65     symconst,script,
  66     files,aasm,cpuasm,cpubase,symtable{$IFDEF NEWST},symbols{$ENDIF NEWST};
  67
  68 {*****************************************************************************
  69                                TIMPORTLIBLINUX
  70 *****************************************************************************}
  71
  72 procedure timportliblinux.preparelib(const s : string);
  73 begin
  74 end;
  75
  76
  77 procedure timportliblinux.importprocedure(const func,module : string;index : longint;const name : string);
  78 begin
  79   { insert sharedlibrary }
  80 {$IFDEF NEWST}
  81   current_module^.linkothersharedlibs.
  82    insert(new(Plinkitem,init(SplitName(module),link_allways)));
  83   { do nothing with the procedure, only set the mangledname }
  84   if name<>'' then
  85     aktprocdef^.setmangledname(name)
  86   else
  87     message(parser_e_empty_import_name);
  88 {$ELSE}
  89   current_module^.linkothersharedlibs.
  90    insert(SplitName(module),link_allways);
  91   { do nothing with the procedure, only set the mangledname }
  92   if name<>'' then
  93     aktprocsym^.definition^.setmangledname(name)
  94   else
  95     message(parser_e_empty_import_name);
  96 {$ENDIF NEWST}
  97 end;
  98
  99
 100 procedure timportliblinux.importvariable(const varname,module:string;const name:string);
 101 begin
 102   { insert sharedlibrary }
 103 {$IFDEF NEWST}
 104   current_module^.linkothersharedlibs.
 105    insert(new(Plinkitem,init(SplitName(module),link_allways)));
 106 {$ELSE}
 107   current_module^.linkothersharedlibs.
 108    insert(SplitName(module),link_allways);
 109 {$ENDIF NEWST}
 110   { reset the mangledname and turn off the dll_var option }
 111   aktvarsym^.setmangledname(name);
 112 {$IFDEF NEWST}
 113   exclude(aktvarsym^.properties,vo_is_dll_var);
 114 {$ELSE}
 115 {$ifdef INCLUDEOK}
 116   exclude(aktvarsym^.varoptions,vo_is_dll_var);
 117 {$else}
 118   aktvarsym^.varoptions:=aktvarsym^.varoptions-[vo_is_dll_var];
 119 {$endif}
 120 {$ENDIF NEWST}
 121 end;
 122
 123
 124 procedure timportliblinux.generatelib;
 125 begin
 126 end;
 127
 128
 129 {*****************************************************************************
 130                                TEXPORTLIBLINUX
 131 *****************************************************************************}
 132
 133 procedure texportliblinux.preparelib(const s:string);
 134 begin
 135 end;
 136
 137
 138 procedure texportliblinux.exportprocedure(hp : pexported_item);
 139 var
 140   hp2 : pexported_item;
 141 begin
 142   { first test the index value }
 143   if (hp^.options and eo_index)<>0 then
 144    begin
 145      Message1(parser_e_no_export_with_index_for_target,'linux');
 146      exit;
 147    end;
 148   { use pascal name is none specified }
 149   if (hp^.options and eo_name)=0 then
 150     begin
 151        hp^.name:=stringdup(hp^.sym^.name);
 152        hp^.options:=hp^.options or eo_name;
 153     end;
 154   { now place in correct order }
 155   hp2:=pexported_item(current_module^._exports^.first);
 156   while assigned(hp2) and
 157      (hp^.name^>hp2^.name^) do
 158     hp2:=pexported_item(hp2^.next);
 159   { insert hp there !! }
 160   if assigned(hp2) and (hp2^.name^=hp^.name^) then
 161     begin
 162       { this is not allowed !! }
 163       Message1(parser_e_export_name_double,hp^.name^);
 164       exit;
 165     end;
 166   if hp2=pexported_item(current_module^._exports^.first) then
 167     current_module^._exports^.insert(hp)
 168   else if assigned(hp2) then
 169     begin
 170        hp^.next:=hp2;
 171        hp^.previous:=hp2^.previous;
 172        if assigned(hp2^.previous) then
 173          hp2^.previous^.next:=hp;
 174        hp2^.previous:=hp;
 175     end
 176   else
 177     current_module^._exports^.concat(hp);
 178 end;
 179
 180
 181 procedure texportliblinux.exportvar(hp : pexported_item);
 182 begin
 183   hp^.is_var:=true;
 184   exportprocedure(hp);
 185 end;
 186
 187
 188 procedure texportliblinux.generatelib;
 189 var
 190   hp2 : pexported_item;
 191 begin
 192   hp2:=pexported_item(current_module^._exports^.first);
 193   while assigned(hp2) do
 194    begin
 195      if not hp2^.is_var then
 196       begin
 197 {$ifdef i386}
 198         { place jump in codesegment }
 199         codesegment^.concat(new(pai_align,init_op(4,$90)));
 200         codesegment^.concat(new(pai_symbol,initname_global(hp2^.name^,0)));
 201         codesegment^.concat(new(paicpu,op_sym(A_JMP,S_NO,newasmsymbol(hp2^.sym^.mangledname))));
 202         codesegment^.concat(new(pai_symbol_end,initname(hp2^.name^)));
 203 {$endif i386}
 204       end
 205      else
 206       Message1(parser_e_no_export_of_variables_for_target,'linux');
 207      hp2:=pexported_item(hp2^.next);
 208    end;
 209 end;
 210
 211
 212 {*****************************************************************************
 213                                   TLINKERLINUX
 214 *****************************************************************************}
 215
 216 Constructor TLinkerLinux.Init;
 217 begin
 218   Inherited Init;
 219   LibrarySearchPath.AddPath('/lib;/usr/lib;/usr/X11R6/lib',true);
 220 end;
 221
 222
 223 procedure TLinkerLinux.SetDefaultInfo;
 224 {
 225   This will also detect which libc version will be used
 226 }
 227 begin
 228   Glibc2:=false;
 229   Glibc21:=false;
 230   with Info do
 231    begin
 232      ExeCmd[1]:='ld $OPT $DYNLINK $STATIC $STRIP -L. -o $EXE $RES';
 233      DllCmd[1]:='ld $OPT -shared -L. -o $EXE $RES';
 234      DllCmd[2]:='strip --strip-unneeded $EXE';
 235      { first try glibc2 }
 236      DynamicLinker:='/lib/ld-linux.so.2';
 237      if FileExists(DynamicLinker) then
 238       begin
 239         Glibc2:=true;
 240         { Check for 2.0 files, else use the glibc 2.1 stub }
 241         if FileExists('/lib/ld-2.0.*') then
 242          Glibc21:=false
 243         else
 244          Glibc21:=true;
 245       end
 246      else
 247       DynamicLinker:='/lib/ld-linux.so.1';
 248      {$ifdef BSD}
 249       DynamicLinker:='';
 250      {$endif}
 251    end;
 252
 253 end;
 254
 255
 256 Function TLinkerLinux.WriteResponseFile(isdll:boolean) : Boolean;
 257 Var
 258   linkres      : TLinkRes;
 259   i            : longint;
 260   cprtobj,
 261   gprtobj,
 262   prtobj       : string[80];
 263 {$IFDEF NEWST}
 264   HPath        : PStringItem;
 265 {$ELSE}
 266   HPath        : PStringQueueItem;
 267 {$ENDIF NEWST}
 268   s            : string;
 269   found,
 270   linkdynamic,
 271   linklibc     : boolean;
 272 begin
 273   WriteResponseFile:=False;
 274 { set special options for some targets }
 275   linkdynamic:=not(SharedLibFiles.empty);
 276   linklibc:=SharedLibFiles.Find('c');
 277   prtobj:='prt0';
 278   cprtobj:='cprt0';
 279   gprtobj:='gprt0';
 280   if glibc21 then
 281    begin
 282      cprtobj:='cprt21';
 283      gprtobj:='gprt21';
 284    end;
 285   if cs_profile in aktmoduleswitches then
 286    begin
 287      prtobj:=gprtobj;
 288      if not glibc2 then
 289       AddSharedLibrary('gmon');
 290      AddSharedLibrary('c');
 291      linklibc:=true;
 292    end
 293   else
 294    begin
 295      if linklibc then
 296       prtobj:=cprtobj;
 297    end;
 298
 299   { Open link.res file }
 300   LinkRes.Init(outputexedir+Info.ResName);
 301
 302   { Write path to search libraries }
 303   HPath:=current_module^.locallibrarysearchpath.First;
 304   while assigned(HPath) do
 305    begin
 306      LinkRes.Add('SEARCH_DIR('+HPath^.Data^+')');
 307      HPath:=HPath^.Next;
 308    end;
 309   HPath:=LibrarySearchPath.First;
 310   while assigned(HPath) do
 311    begin
 312      LinkRes.Add('SEARCH_DIR('+HPath^.Data^+')');
 313      HPath:=HPath^.Next;
 314    end;
 315
 316   LinkRes.Add('INPUT(');
 317   { add objectfiles, start with prt0 always }
 318   if prtobj<>'' then
 319    LinkRes.AddFileName(FindObjectFile(prtobj,''));
 320   { try to add crti and crtbegin if linking to C }
 321   if linklibc then
 322    begin
 323      s:=librarysearchpath.FindFile('crtbegin.o',found)+'crtbegin.o';
 324      if found then
 325       LinkRes.AddFileName(s);
 326      s:=librarysearchpath.FindFile('crti.o',found)+'crti.o';
 327      if found then
 328       LinkRes.AddFileName(s);
 329    end;
 330   { main objectfiles }
 331   while not ObjectFiles.Empty do
 332    begin
 333      s:=ObjectFiles.Get;
 334      if s<>'' then
 335       LinkRes.AddFileName(s);
 336    end;
 337   { objects which must be at the end }
 338   if linklibc then
 339    begin
 340      s:=librarysearchpath.FindFile('crtend.o',found)+'crtend.o';
 341      if found then
 342       LinkRes.AddFileName(s);
 343      s:=librarysearchpath.FindFile('crtn.o',found)+'crtn.o';
 344      if found then
 345       LinkRes.AddFileName(s);
 346    end;
 347   LinkRes.Add(')');
 348
 349   { Write staticlibraries }
 350   if not StaticLibFiles.Empty then
 351    begin
 352      LinkRes.Add('GROUP(');
 353      While not StaticLibFiles.Empty do
 354       begin
 355         S:=StaticLibFiles.Get;
 356         LinkRes.AddFileName(s)
 357       end;
 358      LinkRes.Add(')');
 359    end;
 360
 361   { Write sharedlibraries like -l<lib>, also add the needed dynamic linker
 362     here to be sure that it gets linked this is needed for glibc2 systems (PFV) }
 363   if not SharedLibFiles.Empty then
 364    begin
 365      LinkRes.Add('INPUT(');
 366      While not SharedLibFiles.Empty do
 367       begin
 368         S:=SharedLibFiles.Get;
 369         if s<>'c' then
 370          begin
 371            i:=Pos(target_os.sharedlibext,S);
 372            if i>0 then
 373             Delete(S,i,255);
 374            LinkRes.Add('-l'+s);
 375          end
 376         else
 377          begin
 378            linklibc:=true;
 379            linkdynamic:=false; { libc will include the ld-linux for us }
 380          end;
 381       end;
 382      { be sure that libc is the last lib }
 383      if linklibc then
 384       LinkRes.Add('-lc');
 385      { when we have -static for the linker the we also need libgcc }
 386      if (cs_link_staticflag in aktglobalswitches) then
 387       LinkRes.Add('-lgcc');
 388      if linkdynamic and (Info.DynamicLinker<>'') then
 389       LinkRes.AddFileName(Info.DynamicLinker);
 390      LinkRes.Add(')');
 391    end;
 392 { Write and Close response }
 393   linkres.writetodisk;
 394   linkres.done;
 395
 396   WriteResponseFile:=True;
 397 end;
 398
 399
 400 function TLinkerLinux.MakeExecutable:boolean;
 401 var
 402   binstr,
 403   cmdstr  : string;
 404   success : boolean;
 405   DynLinkStr : string[60];
 406   StaticStr,
 407   StripStr   : string[40];
 408 begin
 409   if not(cs_link_extern in aktglobalswitches) then
 410    Message1(exec_i_linking,current_module^.exefilename^);
 411
 412 { Create some replacements }
 413   StaticStr:='';
 414   StripStr:='';
 415   DynLinkStr:='';
 416   if (cs_link_staticflag in aktglobalswitches) then
 417    StaticStr:='-static';
 418   if (cs_link_strip in aktglobalswitches) then
 419    StripStr:='-s';
 420   If (cs_profile in aktmoduleswitches) or
 421      ((Info.DynamicLinker<>'') and (not SharedLibFiles.Empty)) then
 422    DynLinkStr:='-dynamic-linker='+Info.DynamicLinker;
 423
 424 { Write used files and libraries }
 425   WriteResponseFile(false);
 426
 427 { Call linker }
 428   SplitBinCmd(Info.ExeCmd[1],binstr,cmdstr);
 429   Replace(cmdstr,'$EXE',current_module^.exefilename^);
 430   Replace(cmdstr,'$OPT',Info.ExtraOptions);
 431   Replace(cmdstr,'$RES',outputexedir+Info.ResName);
 432   Replace(cmdstr,'$STATIC',StaticStr);
 433   Replace(cmdstr,'$STRIP',StripStr);
 434   Replace(cmdstr,'$DYNLINK',DynLinkStr);
 435   success:=DoExec(FindUtil(BinStr),CmdStr,true,false);
 436
 437 { Remove ReponseFile }
 438   if (success) and not(cs_link_extern in aktglobalswitches) then
 439    RemoveFile(outputexedir+Info.ResName);
 440
 441   MakeExecutable:=success;   { otherwise a recursive call to link method }
 442 end;
 443
 444
 445 Function TLinkerLinux.MakeSharedLibrary:boolean;
 446 var
 447   binstr,
 448   cmdstr  : string;
 449   success : boolean;
 450 begin
 451   MakeSharedLibrary:=false;
 452   if not(cs_link_extern in aktglobalswitches) then
 453    Message1(exec_i_linking,current_module^.sharedlibfilename^);
 454
 455 { Write used files and libraries }
 456   WriteResponseFile(true);
 457
 458 { Call linker }
 459   SplitBinCmd(Info.DllCmd[1],binstr,cmdstr);
 460   Replace(cmdstr,'$EXE',current_module^.sharedlibfilename^);
 461   Replace(cmdstr,'$OPT',Info.ExtraOptions);
 462   Replace(cmdstr,'$RES',outputexedir+Info.ResName);
 463   success:=DoExec(FindUtil(binstr),cmdstr,true,false);
 464
 465 { Strip the library ? }
 466   if success and (cs_link_strip in aktglobalswitches) then
 467    begin
 468      SplitBinCmd(Info.DllCmd[2],binstr,cmdstr);
 469      Replace(cmdstr,'$EXE',current_module^.sharedlibfilename^);
 470      success:=DoExec(FindUtil(binstr),cmdstr,true,false);
 471    end;
 472
 473 { Remove ReponseFile }
 474   if (success) and not(cs_link_extern in aktglobalswitches) then
 475    RemoveFile(outputexedir+Info.ResName);
 476
 477   MakeSharedLibrary:=success;   { otherwise a recursive call to link method }
 478 end;
 479
 480
 481 end.
 482 {
 483   $Log$
 484   Revision 1.1  2002/02/19 08:24:12  sasu
 485   Initial revision
 486
 487   Revision 1.1.2.2  2000/09/24 21:40:19  peter
 488     * error messages updated
 489     * if messages not available in message file fallback to the internal
 490       messages
 491     * message prefixes (like Note:) can now also be set in the msg file
 492
 493   Revision 1.1.2.1  2000/09/10 16:11:59  marco
 494   Dynamic linker name is always empty for BSD
 495
 496   Revision 1.1  2000/07/13 06:29:57  michael
 497   + Initial import
 498
 499   Revision 1.15  2000/07/08 20:43:38  peter
 500     * findobjectfile gets extra arg with directory where the unit is found
 501       and the .o should be looked first
 502
 503   Revision 1.14  2000/03/21 21:36:52  peter
 504     * only include crtbegin when linking to libc
 505
 506   Revision 1.13  2000/03/12 08:24:03  daniel
 507     * Modification for new symtable
 508
 509   Revision 1.12  2000/03/02 13:12:37  daniel
 510     * Removed a comment to fix gtk.
 511
 512   Revision 1.11  2000/02/28 17:23:57  daniel
 513   * Current work of symtable integration committed. The symtable can be
 514     activated by defining 'newst', but doesn't compile yet. Changes in type
 515     checking and oop are completed. What is left is to write a new
 516     symtablestack and adapt the parser to use it.
 517
 518   Revision 1.10  2000/02/27 14:46:04  peter
 519     * check for ld-so.2.0.* then no glibc21 is used, else glibc21 is used
 520
 521   Revision 1.9  2000/02/09 10:35:48  peter
 522     * -Xt option to link staticly against c libs
 523
 524   Revision 1.8  2000/01/11 09:52:07  peter
 525     * fixed placing of .sl directories
 526     * use -b again for base-file selection
 527     * fixed group writing for linux with smartlinking
 528
 529   Revision 1.7  2000/01/09 00:55:51  pierre
 530     * GROUP of smartlink units put before the C libraries
 531       to allow for smartlinking code that uses C code.
 532
 533   Revision 1.6  2000/01/07 01:14:42  peter
 534     * updated copyright to 2000
 535
 536   Revision 1.5  1999/11/16 23:39:04  peter
 537     * use outputexedir for link.res location
 538
 539   Revision 1.4  1999/11/12 11:03:50  peter
 540     * searchpaths changed to stringqueue object
 541
 542   Revision 1.3  1999/11/05 13:15:00  florian
 543     * some fixes to get the new cg compiling again
 544
 545   Revision 1.2  1999/11/04 10:55:31  peter
 546     * TSearchPathString for the string type of the searchpaths, which is
 547       ansistring under FPC/Delphi
 548
 549   Revision 1.1  1999/10/21 14:29:38  peter
 550     * redesigned linker object
 551     + library support for linux (only procedures can be exported)
 552
 553 }