development/compilers/freepascal/compiler/t_fbsd.pas

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