development/compilers/freepascal/compiler/t_go32v2.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) Go32v2 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_go32v2;
  25
  26   interface
  27   uses
  28     link;
  29
  30   type
  31     plinkergo32v2=^tlinkergo32v2;
  32     tlinkergo32v2=object(tlinker)
  33     private
  34        Function  WriteResponseFile(isdll:boolean) : Boolean;
  35     public
  36        constructor Init;
  37        procedure SetDefaultInfo;virtual;
  38        function  MakeExecutable:boolean;virtual;
  39     end;
  40
  41
  42   implementation
  43
  44     uses
  45        strings,globtype,globals,cobjects,systems,verbose,script,files;
  46
  47
  48 {****************************************************************************
  49                                TLinkerGo32v2
  50 ****************************************************************************}
  51
  52 Constructor TLinkerGo32v2.Init;
  53 begin
  54   Inherited Init;
  55   { allow duplicated libs (PM) }
  56   SharedLibFiles.doubles:=true;
  57   StaticLibFiles.doubles:=true;
  58 end;
  59
  60
  61 procedure TLinkerGo32v2.SetDefaultInfo;
  62 begin
  63   with Info do
  64    begin
  65      ExeCmd[1]:='ld -oformat coff-go32-exe $OPT $STRIP -o $EXE @$RES';
  66    end;
  67 end;
  68
  69
  70 Function TLinkerGo32v2.WriteResponseFile(isdll:boolean) : Boolean;
  71 Var
  72   linkres  : TLinkRes;
  73   i        : longint;
  74 {$IFDEF NEWST}
  75   HPath    : PStringItem;
  76 {$ELSE}
  77   HPath    : PStringQueueItem;
  78 {$ENDIF NEWST}
  79   s        : string;
  80   linklibc : boolean;
  81 begin
  82   WriteResponseFile:=False;
  83
  84   { Open link.res file }
  85   LinkRes.Init(outputexedir+Info.ResName);
  86
  87   { Write path to search libraries }
  88   HPath:=current_module^.locallibrarysearchpath.First;
  89   while assigned(HPath) do
  90    begin
  91      LinkRes.Add('-L'+GetShortName(HPath^.Data^));
  92      HPath:=HPath^.Next;
  93    end;
  94   HPath:=LibrarySearchPath.First;
  95   while assigned(HPath) do
  96    begin
  97      LinkRes.Add('-L'+GetShortName(HPath^.Data^));
  98      HPath:=HPath^.Next;
  99    end;
 100
 101   { add objectfiles, start with prt0 always }
 102   LinkRes.AddFileName(GetShortName(FindObjectFile('prt0','')));
 103   while not ObjectFiles.Empty do
 104    begin
 105      s:=ObjectFiles.Get;
 106      if s<>'' then
 107       LinkRes.AddFileName(GetShortName(s));
 108    end;
 109
 110   { Write staticlibraries }
 111   if not StaticLibFiles.Empty then
 112    begin
 113      LinkRes.Add('-(');
 114      While not StaticLibFiles.Empty do
 115       begin
 116         S:=StaticLibFiles.Get;
 117         LinkRes.AddFileName(GetShortName(s))
 118       end;
 119      LinkRes.Add('-)');
 120    end;
 121
 122   { Write sharedlibraries like -l<lib>, also add the needed dynamic linker
 123     here to be sure that it gets linked this is needed for glibc2 systems (PFV) }
 124   linklibc:=false;
 125   While not SharedLibFiles.Empty do
 126    begin
 127      S:=SharedLibFiles.Get;
 128      if s<>'c' then
 129       begin
 130         i:=Pos(target_os.sharedlibext,S);
 131         if i>0 then
 132          Delete(S,i,255);
 133         LinkRes.Add('-l'+s);
 134       end
 135      else
 136       begin
 137         LinkRes.Add('-l'+s);
 138         linklibc:=true;
 139       end;
 140    end;
 141   { be sure that libc&libgcc is the last lib }
 142   if linklibc then
 143    begin
 144      LinkRes.Add('-lc');
 145      LinkRes.Add('-lgcc');
 146    end;
 147
 148 { Write and Close response }
 149   linkres.writetodisk;
 150   linkres.done;
 151
 152   WriteResponseFile:=True;
 153 end;
 154
 155
 156 function TLinkerGo32v2.MakeExecutable:boolean;
 157 var
 158   binstr,
 159   cmdstr  : string;
 160   success : boolean;
 161   StripStr : string[40];
 162 begin
 163   if not(cs_link_extern in aktglobalswitches) then
 164    Message1(exec_i_linking,current_module^.exefilename^);
 165
 166 { Create some replacements }
 167   StripStr:='';
 168   if (cs_link_strip in aktglobalswitches) then
 169    StripStr:='-s';
 170
 171 { Write used files and libraries }
 172   WriteResponseFile(false);
 173
 174 { Call linker }
 175   SplitBinCmd(Info.ExeCmd[1],binstr,cmdstr);
 176   Replace(cmdstr,'$EXE',current_module^.exefilename^);
 177   Replace(cmdstr,'$OPT',Info.ExtraOptions);
 178   Replace(cmdstr,'$RES',outputexedir+Info.ResName);
 179   Replace(cmdstr,'$STRIP',StripStr);
 180   success:=DoExec(FindUtil(BinStr),cmdstr,true,false);
 181
 182 { Remove ReponseFile }
 183   if (success) and not(cs_link_extern in aktglobalswitches) then
 184    RemoveFile(outputexedir+Info.ResName);
 185
 186   MakeExecutable:=success;   { otherwise a recursive call to link method }
 187 end;
 188
 189
 190 {$ifdef notnecessary}
 191 procedure tlinkergo32v2.postprocessexecutable(const n : string);
 192 type
 193   tcoffheader=packed record
 194     mach   : word;
 195     nsects : word;
 196     time   : longint;
 197     sympos : longint;
 198     syms   : longint;
 199     opthdr : word;
 200     flag   : word;
 201   end;
 202   tcoffsechdr=packed record
 203     name     : array[0..7] of char;
 204     vsize    : longint;
 205     rvaofs   : longint;
 206     datalen  : longint;
 207     datapos  : longint;
 208     relocpos : longint;
 209     lineno1  : longint;
 210     nrelocs  : word;
 211     lineno2  : word;
 212     flags    : longint;
 213   end;
 214   psecfill=^tsecfill;
 215   tsecfill=record
 216     fillpos,
 217     fillsize : longint;
 218     next : psecfill;
 219   end;
 220 var
 221   f : file;
 222   coffheader : tcoffheader;
 223   firstsecpos,
 224   maxfillsize,
 225   l : longint;
 226   coffsec : tcoffsechdr;
 227   secroot,hsecroot : psecfill;
 228   zerobuf : pointer;
 229 begin
 230   { when -s is used quit, because there is no .exe }
 231   if cs_link_extern in aktglobalswitches then
 232    exit;
 233   { open file }
 234   assign(f,n);
 235   {$I-}
 236    reset(f,1);
 237   if ioresult<>0 then
 238     Message1(execinfo_f_cant_open_executable,n);
 239   { read headers }
 240   seek(f,2048);
 241   blockread(f,coffheader,sizeof(tcoffheader));
 242   { read section info }
 243   maxfillsize:=0;
 244   firstsecpos:=0;
 245   secroot:=nil;
 246   for l:=1to coffheader.nSects do
 247    begin
 248      blockread(f,coffsec,sizeof(tcoffsechdr));
 249      if coffsec.datapos>0 then
 250       begin
 251         if secroot=nil then
 252          firstsecpos:=coffsec.datapos;
 253         new(hsecroot);
 254         hsecroot^.fillpos:=coffsec.datapos+coffsec.vsize;
 255         hsecroot^.fillsize:=coffsec.datalen-coffsec.vsize;
 256         hsecroot^.next:=secroot;
 257         secroot:=hsecroot;
 258         if secroot^.fillsize>maxfillsize then
 259          maxfillsize:=secroot^.fillsize;
 260       end;
 261    end;
 262   if firstsecpos>0 then
 263    begin
 264      l:=firstsecpos-filepos(f);
 265      if l>maxfillsize then
 266       maxfillsize:=l;
 267    end
 268   else
 269    l:=0;
 270   { get zero buffer }
 271   getmem(zerobuf,maxfillsize);
 272   fillchar(zerobuf^,maxfillsize,0);
 273   { zero from sectioninfo until first section }
 274   blockwrite(f,zerobuf^,l);
 275   { zero section alignments }
 276   while assigned(secroot) do
 277    begin
 278      seek(f,secroot^.fillpos);
 279      blockwrite(f,zerobuf^,secroot^.fillsize);
 280      hsecroot:=secroot;
 281      secroot:=secroot^.next;
 282      dispose(hsecroot);
 283    end;
 284   freemem(zerobuf,maxfillsize);
 285   close(f);
 286   {$I+}
 287   i:=ioresult;
 288   postprocessexecutable:=true;
 289 end;
 290 {$endif}
 291
 292 end.
 293 {
 294   $Log$
 295   Revision 1.1  2002/02/19 08:24:11  sasu
 296   Initial revision
 297
 298   Revision 1.1  2000/07/13 06:29:57  michael
 299   + Initial import
 300
 301   Revision 1.11  2000/07/08 20:43:38  peter
 302     * findobjectfile gets extra arg with directory where the unit is found
 303       and the .o should be looked first
 304
 305   Revision 1.10  2000/02/28 17:23:57  daniel
 306   * Current work of symtable integration committed. The symtable can be
 307     activated by defining 'newst', but doesn't compile yet. Changes in type
 308     checking and oop are completed. What is left is to write a new
 309     symtablestack and adapt the parser to use it.
 310
 311   Revision 1.9  2000/02/09 13:23:06  peter
 312     * log truncated
 313
 314   Revision 1.8  2000/01/09 00:55:51  pierre
 315     * GROUP of smartlink units put before the C libraries
 316       to allow for smartlinking code that uses C code.
 317
 318   Revision 1.7  2000/01/07 01:14:42  peter
 319     * updated copyright to 2000
 320
 321   Revision 1.6  1999/12/06 18:21:04  peter
 322     * support !ENVVAR for long commandlines
 323     * win32/go32v2 write short pathnames to link.res so c:\Program Files\ is
 324       finally supported as installdir.
 325
 326   Revision 1.5  1999/11/16 23:39:04  peter
 327     * use outputexedir for link.res location
 328
 329   Revision 1.4  1999/11/12 11:03:50  peter
 330     * searchpaths changed to stringqueue object
 331
 332   Revision 1.3  1999/11/04 10:55:31  peter
 333     * TSearchPathString for the string type of the searchpaths, which is
 334       ansistring under FPC/Delphi
 335
 336   Revision 1.2  1999/10/22 14:42:40  peter
 337     * reset linklibc
 338
 339   Revision 1.1  1999/10/21 14:29:38  peter
 340     * redesigned linker object
 341     + library support for linux (only procedures can be exported)
 342
 343 }