* moved target units to subdir

compiler/Makefile

@@ -177,7 +177,7 @@ endif
 override LOCALOPT+=$(LOCALDEF)
 override FPCOPT:=$(LOCALOPT)
 override COMPILER_INCLUDEDIR+=$(CPU_TARGET)
-override COMPILER_UNITDIR+=$(CPU_TARGET)
+override COMPILER_UNITDIR+=$(CPU_TARGET) targets
 override COMPILER_TARGETDIR+=.
 ifndef ECHO
 ECHO:=$(strip $(wildcard $(addsuffix /gecho$(EXEEXT),$(SEARCHPATH))))

compiler/Makefile.fpc

@@ -8,7 +8,7 @@ version=1.1
 
 [compiler]
 targetdir=.
-unitdir=$(CPU_TARGET)
+unitdir=$(CPU_TARGET) targets
 includedir=$(CPU_TARGET)
 
 [require]

compiler/targets/t_fbsd.pas

@@ -0,0 +1,472 @@
+{
+    $Id$
+    Copyright (c) 1998-2000 by Peter Vreman (original Linux)
+              (c) 2000      by Marco van de Voort (FreeBSD mods)
+
+    This unit implements support import,export,link routines
+    for the (i386)FreeBSD target
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+ ****************************************************************************
+}
+unit t_fbsd;
+
+{$i defines.inc}
+
+interface
+
+  uses
+    import,export,link;
+
+  type
+    timportlibfreebsd=class(timportlib)
+      procedure preparelib(const s:string);override;
+      procedure importprocedure(const func,module:string;index:longint;const name:string);override;
+      procedure importvariable(const varname,module:string;const name:string);override;
+      procedure generatelib;override;
+    end;
+
+    texportlibfreebsd=class(texportlib)
+      procedure preparelib(const s : string);override;
+      procedure exportprocedure(hp : texported_item);override;
+      procedure exportvar(hp : texported_item);override;
+      procedure generatelib;override;
+    end;
+
+    tlinkerfreebsd=class(tlinker)
+    private
+      Glibc2,
+      Glibc21 : boolean;
+      Function  WriteResponseFile(isdll:boolean) : Boolean;
+    public
+      constructor Create;
+      procedure SetDefaultInfo;override;
+      function  MakeExecutable:boolean;override;
+      function  MakeSharedLibrary:boolean;override;
+    end;
+
+
+implementation
+
+  uses
+    cutils,cclasses,
+    verbose,systems,globtype,globals,
+    symconst,script,
+    fmodule,aasm,cpuasm,cpubase,symsym;
+
+{*****************************************************************************
+                               TIMPORTLIBLINUX
+*****************************************************************************}
+
+procedure timportlibfreebsd.preparelib(const s : string);
+begin
+end;
+
+
+procedure timportlibfreebsd.importprocedure(const func,module : string;index : longint;const name : string);
+begin
+  { insert sharedlibrary }
+  current_module.linkothersharedlibs.add(SplitName(module),link_allways);
+  { do nothing with the procedure, only set the mangledname }
+  if name<>'' then
+    aktprocsym^.definition^.setmangledname(name)
+  else
+    message(parser_e_empty_import_name);
+end;
+
+
+procedure timportlibfreebsd.importvariable(const varname,module:string;const name:string);
+begin
+  { insert sharedlibrary }
+  current_module.linkothersharedlibs.add(SplitName(module),link_allways);
+  { reset the mangledname and turn off the dll_var option }
+  aktvarsym^.setmangledname(name);
+  exclude(aktvarsym^.varoptions,vo_is_dll_var);
+end;
+
+
+procedure timportlibfreebsd.generatelib;
+begin
+end;
+
+
+{*****************************************************************************
+                               TEXPORTLIBLINUX
+*****************************************************************************}
+
+procedure texportlibfreebsd.preparelib(const s:string);
+begin
+end;
+
+
+procedure texportlibfreebsd.exportprocedure(hp : texported_item);
+var
+  hp2 : texported_item;
+begin
+  { first test the index value }
+  if (hp.options and eo_index)<>0 then
+   begin
+     Message1(parser_e_no_export_with_index_for_target,'freebsd');
+     exit;
+   end;
+  { now place in correct order }
+  hp2:=texported_item(current_module._exports.first);
+  while assigned(hp2) and
+     (hp.name^>hp2.name^) do
+    hp2:=texported_item(hp2.next);
+  { insert hp there !! }
+  if assigned(hp2) and (hp2.name^=hp.name^) then
+    begin
+      { this is not allowed !! }
+      Message1(parser_e_export_name_double,hp.name^);
+      exit;
+    end;
+  if hp2=texported_item(current_module._exports.first) then
+    current_module._exports.concat(hp)
+  else if assigned(hp2) then
+    begin
+       hp.next:=hp2;
+       hp.previous:=hp2.previous;
+       if assigned(hp2.previous) then
+         hp2.previous.next:=hp;
+       hp2.previous:=hp;
+    end
+  else
+    current_module._exports.concat(hp);
+end;
+
+
+procedure texportlibfreebsd.exportvar(hp : texported_item);
+begin
+  hp.is_var:=true;
+  exportprocedure(hp);
+end;
+
+
+procedure texportlibfreebsd.generatelib;
+var
+  hp2 : texported_item;
+begin
+  hp2:=texported_item(current_module._exports.first);
+  while assigned(hp2) do
+   begin
+     if not hp2.is_var then
+      begin
+{$ifdef i386}
+        { place jump in codesegment }
+        codeSegment.concat(Tai_align.Create_op(4,$90));
+        codeSegment.concat(Tai_symbol.Createname_global(hp2.name^,0));
+        codeSegment.concat(Taicpu.Op_sym(A_JMP,S_NO,newasmsymbol(hp2.sym^.mangledname)));
+        codeSegment.concat(Tai_symbol_end.Createname(hp2.name^));
+{$endif i386}
+      end
+     else
+      Message1(parser_e_no_export_of_variables_for_target,'freebsd');
+     hp2:=texported_item(hp2.next);
+   end;
+end;
+
+
+{*****************************************************************************
+                                  TLINKERLINUX
+*****************************************************************************}
+
+Constructor TLinkerFreeBSD.Create;
+begin
+  Inherited Create;
+  LibrarySearchPath.AddPath('/lib;/usr/lib;/usr/X11R6/lib',true);
+end;
+
+
+procedure TLinkerFreeBSD.SetDefaultInfo;
+{
+  This will also detect which libc version will be used
+}
+begin
+  Glibc2:=false;
+  Glibc21:=false;
+  with Info do
+   begin
+     ExeCmd[1]:='ld $OPT $DYNLINK $STATIC $STRIP -L. -o $EXE $RES';
+     DllCmd[1]:='ld $OPT -shared -L. -o $EXE $RES';
+     DllCmd[2]:='strip --strip-unneeded $EXE';
+     { first try glibc2 }
+     {$ifndef BSD} {Keep linux code in place. FBSD might go to a different
+                                glibc too once}
+     DynamicLinker:='/lib/ld-linux.so.2';
+     if FileExists(DynamicLinker) then
+      begin
+        Glibc2:=true;
+        { Check for 2.0 files, else use the glibc 2.1 stub }
+        if FileExists('/lib/ld-2.0.*') then
+         Glibc21:=false
+        else
+         Glibc21:=true;
+      end
+     else
+      DynamicLinker:='/lib/ld-linux.so.1';
+     {$ELSE}
+      DynamicLinker:='';
+     {$endif}
+   end;
+
+end;
+
+
+Function TLinkerFreeBSD.WriteResponseFile(isdll:boolean) : Boolean;
+Var
+  linkres      : TLinkRes;
+  i            : longint;
+  cprtobj,
+  gprtobj,
+  prtobj       : string[80];
+  HPath        : TStringListItem;
+  s            : string;
+  linkdynamic,
+  linklibc     : boolean;
+begin
+  WriteResponseFile:=False;
+{ set special options for some targets }
+  linkdynamic:=not(SharedLibFiles.empty);
+  linklibc:=(SharedLibFiles.Find('c')<>nil);
+  prtobj:='prt0';
+  cprtobj:='cprt0';
+  gprtobj:='gprt0';
+  if glibc21 then
+   begin
+     cprtobj:='cprt21';
+     gprtobj:='gprt21';
+   end;
+  if cs_profile in aktmoduleswitches then
+   begin
+     prtobj:=gprtobj;
+     if not glibc2 then
+      AddSharedLibrary('gmon');
+     AddSharedLibrary('c');
+     linklibc:=true;
+   end
+  else
+   begin
+     if linklibc then
+      prtobj:=cprtobj;
+   end;
+
+  { Open link.res file }
+  LinkRes.Init(outputexedir+Info.ResName);
+
+  { Write path to search libraries }
+  HPath:=TStringListItem(current_module.locallibrarysearchpath.First);
+  while assigned(HPath) do
+   begin
+     LinkRes.Add('SEARCH_DIR('+HPath.Str+')');
+     HPath:=TStringListItem(HPath.Next);
+   end;
+  HPath:=TStringListItem(LibrarySearchPath.First);
+  while assigned(HPath) do
+   begin
+     LinkRes.Add('SEARCH_DIR('+HPath.Str+')');
+     HPath:=TStringListItem(HPath.Next);
+   end;
+
+  LinkRes.Add('INPUT(');
+  { add objectfiles, start with prt0 always }
+  if prtobj<>'' then
+   LinkRes.AddFileName(FindObjectFile(prtobj,''));
+  { try to add crti and crtbegin if linking to C }
+  if linklibc then
+   begin
+     if librarysearchpath.FindFile('crtbegin.o',s) then
+      LinkRes.AddFileName(s);
+     if librarysearchpath.FindFile('crti.o',s) then
+      LinkRes.AddFileName(s);
+   end;
+  { main objectfiles }
+  while not ObjectFiles.Empty do
+   begin
+     s:=ObjectFiles.GetFirst;
+     if s<>'' then
+      LinkRes.AddFileName(s);
+   end;
+  { objects which must be at the end }
+  if linklibc then
+   begin
+     if librarysearchpath.FindFile('crtend.o',s) then
+      LinkRes.AddFileName(s);
+     if librarysearchpath.FindFile('crtn.o',s) then
+      LinkRes.AddFileName(s);
+   end;
+  LinkRes.Add(')');
+
+  { Write staticlibraries }
+  if not StaticLibFiles.Empty then
+   begin
+     LinkRes.Add('GROUP(');
+     While not StaticLibFiles.Empty do
+      begin
+        S:=StaticLibFiles.GetFirst;
+        LinkRes.AddFileName(s)
+      end;
+     LinkRes.Add(')');
+   end;
+
+  { Write sharedlibraries like -l<lib>, also add the needed dynamic linker
+    here to be sure that it gets linked this is needed for glibc2 systems (PFV) }
+  if not SharedLibFiles.Empty then
+   begin
+     LinkRes.Add('INPUT(');
+     While not SharedLibFiles.Empty do
+      begin
+        S:=SharedLibFiles.GetFirst;
+        if s<>'c' then
+         begin
+           i:=Pos(target_os.sharedlibext,S);
+           if i>0 then
+            Delete(S,i,255);
+           LinkRes.Add('-l'+s);
+         end
+        else
+         begin
+           linklibc:=true;
+           linkdynamic:=false; { libc will include the ld-linux for us }
+         end;
+      end;
+     { be sure that libc is the last lib }
+     if linklibc then
+      LinkRes.Add('-lc');
+     { when we have -static for the linker the we also need libgcc }
+     if (cs_link_staticflag in aktglobalswitches) then
+      LinkRes.Add('-lgcc');
+     if linkdynamic and (Info.DynamicLinker<>'') then
+      LinkRes.AddFileName(Info.DynamicLinker);
+     LinkRes.Add(')');
+   end;
+{ Write and Close response }
+  linkres.writetodisk;
+  linkres.done;
+
+  WriteResponseFile:=True;
+end;
+
+
+function TLinkerFreeBSD.MakeExecutable:boolean;
+var
+  binstr,
+  cmdstr  : string;
+  success : boolean;
+  DynLinkStr : string[60];
+  StaticStr,
+  StripStr   : string[40];
+begin
+  if not(cs_link_extern in aktglobalswitches) then
+   Message1(exec_i_linking,current_module.exefilename^);
+
+{ Create some replacements }
+  StaticStr:='';
+  StripStr:='';
+  DynLinkStr:='';
+  if (cs_link_staticflag in aktglobalswitches) then
+   StaticStr:='-static';
+  if (cs_link_strip in aktglobalswitches) then
+   StripStr:='-s';
+  If (cs_profile in aktmoduleswitches) or
+     ((Info.DynamicLinker<>'') and (not SharedLibFiles.Empty)) then
+   DynLinkStr:='-dynamic-linker='+Info.DynamicLinker;
+
+{ Write used files and libraries }
+  WriteResponseFile(false);
+
+{ Call linker }
+  SplitBinCmd(Info.ExeCmd[1],binstr,cmdstr);
+  Replace(cmdstr,'$EXE',current_module.exefilename^);
+  Replace(cmdstr,'$OPT',Info.ExtraOptions);
+  Replace(cmdstr,'$RES',outputexedir+Info.ResName);
+  Replace(cmdstr,'$STATIC',StaticStr);
+  Replace(cmdstr,'$STRIP',StripStr);
+  Replace(cmdstr,'$DYNLINK',DynLinkStr);
+  success:=DoExec(FindUtil(BinStr),CmdStr,true,false);
+
+{ Remove ReponseFile }
+  if (success) and not(cs_link_extern in aktglobalswitches) then
+   RemoveFile(outputexedir+Info.ResName);
+
+  MakeExecutable:=success;   { otherwise a recursive call to link method }
+end;
+
+
+Function TLinkerFreeBSD.MakeSharedLibrary:boolean;
+var
+  binstr,
+  cmdstr  : string;
+  success : boolean;
+begin
+  MakeSharedLibrary:=false;
+  if not(cs_link_extern in aktglobalswitches) then
+   Message1(exec_i_linking,current_module.sharedlibfilename^);
+
+{ Write used files and libraries }
+  WriteResponseFile(true);
+
+{ Call linker }
+  SplitBinCmd(Info.DllCmd[1],binstr,cmdstr);
+  Replace(cmdstr,'$EXE',current_module.sharedlibfilename^);
+  Replace(cmdstr,'$OPT',Info.ExtraOptions);
+  Replace(cmdstr,'$RES',outputexedir+Info.ResName);
+  success:=DoExec(FindUtil(binstr),cmdstr,true,false);
+
+{ Strip the library ? }
+  if success and (cs_link_strip in aktglobalswitches) then
+   begin
+     SplitBinCmd(Info.DllCmd[2],binstr,cmdstr);
+     Replace(cmdstr,'$EXE',current_module.sharedlibfilename^);
+     success:=DoExec(FindUtil(binstr),cmdstr,true,false);
+   end;
+
+{ Remove ReponseFile }
+  if (success) and not(cs_link_extern in aktglobalswitches) then
+   RemoveFile(outputexedir+Info.ResName);
+
+  MakeSharedLibrary:=success;   { otherwise a recursive call to link method }
+end;
+
+end.
+{
+  $Log$
+  Revision 1.1  2001-02-26 19:43:11  peter
+    * moved target units to subdir
+
+  Revision 1.7  2001/02/20 21:41:17  peter
+    * new fixfilename, findfile for unix. Look first for lowercase, then
+      NormalCase and last for UPPERCASE names.
+
+  Revision 1.6  2000/12/30 22:53:25  peter
+    * export with the case provided in the exports section
+
+  Revision 1.5  2000/12/25 00:07:30  peter
+    + new tlinkedlist class (merge of old tstringqueue,tcontainer and
+      tlinkedlist objects)
+
+  Revision 1.4  2000/10/31 22:02:53  peter
+    * symtable splitted, no real code changes
+
+  Revision 1.3  2000/09/24 21:33:47  peter
+    * message updates merges
+
+  Revision 1.2  2000/09/24 15:12:12  peter
+    * renamed to be 8.3
+
+  Revision 1.2  2000/09/16 12:24:00  peter
+    * freebsd support routines
+}

compiler/targets/t_go32v1.pas

@@ -0,0 +1,209 @@
+{
+    $Id$
+    Copyright (c) 1998-2000 by Peter Vreman
+
+    This unit implements support import,export,link routines
+    for the (i386) go32v1 target
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+ ****************************************************************************
+}
+unit t_go32v1;
+
+{$i defines.inc}
+
+interface
+
+  uses
+    link;
+
+  type
+    tlinkergo32v1=class(tlinker)
+    private
+       Function  WriteResponseFile(isdll:boolean) : Boolean;
+    public
+       constructor Create;
+       procedure SetDefaultInfo;override;
+       function  MakeExecutable:boolean;override;
+    end;
+
+
+  implementation
+
+    uses
+       cutils,cclasses,
+       globtype,globals,systems,verbose,script,fmodule;
+
+
+{****************************************************************************
+                               TLinkergo32v1
+****************************************************************************}
+
+Constructor TLinkergo32v1.Create;
+begin
+  Inherited Create;
+  { allow duplicated libs (PM) }
+  SharedLibFiles.doubles:=true;
+  StaticLibFiles.doubles:=true;
+end;
+
+
+procedure TLinkergo32v1.SetDefaultInfo;
+begin
+  with Info do
+   begin
+     ExeCmd[1]:='ld -oformat coff-go32 $OPT $STRIP -o $EXE @$RES';
+     ExeCmd[2]:='aout2exe $EXE';
+   end;
+end;
+
+
+Function TLinkergo32v1.WriteResponseFile(isdll:boolean) : Boolean;
+Var
+  linkres  : TLinkRes;
+  i        : longint;
+  HPath    : TStringListItem;
+  s        : string;
+  linklibc : boolean;
+begin
+  WriteResponseFile:=False;
+
+  { Open link.res file }
+  LinkRes.Init(outputexedir+Info.ResName);
+
+  { Write path to search libraries }
+  HPath:=TStringListItem(current_module.locallibrarysearchpath.First);
+  while assigned(HPath) do
+   begin
+     LinkRes.Add('-L'+HPath.Str);
+     HPath:=TStringListItem(HPath.Next);
+   end;
+  HPath:=TStringListItem(LibrarySearchPath.First);
+  while assigned(HPath) do
+   begin
+     LinkRes.Add('-L'+HPath.Str);
+     HPath:=TStringListItem(HPath.Next);
+   end;
+
+  { add objectfiles, start with prt0 always }
+  LinkRes.AddFileName(FindObjectFile('prt0',''));
+  while not ObjectFiles.Empty do
+   begin
+     s:=ObjectFiles.GetFirst;
+     if s<>'' then
+      LinkRes.AddFileName(s);
+   end;
+
+  { Write staticlibraries }
+  if not StaticLibFiles.Empty then
+   begin
+     LinkRes.Add('-(');
+     While not StaticLibFiles.Empty do
+      begin
+        S:=StaticLibFiles.GetFirst;
+        LinkRes.AddFileName(s)
+      end;
+     LinkRes.Add('-)');
+   end;
+
+  { Write sharedlibraries like -l<lib>, also add the needed dynamic linker
+    here to be sure that it gets linked this is needed for glibc2 systems (PFV) }
+  linklibc:=false;
+  While not SharedLibFiles.Empty do
+   begin
+     S:=SharedLibFiles.GetFirst;
+     if s<>'c' then
+      begin
+        i:=Pos(target_os.sharedlibext,S);
+        if i>0 then
+         Delete(S,i,255);
+        LinkRes.Add('-l'+s);
+      end
+     else
+      begin
+        LinkRes.Add('-l'+s);
+        linklibc:=true;
+      end;
+   end;
+  { be sure that libc&libgcc is the last lib }
+  if linklibc then
+   begin
+     LinkRes.Add('-lc');
+     LinkRes.Add('-lgcc');
+   end;
+
+{ Write and Close response }
+  linkres.writetodisk;
+  linkres.done;
+
+  WriteResponseFile:=True;
+end;
+
+
+function TLinkergo32v1.MakeExecutable:boolean;
+var
+  binstr,
+  cmdstr  : string;
+  success : boolean;
+  StripStr : string[40];
+begin
+  if not(cs_link_extern in aktglobalswitches) then
+   Message1(exec_i_linking,current_module.exefilename^);
+
+{ Create some replacements }
+  StripStr:='';
+  if (cs_link_strip in aktglobalswitches) then
+   StripStr:='-s';
+
+{ Write used files and libraries }
+  WriteResponseFile(false);
+
+{ Call linker }
+  SplitBinCmd(Info.ExeCmd[1],binstr,cmdstr);
+  Replace(cmdstr,'$EXE',current_module.exefilename^);
+  Replace(cmdstr,'$OPT',Info.ExtraOptions);
+  Replace(cmdstr,'$RES',outputexedir+Info.ResName);
+  Replace(cmdstr,'$STRIP',StripStr);
+  success:=DoExec(FindUtil(BinStr),cmdstr,true,false);
+
+{ Remove ReponseFile }
+  if (success) and not(cs_link_extern in aktglobalswitches) then
+   RemoveFile(outputexedir+Info.ResName);
+
+  MakeExecutable:=success;   { otherwise a recursive call to link method }
+end;
+
+end.
+{
+  $Log$
+  Revision 1.1  2001-02-26 19:43:11  peter
+    * moved target units to subdir
+
+  Revision 1.5  2000/12/25 00:07:30  peter
+    + new tlinkedlist class (merge of old tstringqueue,tcontainer and
+      tlinkedlist objects)
+
+  Revision 1.4  2000/09/24 15:06:30  peter
+    * use defines.inc
+
+  Revision 1.3  2000/08/27 16:11:54  peter
+    * moved some util functions from globals,cobjects to cutils
+    * splitted files into finput,fmodule
+
+  Revision 1.2  2000/07/13 11:32:50  michael
+  + removed logs
+
+}

compiler/targets/t_go32v2.pas

@@ -0,0 +1,445 @@
+{
+    $Id$
+    Copyright (c) 1998-2000 by Peter Vreman
+
+    This unit implements support import,export,link routines
+    for the (i386) Go32v2 target
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+ ****************************************************************************
+}
+unit t_go32v2;
+
+{$i defines.inc}
+
+interface
+
+  uses
+    link;
+
+  type
+    tlinkergo32v2=class(tlinker)
+    private
+       Function  WriteResponseFile(isdll:boolean) : Boolean;
+       Function  WriteScript(isdll:boolean) : Boolean;
+    public
+       constructor Create;
+       procedure SetDefaultInfo;override;
+       function  MakeExecutable:boolean;override;
+    end;
+
+
+  implementation
+
+    uses
+       cutils,cclasses,
+       globtype,globals,systems,verbose,script,fmodule;
+
+
+{****************************************************************************
+                               TLinkerGo32v2
+****************************************************************************}
+
+Constructor TLinkerGo32v2.Create;
+begin
+  Inherited Create;
+  { allow duplicated libs (PM) }
+  SharedLibFiles.doubles:=true;
+  StaticLibFiles.doubles:=true;
+end;
+
+
+procedure TLinkerGo32v2.SetDefaultInfo;
+begin
+  with Info do
+   begin
+      if cs_align in aktglobalswitches then
+        ExeCmd[1]:='ld $SCRIPT $OPT $STRIP -o $EXE'
+      else
+        ExeCmd[1]:='ld -oformat coff-go32-exe $OPT $STRIP -o $EXE @$RES'
+   end;
+end;
+
+
+Function TLinkerGo32v2.WriteResponseFile(isdll:boolean) : Boolean;
+Var
+  linkres  : TLinkRes;
+  i        : longint;
+  HPath    : TStringListItem;
+  s        : string;
+  linklibc : boolean;
+begin
+  WriteResponseFile:=False;
+
+  { Open link.res file }
+  LinkRes.Init(outputexedir+Info.ResName);
+
+  { Write path to search libraries }
+  HPath:=TStringListItem(current_module.locallibrarysearchpath.First);
+  while assigned(HPath) do
+   begin
+     LinkRes.Add('-L'+GetShortName(HPath.Str));
+     HPath:=TStringListItem(HPath.Next);
+   end;
+  HPath:=TStringListItem(LibrarySearchPath.First);
+  while assigned(HPath) do
+   begin
+     LinkRes.Add('-L'+GetShortName(HPath.Str));
+     HPath:=TStringListItem(HPath.Next);
+   end;
+
+  { add objectfiles, start with prt0 always }
+  LinkRes.AddFileName(GetShortName(FindObjectFile('prt0','')));
+  while not ObjectFiles.Empty do
+   begin
+     s:=ObjectFiles.GetFirst;
+     if s<>'' then
+      LinkRes.AddFileName(GetShortName(s));
+   end;
+
+  { Write staticlibraries }
+  if not StaticLibFiles.Empty then
+   begin
+     LinkRes.Add('-(');
+     While not StaticLibFiles.Empty do
+      begin
+        S:=StaticLibFiles.GetFirst;
+        LinkRes.AddFileName(GetShortName(s))
+      end;
+     LinkRes.Add('-)');
+   end;
+
+  { Write sharedlibraries like -l<lib>, also add the needed dynamic linker
+    here to be sure that it gets linked this is needed for glibc2 systems (PFV) }
+  linklibc:=false;
+  While not SharedLibFiles.Empty do
+   begin
+     S:=SharedLibFiles.GetFirst;
+     if s<>'c' then
+      begin
+        i:=Pos(target_os.sharedlibext,S);
+        if i>0 then
+         Delete(S,i,255);
+        LinkRes.Add('-l'+s);
+      end
+     else
+      begin
+        LinkRes.Add('-l'+s);
+        linklibc:=true;
+      end;
+   end;
+  { be sure that libc&libgcc is the last lib }
+  if linklibc then
+   begin
+     LinkRes.Add('-lc');
+     LinkRes.Add('-lgcc');
+   end;
+
+{ Write and Close response }
+  linkres.writetodisk;
+  linkres.done;
+
+  WriteResponseFile:=True;
+end;
+
+Function TLinkerGo32v2.WriteScript(isdll:boolean) : Boolean;
+Var
+  scriptres  : TLinkRes;
+  i        : longint;
+  s        : string;
+  linklibc : boolean;
+begin
+  WriteScript:=False;
+
+  { Open link.res file }
+  ScriptRes.Init(outputexedir+Info.ResName);
+  ScriptRes.Add('OUTPUT_FORMAT("coff-go32-exe")');
+  ScriptRes.Add('ENTRY(start)');
+
+{$ifdef dummy}
+  { Write path to search libraries }
+  HPath:=current_module.locallibrarysearchpath.First;
+  while assigned(HPath) do
+   begin
+     ScriptRes.Add('SEARCH_PATH("'+GetShortName(HPath^.Data^)+'")');
+     HPath:=HPath^.Next;
+   end;
+  HPath:=LibrarySearchPath.First;
+  while assigned(HPath) do
+   begin
+     ScriptRes.Add('SEARCH_PATH("'+GetShortName(HPath^.Data^)+'")');
+     HPath:=HPath^.Next;
+   end;
+{$endif dummy}
+
+  ScriptRes.Add('SECTIONS');
+  ScriptRes.Add('{');
+  ScriptRes.Add('  .text  0x1000+SIZEOF_HEADERS : {');
+  ScriptRes.Add('  . = ALIGN(16);');
+  { add objectfiles, start with prt0 always }
+  ScriptRes.Add('  '+GetShortName(FindObjectFile('prt0',''))+'(.text)');
+  while not ObjectFiles.Empty do
+   begin
+     s:=ObjectFiles.GetFirst;
+     if s<>'' then
+       begin
+          ScriptRes.Add('  . = ALIGN(16);');
+          ScriptRes.Add('  '+GetShortName(s)+'(.text)');
+       end;
+   end;
+  ScriptRes.Add('    *(.text)');
+  ScriptRes.Add('    etext  =  . ; _etext = .;');
+  ScriptRes.Add('    . = ALIGN(0x200);');
+  ScriptRes.Add('  }');
+  ScriptRes.Add('    .data  ALIGN(0x200) : {');
+  ScriptRes.Add('      djgpp_first_ctor = . ;');
+  ScriptRes.Add('      *(.ctor)');
+  ScriptRes.Add('      djgpp_last_ctor = . ;');
+  ScriptRes.Add('      djgpp_first_dtor = . ;');
+  ScriptRes.Add('      *(.dtor)');
+  ScriptRes.Add('      djgpp_last_dtor = . ;');
+  ScriptRes.Add('      *(.data)');
+  ScriptRes.Add('      *(.gcc_exc)');
+  ScriptRes.Add('      ___EH_FRAME_BEGIN__ = . ;');
+  ScriptRes.Add('      *(.eh_fram)');
+  ScriptRes.Add('      ___EH_FRAME_END__ = . ;');
+  ScriptRes.Add('      LONG(0)');
+  ScriptRes.Add('       edata  =  . ; _edata = .;');
+  ScriptRes.Add('       . = ALIGN(0x200);');
+  ScriptRes.Add('    }');
+  ScriptRes.Add('    .bss  SIZEOF(.data) + ADDR(.data) :');
+  ScriptRes.Add('    {');
+  ScriptRes.Add('      _object.2 = . ;');
+  ScriptRes.Add('      . += 24 ;');
+  ScriptRes.Add('      *(.bss)');
+  ScriptRes.Add('      *(COMMON)');
+  ScriptRes.Add('       end = . ; _end = .;');
+  ScriptRes.Add('       . = ALIGN(0x200);');
+  ScriptRes.Add('    }');
+  ScriptRes.Add('  }');
+
+  { Write staticlibraries }
+  if not StaticLibFiles.Empty then
+   begin
+     ScriptRes.Add('-(');
+     While not StaticLibFiles.Empty do
+      begin
+        S:=StaticLibFiles.GetFirst;
+        ScriptRes.AddFileName(GetShortName(s))
+      end;
+     ScriptRes.Add('-)');
+   end;
+
+  { Write sharedlibraries like -l<lib>, also add the needed dynamic linker
+    here to be sure that it gets linked this is needed for glibc2 systems (PFV) }
+  linklibc:=false;
+  While not SharedLibFiles.Empty do
+   begin
+     S:=SharedLibFiles.GetFirst;
+     if s<>'c' then
+      begin
+        i:=Pos(target_os.sharedlibext,S);
+        if i>0 then
+         Delete(S,i,255);
+        ScriptRes.Add('-l'+s);
+      end
+     else
+      begin
+        ScriptRes.Add('-l'+s);
+        linklibc:=true;
+      end;
+   end;
+  { be sure that libc&libgcc is the last lib }
+  if linklibc then
+   begin
+     ScriptRes.Add('-lc');
+     ScriptRes.Add('-lgcc');
+   end;
+
+{ Write and Close response }
+  ScriptRes.WriteToDisk;
+  ScriptRes.done;
+
+  WriteScript:=True;
+end;
+
+function TLinkerGo32v2.MakeExecutable:boolean;
+var
+  binstr,
+  cmdstr  : string;
+  success : boolean;
+  StripStr : string[40];
+begin
+  if not(cs_link_extern in aktglobalswitches) then
+   Message1(exec_i_linking,current_module.exefilename^);
+
+{ Create some replacements }
+  StripStr:='';
+  if (cs_link_strip in aktglobalswitches) then
+   StripStr:='-s';
+
+  if cs_align in aktglobalswitches then
+    WriteScript(false)
+  else
+    { Write used files and libraries }
+    WriteResponseFile(false);
+
+{ Call linker }
+  SplitBinCmd(Info.ExeCmd[1],binstr,cmdstr);
+  Replace(cmdstr,'$EXE',current_module.exefilename^);
+  Replace(cmdstr,'$OPT',Info.ExtraOptions);
+  Replace(cmdstr,'$RES',outputexedir+Info.ResName);
+  Replace(cmdstr,'$STRIP',StripStr);
+  Replace(cmdstr,'$SCRIPT','--script='+outputexedir+Info.ResName);
+  success:=DoExec(FindUtil(BinStr),cmdstr,true,false);
+
+{ Remove ReponseFile }
+  if (success) and not(cs_link_extern in aktglobalswitches) then
+   RemoveFile(outputexedir+Info.ResName);
+
+  MakeExecutable:=success;   { otherwise a recursive call to link method }
+end;
+
+
+{$ifdef notnecessary}
+procedure tlinkergo32v2.postprocessexecutable(const n : string);
+type
+  tcoffheader=packed record
+    mach   : word;
+    nsects : word;
+    time   : longint;
+    sympos : longint;
+    syms   : longint;
+    opthdr : word;
+    flag   : word;
+  end;
+  tcoffsechdr=packed record
+    name     : array[0..7] of char;
+    vsize    : longint;
+    rvaofs   : longint;
+    datalen  : longint;
+    datapos  : longint;
+    relocpos : longint;
+    lineno1  : longint;
+    nrelocs  : word;
+    lineno2  : word;
+    flags    : longint;
+  end;
+  psecfill=^tsecfill;
+  tsecfill=record
+    fillpos,
+    fillsize : longint;
+    next : psecfill;
+  end;
+var
+  f : file;
+  coffheader : tcoffheader;
+  firstsecpos,
+  maxfillsize,
+  l : longint;
+  coffsec : tcoffsechdr;
+  secroot,hsecroot : psecfill;
+  zerobuf : pointer;
+begin
+  { when -s is used quit, because there is no .exe }
+  if cs_link_extern in aktglobalswitches then
+   exit;
+  { open file }
+  assign(f,n);
+  {$I-}
+   reset(f,1);
+  if ioresult<>0 then
+    Message1(execinfo_f_cant_open_executable,n);
+  { read headers }
+  seek(f,2048);
+  blockread(f,coffheader,sizeof(tcoffheader));
+  { read section info }
+  maxfillsize:=0;
+  firstsecpos:=0;
+  secroot:=nil;
+  for l:=1to coffheader.nSects do
+   begin
+     blockread(f,coffsec,sizeof(tcoffsechdr));
+     if coffsec.datapos>0 then
+      begin
+        if secroot=nil then
+         firstsecpos:=coffsec.datapos;
+        new(hsecroot);
+        hsecroot^.fillpos:=coffsec.datapos+coffsec.vsize;
+        hsecroot^.fillsize:=coffsec.datalen-coffsec.vsize;
+        hsecroot^.next:=secroot;
+        secroot:=hsecroot;
+        if secroot^.fillsize>maxfillsize then
+         maxfillsize:=secroot^.fillsize;
+      end;
+   end;
+  if firstsecpos>0 then
+   begin
+     l:=firstsecpos-filepos(f);
+     if l>maxfillsize then
+      maxfillsize:=l;
+   end
+  else
+   l:=0;
+  { get zero buffer }
+  getmem(zerobuf,maxfillsize);
+  fillchar(zerobuf^,maxfillsize,0);
+  { zero from sectioninfo until first section }
+  blockwrite(f,zerobuf^,l);
+  { zero section alignments }
+  while assigned(secroot) do
+   begin
+     seek(f,secroot^.fillpos);
+     blockwrite(f,zerobuf^,secroot^.fillsize);
+     hsecroot:=secroot;
+     secroot:=secroot^.next;
+     dispose(hsecroot);
+   end;
+  freemem(zerobuf,maxfillsize);
+  close(f);
+  {$I+}
+  i:=ioresult;
+  postprocessexecutable:=true;
+end;
+{$endif}
+
+end.
+{
+  $Log$
+  Revision 1.1  2001-02-26 19:43:11  peter
+    * moved target units to subdir
+
+  Revision 1.7  2001/01/27 21:29:35  florian
+     * behavior -Oa optimized
+
+  Revision 1.6  2000/12/25 00:07:30  peter
+    + new tlinkedlist class (merge of old tstringqueue,tcontainer and
+      tlinkedlist objects)
+
+  Revision 1.5  2000/09/24 15:06:31  peter
+    * use defines.inc
+
+  Revision 1.4  2000/08/27 16:11:54  peter
+    * moved some util functions from globals,cobjects to cutils
+    * splitted files into finput,fmodule
+
+  Revision 1.3  2000/08/16 13:06:07  florian
+    + support of 64 bit integer constants
+
+  Revision 1.2  2000/07/13 11:32:50  michael
+  + removed logs
+
+}

compiler/targets/t_linux.pas

@@ -0,0 +1,481 @@
+{
+    $Id$
+    Copyright (c) 1998-2000 by Peter Vreman
+
+    This unit implements support import,export,link routines
+    for the (i386) Linux target
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+ ****************************************************************************
+}
+unit t_linux;
+
+{$i defines.inc}
+
+interface
+
+  uses
+    import,export,link;
+
+  type
+    timportliblinux=class(timportlib)
+      procedure preparelib(const s:string);override;
+      procedure importprocedure(const func,module:string;index:longint;const name:string);override;
+      procedure importvariable(const varname,module:string;const name:string);override;
+      procedure generatelib;override;
+    end;
+
+    texportliblinux=class(texportlib)
+      procedure preparelib(const s : string);override;
+      procedure exportprocedure(hp : texported_item);override;
+      procedure exportvar(hp : texported_item);override;
+      procedure generatelib;override;
+    end;
+
+    tlinkerlinux=class(tlinker)
+    private
+      Glibc2,
+      Glibc21 : boolean;
+      Function  WriteResponseFile(isdll:boolean) : Boolean;
+    public
+      constructor Create;
+      procedure SetDefaultInfo;override;
+      function  MakeExecutable:boolean;override;
+      function  MakeSharedLibrary:boolean;override;
+    end;
+
+
+implementation
+
+  uses
+    cutils,cclasses,
+    verbose,systems,globtype,globals,
+    symconst,script,
+    fmodule,aasm,cpuasm,cpubase,symsym;
+
+{*****************************************************************************
+                               TIMPORTLIBLINUX
+*****************************************************************************}
+
+procedure timportliblinux.preparelib(const s : string);
+begin
+end;
+
+
+procedure timportliblinux.importprocedure(const func,module : string;index : longint;const name : string);
+begin
+  { insert sharedlibrary }
+  current_module.linkothersharedlibs.add(SplitName(module),link_allways);
+  { do nothing with the procedure, only set the mangledname }
+  if name<>'' then
+    aktprocsym^.definition^.setmangledname(name)
+  else
+    message(parser_e_empty_import_name);
+end;
+
+
+procedure timportliblinux.importvariable(const varname,module:string;const name:string);
+begin
+  { insert sharedlibrary }
+  current_module.linkothersharedlibs.add(SplitName(module),link_allways);
+  { reset the mangledname and turn off the dll_var option }
+  aktvarsym^.setmangledname(name);
+  exclude(aktvarsym^.varoptions,vo_is_dll_var);
+end;
+
+
+procedure timportliblinux.generatelib;
+begin
+end;
+
+
+{*****************************************************************************
+                               TEXPORTLIBLINUX
+*****************************************************************************}
+
+procedure texportliblinux.preparelib(const s:string);
+begin
+end;
+
+
+procedure texportliblinux.exportprocedure(hp : texported_item);
+var
+  hp2 : texported_item;
+begin
+  { first test the index value }
+  if (hp.options and eo_index)<>0 then
+   begin
+     Message1(parser_e_no_export_with_index_for_target,'linux');
+     exit;
+   end;
+  { now place in correct order }
+  hp2:=texported_item(current_module._exports.first);
+  while assigned(hp2) and
+     (hp.name^>hp2.name^) do
+    hp2:=texported_item(hp2.next);
+  { insert hp there !! }
+  if assigned(hp2) and (hp2.name^=hp.name^) then
+    begin
+      { this is not allowed !! }
+      Message1(parser_e_export_name_double,hp.name^);
+      exit;
+    end;
+  if hp2=texported_item(current_module._exports.first) then
+    current_module._exports.concat(hp)
+  else if assigned(hp2) then
+    begin
+       hp.next:=hp2;
+       hp.previous:=hp2.previous;
+       if assigned(hp2.previous) then
+         hp2.previous.next:=hp;
+       hp2.previous:=hp;
+    end
+  else
+    current_module._exports.concat(hp);
+end;
+
+
+procedure texportliblinux.exportvar(hp : texported_item);
+begin
+  hp.is_var:=true;
+  exportprocedure(hp);
+end;
+
+
+procedure texportliblinux.generatelib;
+var
+  hp2 : texported_item;
+begin
+  hp2:=texported_item(current_module._exports.first);
+  while assigned(hp2) do
+   begin
+     if not hp2.is_var then
+      begin
+{$ifdef i386}
+        { place jump in codesegment }
+        codesegment.concat(Tai_align.Create_op(4,$90));
+        codeSegment.concat(Tai_symbol.Createname_global(hp2.name^,0));
+        codeSegment.concat(Taicpu.Op_sym(A_JMP,S_NO,newasmsymbol(hp2.sym^.mangledname)));
+        codeSegment.concat(Tai_symbol_end.Createname(hp2.name^));
+{$endif i386}
+      end
+     else
+      Message1(parser_e_no_export_of_variables_for_target,'linux');
+     hp2:=texported_item(hp2.next);
+   end;
+end;
+
+
+{*****************************************************************************
+                                  TLINKERLINUX
+*****************************************************************************}
+
+Constructor TLinkerLinux.Create;
+begin
+  Inherited Create;
+  LibrarySearchPath.AddPath('/lib;/usr/lib;/usr/X11R6/lib',true);
+end;
+
+
+procedure TLinkerLinux.SetDefaultInfo;
+{
+  This will also detect which libc version will be used
+}
+begin
+  Glibc2:=false;
+  Glibc21:=false;
+  with Info do
+   begin
+     ExeCmd[1]:='ld $OPT $DYNLINK $STATIC $STRIP -L. -o $EXE $RES';
+     DllCmd[1]:='ld $OPT -shared -L. -o $EXE $RES';
+     DllCmd[2]:='strip --strip-unneeded $EXE';
+     { first try glibc2 }
+     DynamicLinker:='/lib/ld-linux.so.2';
+     if FileExists(DynamicLinker) then
+      begin
+        Glibc2:=true;
+        { Check for 2.0 files, else use the glibc 2.1 stub }
+        if FileExists('/lib/ld-2.0.*') then
+         Glibc21:=false
+        else
+         Glibc21:=true;
+      end
+     else
+      DynamicLinker:='/lib/ld-linux.so.1';
+     {$ifdef BSD}
+      DynamicLinker:='';
+     {$endif}
+   end;
+
+end;
+
+
+Function TLinkerLinux.WriteResponseFile(isdll:boolean) : Boolean;
+Var
+  linkres      : TLinkRes;
+  i            : longint;
+  cprtobj,
+  gprtobj,
+  prtobj       : string[80];
+  HPath        : TStringListItem;
+  s            : string;
+  linkdynamic,
+  linklibc     : boolean;
+begin
+  WriteResponseFile:=False;
+{ set special options for some targets }
+  linkdynamic:=not(SharedLibFiles.empty);
+  linklibc:=(SharedLibFiles.Find('c')<>nil);
+  prtobj:='prt0';
+  cprtobj:='cprt0';
+  gprtobj:='gprt0';
+  if glibc21 then
+   begin
+     cprtobj:='cprt21';
+     gprtobj:='gprt21';
+   end;
+  if cs_profile in aktmoduleswitches then
+   begin
+     prtobj:=gprtobj;
+     if not glibc2 then
+      AddSharedLibrary('gmon');
+     AddSharedLibrary('c');
+     linklibc:=true;
+   end
+  else
+   begin
+     if linklibc then
+      prtobj:=cprtobj;
+   end;
+
+  { Open link.res file }
+  LinkRes.Init(outputexedir+Info.ResName);
+
+  { Write path to search libraries }
+  HPath:=TStringListItem(current_module.locallibrarysearchpath.First);
+  while assigned(HPath) do
+   begin
+     LinkRes.Add('SEARCH_DIR('+HPath.Str+')');
+     HPath:=TStringListItem(HPath.Next);
+   end;
+  HPath:=TStringListItem(LibrarySearchPath.First);
+  while assigned(HPath) do
+   begin
+     LinkRes.Add('SEARCH_DIR('+HPath.Str+')');
+     HPath:=TStringListItem(HPath.Next);
+   end;
+
+  LinkRes.Add('INPUT(');
+  { add objectfiles, start with prt0 always }
+  if prtobj<>'' then
+   LinkRes.AddFileName(FindObjectFile(prtobj,''));
+  { try to add crti and crtbegin if linking to C }
+  if linklibc then
+   begin
+     if librarysearchpath.FindFile('crtbegin.o',s) then
+      LinkRes.AddFileName(s);
+     if librarysearchpath.FindFile('crti.o',s) then
+      LinkRes.AddFileName(s);
+   end;
+  { main objectfiles }
+  while not ObjectFiles.Empty do
+   begin
+     s:=ObjectFiles.GetFirst;
+     if s<>'' then
+      LinkRes.AddFileName(s);
+   end;
+  { objects which must be at the end }
+  if linklibc then
+   begin
+     if librarysearchpath.FindFile('crtend.o',s) then
+      LinkRes.AddFileName(s);
+     if librarysearchpath.FindFile('crtn.o',s) then
+      LinkRes.AddFileName(s);
+   end;
+  LinkRes.Add(')');
+
+  { Write staticlibraries }
+  if not StaticLibFiles.Empty then
+   begin
+     LinkRes.Add('GROUP(');
+     While not StaticLibFiles.Empty do
+      begin
+        S:=StaticLibFiles.GetFirst;
+        LinkRes.AddFileName(s)
+      end;
+     LinkRes.Add(')');
+   end;
+
+  { Write sharedlibraries like -l<lib>, also add the needed dynamic linker
+    here to be sure that it gets linked this is needed for glibc2 systems (PFV) }
+  if not SharedLibFiles.Empty then
+   begin
+     LinkRes.Add('INPUT(');
+     While not SharedLibFiles.Empty do
+      begin
+        S:=SharedLibFiles.GetFirst;
+        if s<>'c' then
+         begin
+           i:=Pos(target_os.sharedlibext,S);
+           if i>0 then
+            Delete(S,i,255);
+           LinkRes.Add('-l'+s);
+         end
+        else
+         begin
+           linklibc:=true;
+           linkdynamic:=false; { libc will include the ld-linux for us }
+         end;
+      end;
+     { be sure that libc is the last lib }
+     if linklibc then
+      LinkRes.Add('-lc');
+     { when we have -static for the linker the we also need libgcc }
+     if (cs_link_staticflag in aktglobalswitches) then
+      LinkRes.Add('-lgcc');
+     if linkdynamic and (Info.DynamicLinker<>'') then
+      LinkRes.AddFileName(Info.DynamicLinker);
+     LinkRes.Add(')');
+   end;
+{ Write and Close response }
+  linkres.writetodisk;
+  linkres.done;
+
+  WriteResponseFile:=True;
+end;
+
+
+function TLinkerLinux.MakeExecutable:boolean;
+var
+  binstr,
+  cmdstr  : string;
+  success : boolean;
+  DynLinkStr : string[60];
+  StaticStr,
+  StripStr   : string[40];
+begin
+  if not(cs_link_extern in aktglobalswitches) then
+   Message1(exec_i_linking,current_module.exefilename^);
+
+{ Create some replacements }
+  StaticStr:='';
+  StripStr:='';
+  DynLinkStr:='';
+  if (cs_link_staticflag in aktglobalswitches) then
+   StaticStr:='-static';
+  if (cs_link_strip in aktglobalswitches) then
+   StripStr:='-s';
+  If (cs_profile in aktmoduleswitches) or
+     ((Info.DynamicLinker<>'') and (not SharedLibFiles.Empty)) then
+   DynLinkStr:='-dynamic-linker='+Info.DynamicLinker;
+
+{ Write used files and libraries }
+  WriteResponseFile(false);
+
+{ Call linker }
+  SplitBinCmd(Info.ExeCmd[1],binstr,cmdstr);
+  Replace(cmdstr,'$EXE',current_module.exefilename^);
+  Replace(cmdstr,'$OPT',Info.ExtraOptions);
+  Replace(cmdstr,'$RES',outputexedir+Info.ResName);
+  Replace(cmdstr,'$STATIC',StaticStr);
+  Replace(cmdstr,'$STRIP',StripStr);
+  Replace(cmdstr,'$DYNLINK',DynLinkStr);
+  success:=DoExec(FindUtil(BinStr),CmdStr,true,false);
+
+{ Remove ReponseFile }
+  if (success) and not(cs_link_extern in aktglobalswitches) then
+   RemoveFile(outputexedir+Info.ResName);
+
+  MakeExecutable:=success;   { otherwise a recursive call to link method }
+end;
+
+
+Function TLinkerLinux.MakeSharedLibrary:boolean;
+var
+  binstr,
+  cmdstr  : string;
+  success : boolean;
+begin
+  MakeSharedLibrary:=false;
+  if not(cs_link_extern in aktglobalswitches) then
+   Message1(exec_i_linking,current_module.sharedlibfilename^);
+
+{ Write used files and libraries }
+  WriteResponseFile(true);
+
+{ Call linker }
+  SplitBinCmd(Info.DllCmd[1],binstr,cmdstr);
+  Replace(cmdstr,'$EXE',current_module.sharedlibfilename^);
+  Replace(cmdstr,'$OPT',Info.ExtraOptions);
+  Replace(cmdstr,'$RES',outputexedir+Info.ResName);
+  success:=DoExec(FindUtil(binstr),cmdstr,true,false);
+
+{ Strip the library ? }
+  if success and (cs_link_strip in aktglobalswitches) then
+   begin
+     SplitBinCmd(Info.DllCmd[2],binstr,cmdstr);
+     Replace(cmdstr,'$EXE',current_module.sharedlibfilename^);
+     success:=DoExec(FindUtil(binstr),cmdstr,true,false);
+   end;
+
+{ Remove ReponseFile }
+  if (success) and not(cs_link_extern in aktglobalswitches) then
+   RemoveFile(outputexedir+Info.ResName);
+
+  MakeSharedLibrary:=success;   { otherwise a recursive call to link method }
+end;
+
+
+end.
+{
+  $Log$
+  Revision 1.1  2001-02-26 19:43:11  peter
+    * moved target units to subdir
+
+  Revision 1.11  2001/02/20 21:41:17  peter
+    * new fixfilename, findfile for unix. Look first for lowercase, then
+      NormalCase and last for UPPERCASE names.
+
+  Revision 1.10  2000/12/30 22:53:25  peter
+    * export with the case provided in the exports section
+
+  Revision 1.9  2000/12/25 00:07:30  peter
+    + new tlinkedlist class (merge of old tstringqueue,tcontainer and
+      tlinkedlist objects)
+
+  Revision 1.8  2000/10/31 22:02:54  peter
+    * symtable splitted, no real code changes
+
+  Revision 1.7  2000/09/24 21:33:47  peter
+    * message updates merges
+
+  Revision 1.6  2000/09/24 15:06:31  peter
+    * use defines.inc
+
+  Revision 1.5  2000/09/10 20:26:55  peter
+    * bsd patches from marco
+
+  Revision 1.4  2000/08/27 16:11:54  peter
+    * moved some util functions from globals,cobjects to cutils
+    * splitted files into finput,fmodule
+
+  Revision 1.3  2000/07/13 12:08:28  michael
+  + patched to 1.1.0 with former 1.09patch from peter
+
+  Revision 1.2  2000/07/13 11:32:50  michael
+  + removed logs
+
+}

compiler/targets/t_nwm.pas

@@ -0,0 +1,449 @@
+{
+    $Id$
+    Copyright (c) 1998-2000 by Peter Vreman
+
+    This unit implements support import,export,link routines
+    for the (i386) Netware target
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+    First Implementation 10 Sept 2000 Armin Diehl
+
+    Currently generating NetWare-NLM's only work under Linux. This is
+    because nlmconf from binutils does not work with i.e. win32 coff
+    object files. It works fine with ELF-Objects.
+
+    The following compiler-swiches are supported for NetWare:
+    $DESCRIPTION    : NLM-Description, will be displayed at load-time
+    $M              : For Stack-Size, Heap-Size will be ignored
+    $VERSION x.x.x  : Sets Major, Minor and Revision
+
+    Sorry, Displaying copyright does not work with nlmconv from gnu bunutils.
+
+    Exports will be handled like in win32:
+    procedure bla;
+    begin
+    end;
+
+    exports bla name 'bla';
+
+    Without Name 'bla' this will be exported in upper-case.
+
+    The path to the import-Files (from netware-sdk, see developer.novell.com)
+    must be specified by the library-path. All external modules are defined
+    as autoload.
+
+    i.e. Procedure ConsolePrintf (p:pchar); cdecl; external 'clib.nlm';
+    sets IMPORT @clib.imp and MODULE clib.
+
+    If you dont have nlmconv, compile gnu-binutils with
+       ./configure --enable-targets=i386-linux,i386-netware
+       make all
+
+    Debugging is currently only possible at assembler level with nwdbg, written
+    by Jan Beulich. Nwdbg supports symbols but it's not a source-level
+    debugger. You can get nwdbg from developer.novell.com. To enter the
+    debugger from your program, define "EnterDebugger" as external cdecl and
+    call it. Int3 will not work with Netware 5.
+
+    A sample program:
+
+    Program Hello;
+    (*$DESCRIPTION HelloWorldNlm*)
+    (*$VERSION 1.2.2*)
+    (*$M 8192,8192*)
+    begin
+      writeLn ('hello world');
+    end.
+
+    compile with:
+    ppc386 -Tnetware hello
+
+    ToDo:
+      - No duplicate imports and autoloads
+      - Screen and Thread-Names
+
+****************************************************************************
+}
+unit t_nwm;
+
+{$i defines.inc}
+
+interface
+
+  uses
+    import,export,link;
+
+  type
+    timportlibnetware=class(timportlib)
+      procedure preparelib(const s:string);override;
+      procedure importprocedure(const func,module:string;index:longint;const name:string);override;
+      procedure importvariable(const varname,module:string;const name:string);override;
+      procedure generatelib;override;
+    end;
+
+    texportlibnetware=class(texportlib)
+      procedure preparelib(const s : string);override;
+      procedure exportprocedure(hp : texported_item);override;
+      procedure exportvar(hp : texported_item);override;
+      procedure generatelib;override;
+    end;
+
+    tlinkernetware=class(tlinker)
+    private
+      Function  WriteResponseFile(isdll:boolean) : Boolean;
+    public
+      constructor Create;
+      procedure SetDefaultInfo;override;
+      function  MakeExecutable:boolean;override;
+    end;
+
+
+implementation
+
+  uses
+    cutils,
+    verbose,systems,globtype,globals,
+    symconst,script,
+    fmodule,aasm,cpuasm,cpubase,symsym;
+
+{*****************************************************************************
+                               TIMPORTLIBNETWARE
+*****************************************************************************}
+
+procedure timportlibnetware.preparelib(const s : string);
+begin
+end;
+
+
+procedure timportlibnetware.importprocedure(const func,module : string;index : longint;const name : string);
+begin
+  { insert sharedlibrary }
+  current_module.linkothersharedlibs.add(SplitName(module),link_allways);
+  { do nothing with the procedure, only set the mangledname }
+  if name<>'' then
+    aktprocsym^.definition^.setmangledname(name)
+  else
+    message(parser_e_empty_import_name);
+end;
+
+
+procedure timportlibnetware.importvariable(const varname,module:string;const name:string);
+begin
+  { insert sharedlibrary }
+  current_module.linkothersharedlibs.add(SplitName(module),link_allways);
+  { reset the mangledname and turn off the dll_var option }
+  aktvarsym^.setmangledname(name);
+  exclude(aktvarsym^.varoptions,vo_is_dll_var);
+end;
+
+
+procedure timportlibnetware.generatelib;
+begin
+end;
+
+
+{*****************************************************************************
+                               TEXPORTLIBNETWARE
+*****************************************************************************}
+
+procedure texportlibnetware.preparelib(const s:string);
+begin
+end;
+
+
+procedure texportlibnetware.exportprocedure(hp : texported_item);
+var
+  hp2 : texported_item;
+begin
+  { first test the index value }
+  if (hp.options and eo_index)<>0 then
+   begin
+     Comment(V_Error,'can''t export with index under netware');
+     exit;
+   end;
+  { use pascal name is none specified }
+  if (hp.options and eo_name)=0 then
+    begin
+       hp.name:=stringdup(hp.sym^.name);
+       hp.options:=hp.options or eo_name;
+    end;
+  { now place in correct order }
+  hp2:=texported_item(current_module._exports.first);
+  while assigned(hp2) and
+     (hp.name^>hp2.name^) do
+    hp2:=texported_item(hp2.next);
+  { insert hp there !! }
+  if assigned(hp2) and (hp2.name^=hp.name^) then
+    begin
+      { this is not allowed !! }
+      Message1(parser_e_export_name_double,hp.name^);
+      exit;
+    end;
+  if hp2=texported_item(current_module._exports.first) then
+    current_module._exports.insert(hp)
+  else if assigned(hp2) then
+    begin
+       hp.next:=hp2;
+       hp.previous:=hp2.previous;
+       if assigned(hp2.previous) then
+         hp2.previous.next:=hp;
+       hp2.previous:=hp;
+    end
+  else
+    current_module._exports.concat(hp);
+end;
+
+
+procedure texportlibnetware.exportvar(hp : texported_item);
+begin
+  hp.is_var:=true;
+  exportprocedure(hp);
+end;
+
+
+procedure texportlibnetware.generatelib;
+var
+  hp2 : texported_item;
+begin
+  hp2:=texported_item(current_module._exports.first);
+  while assigned(hp2) do
+   begin
+     if not hp2.is_var then
+      begin
+{$ifdef i386}
+        { place jump in codesegment }
+        codeSegment.concat(Tai_align.Create_op(4,$90));
+        codeSegment.concat(Tai_symbol.Createname_global(hp2.name^,0));
+        codeSegment.concat(Taicpu.Op_sym(A_JMP,S_NO,newasmsymbol(hp2.sym^.mangledname)));
+        codeSegment.concat(Tai_symbol_end.Createname(hp2.name^));
+{$endif i386}
+      end
+     else
+      Comment(V_Error,'Exporting of variables is not supported under netware');
+     hp2:=texported_item(hp2.next);
+   end;
+end;
+
+
+{*****************************************************************************
+                                  TLINKERNETWARE
+*****************************************************************************}
+
+Constructor TLinkerNetware.Create;
+begin
+  Inherited Create;
+end;
+
+
+procedure TLinkerNetware.SetDefaultInfo;
+begin
+  with Info do
+   begin
+     ExeCmd[1]:='nlmconv -T$RES';
+     {DllCmd[1]:='ld $OPT -shared -L. -o $EXE $RES';}
+     DllCmd[2]:='strip --strip-unneeded $EXE';
+   end;
+end;
+
+
+Function TLinkerNetware.WriteResponseFile(isdll:boolean) : Boolean;
+Var
+  linkres      : TLinkRes;
+  i            : longint;
+  s,s2         : string;
+  ProgNam      : string [80];
+  NlmNam       : string [80];
+  hp2          : texported_item;  { for exports }
+begin
+  WriteResponseFile:=False;
+
+  ProgNam := current_module.exefilename^;
+  i:=Pos(target_os.exeext,ProgNam);
+  if i>0 then
+    Delete(ProgNam,i,255);
+  NlmNam := ProgNam + target_os.exeext;
+
+  { Open link.res file }
+  LinkRes.Init(outputexedir+Info.ResName);
+
+  if Description <> '' then
+    LinkRes.Add('DESCRIPTION "' + Description + '"');
+  LinkRes.Add('VERSION '+tostr(dllmajor)+','+tostr(dllminor)+','+tostr(dllrevision));
+  LinkRes.Add('SCREENNAME "' + ProgNam + '"');  { for that, we have }
+  LinkRes.Add('THREADNAME "' + ProgNam + '"');  { to add comiler directives }
+  if stacksize > 1024 then
+  begin
+    str (stacksize, s);
+    LinkRes.Add ('STACKSIZE '+s);
+  end;
+
+  { add objectfiles, start with nwpre always }
+  LinkRes.Add ('INPUT '+FindObjectFile('nwpre',''));
+
+  { main objectfiles }
+  while not ObjectFiles.Empty do
+   begin
+     s:=ObjectFiles.GetFirst;
+     if s<>'' then
+      LinkRes.Add ('INPUT ' + FindObjectFile (s,''));
+   end;
+
+  { output file (nlm) }
+  LinkRes.Add ('OUTPUT ' + NlmNam);
+
+  { start and stop-procedures }
+  LinkRes.Add ('START _Prelude');  { defined in rtl/netware/nwpre.pp }
+  LinkRes.Add ('EXIT _Stop');
+
+  //if not (cs_link_strip in aktglobalswitches) then
+  { ahhhggg: how do i detect if we have debug-symbols ? }
+  LinkRes.Add ('DEBUG');
+
+  { Write staticlibraries, is that correct ? }
+  if not StaticLibFiles.Empty then
+   begin
+     While not StaticLibFiles.Empty do
+      begin
+        S:=lower (StaticLibFiles.GetFirst);
+        if s<>'' then
+         begin
+           i:=Pos(target_os.staticlibext,S);
+           if i>0 then
+            Delete(S,i,255);
+           S := S + '.imp';
+           librarysearchpath.FindFile(S,s);
+           LinkRes.Add('IMPORT @'+s);
+         end
+      end;
+   end;
+
+  if not SharedLibFiles.Empty then
+   begin
+     While not SharedLibFiles.Empty do
+      begin
+        {becuase of upper/lower case mix, we may get duplicate
+         names but nlmconv ignores that.
+         Here we are setting the import-files for nlmconv. I.e. for
+         the module clib or clib.nlm we add IMPORT @clib.imp and also
+         the module clib.nlm (autoload)
+         ? may it be better to set autoload's via StaticLibFiles ? }
+        S:=lower (SharedLibFiles.GetFirst);
+        if s<>'' then
+         begin
+           s2:=s;
+           i:=Pos(target_os.sharedlibext,S);
+           if i>0 then
+            Delete(S,i,255);
+           S := S + '.imp';
+           librarysearchpath.FindFile(S,s);
+           LinkRes.Add('IMPORT @'+s);
+           LinkRes.Add('MODULE '+s2);
+         end
+      end;
+   end;
+
+  { write exports }
+  hp2:=texported_item(current_module._exports.first);
+  while assigned(hp2) do
+   begin
+     if not hp2.is_var then
+      begin
+        { Export the Symbol
+          Warning: The Symbol is converted to upper-case if not explicitly
+          specified by >>Exports BlaBla NAME 'BlaBla';<< }
+        Comment(V_Debug,'Exporting '+hp2.name^);
+        LinkRes.Add ('EXPORT '+hp2.name^);
+      end
+     else
+      { really ? }
+      Comment(V_Error,'Exporting of variables is not supported under netware');
+     hp2:=texported_item(hp2.next);
+   end;
+
+{ Write and Close response }
+  linkres.writetodisk;
+  linkres.done;
+
+  WriteResponseFile:=True;
+end;
+
+
+function TLinkerNetware.MakeExecutable:boolean;
+var
+  binstr,
+  cmdstr  : string;
+  success : boolean;
+  DynLinkStr : string[60];
+  StaticStr,
+  StripStr   : string[40];
+begin
+  if not(cs_link_extern in aktglobalswitches) then
+   Message1(exec_i_linking,current_module.exefilename^);
+
+{ Create some replacements }
+  StaticStr:='';
+  StripStr:='';
+  DynLinkStr:='';
+
+{ Write used files and libraries }
+  WriteResponseFile(false);
+
+{ Call linker }
+  SplitBinCmd(Info.ExeCmd[1],binstr,cmdstr);
+  Replace(cmdstr,'$EXE',current_module.exefilename^);
+  Replace(cmdstr,'$OPT',Info.ExtraOptions);
+  Replace(cmdstr,'$RES',outputexedir+Info.ResName);
+  Replace(cmdstr,'$STATIC',StaticStr);
+  Replace(cmdstr,'$STRIP',StripStr);
+  Replace(cmdstr,'$DYNLINK',DynLinkStr);
+  success:=DoExec(FindUtil(BinStr),CmdStr,true,false);
+
+  { Remove ReponseFile }
+  if (success) and not(cs_link_extern in aktglobalswitches) then
+    RemoveFile(outputexedir+Info.ResName);
+
+  MakeExecutable:=success;   { otherwise a recursive call to link method }
+end;
+
+end.
+{
+  $Log$
+  Revision 1.1  2001-02-26 19:43:11  peter
+    * moved target units to subdir
+
+  Revision 1.6  2001/02/20 21:41:16  peter
+    * new fixfilename, findfile for unix. Look first for lowercase, then
+      NormalCase and last for UPPERCASE names.
+
+  Revision 1.5  2000/12/25 00:07:30  peter
+    + new tlinkedlist class (merge of old tstringqueue,tcontainer and
+      tlinkedlist objects)
+
+  Revision 1.4  2000/11/29 00:30:42  florian
+    * unused units removed from uses clause
+    * some changes for widestrings
+
+  Revision 1.3  2000/10/31 22:02:55  peter
+    * symtable splitted, no real code changes
+
+  Revision 1.2  2000/09/24 15:06:31  peter
+    * use defines.inc
+
+  Revision 1.1  2000/09/11 17:00:23  florian
+    + first implementation of Netware Module support, thanks to
+      Armin Diehl ([email protected]) for providing the patches
+
+}

compiler/targets/t_os2.pas

@@ -0,0 +1,529 @@
+{
+    $Id$
+    Copyright (c) 1998-2000 by Daniel Mantione
+    Portions Copyright (c) 1998-2000 Eberhard Mattes
+
+    Unit to write out import libraries and def files for OS/2
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+ ****************************************************************************
+}
+{
+   A lot of code in this unit has been ported from C to Pascal from the
+   emximp utility, part of the EMX development system. Emximp is copyrighted
+   by Eberhard Mattes. Note: Eberhard doesn't know much about the Pascal
+   port, please send questions to Daniel Mantione
+   <[email protected]>.
+}
+unit t_os2;
+
+{$i defines.inc}
+
+interface
+uses
+  import,link,comprsrc;
+
+type
+  timportlibos2=class(timportlib)
+    procedure preparelib(const s:string);override;
+    procedure importprocedure(const func,module:string;index:longint;const name:string);override;
+    procedure generatelib;override;
+  end;
+
+    tlinkeros2=class(tlinker)
+    private
+       Function  WriteResponseFile(isdll:boolean) : Boolean;
+    public
+       constructor Create;
+       procedure SetDefaultInfo;override;
+       function  MakeExecutable:boolean;override;
+    end;
+
+
+{***************************************************************************}
+
+{***************************************************************************}
+
+implementation
+
+  uses
+{$ifdef Delphi}
+     sysutils,
+     dmisc,
+{$else Delphi}
+     strings,
+     dos,
+{$endif Delphi}
+     cutils,cclasses,
+     globtype,comphook,systems,
+     globals,verbose,fmodule,script;
+
+const   profile_flag:boolean=false;
+
+const   n_ext   = 1;
+        n_abs   = 2;
+        n_text  = 4;
+        n_data  = 6;
+        n_bss   = 8;
+        n_imp1  = $68;
+        n_imp2  = $6a;
+
+type    reloc=packed record     {This is the layout of a relocation table
+                                 entry.}
+            address:longint;    {Fixup location}
+            remaining:longint;
+            {Meaning of bits for remaining:
+             0..23:              Symbol number or segment
+             24:                 Self-relative fixup if non-zero
+             25..26:             Fixup size (0: 1 byte, 1: 2, 2: 4 bytes)
+             27:                 Reference to symbol or segment
+             28..31              Not used}
+        end;
+
+        nlist=packed record     {This is the layout of a symbol table entry.}
+            strofs:longint;     {Offset in string table}
+            typ:byte;           {Type of the symbol}
+            other:byte;         {Other information}
+            desc:word;          {More information}
+            value:longint;      {Value (address)}
+        end;
+
+        a_out_header=packed record
+            magic:word;         {Magic word, must be $0107}
+            machtype:byte;      {Machine type}
+            flags:byte;         {Flags}
+            text_size:longint;  {Length of text, in bytes}
+            data_size:longint;  {Length of initialized data, in bytes}
+            bss_size:longint;   {Length of uninitialized data, in bytes}
+            sym_size:longint;   {Length of symbol table, in bytes}
+            entry:longint;      {Start address (entry point)}
+            trsize:longint;     {Length of relocation info for text, bytes}
+            drsize:longint;     {Length of relocation info for data, bytes}
+        end;
+
+        ar_hdr=packed record
+            ar_name:array[0..15] of char;
+            ar_date:array[0..11] of char;
+            ar_uid:array[0..5] of char;
+            ar_gid:array[0..5] of char;
+            ar_mode:array[0..7] of char;
+            ar_size:array[0..9] of char;
+            ar_fmag:array[0..1] of char;
+        end;
+
+var aout_str_size:longint;
+    aout_str_tab:array[0..2047] of byte;
+    aout_sym_count:longint;
+    aout_sym_tab:array[0..5] of nlist;
+
+    aout_text:array[0..63] of byte;
+    aout_text_size:longint;
+
+    aout_treloc_tab:array[0..1] of reloc;
+    aout_treloc_count:longint;
+
+    aout_size:longint;
+    seq_no:longint;
+
+    ar_member_size:longint;
+
+    out_file:file;
+
+procedure write_ar(const name:string;size:longint);
+
+var ar:ar_hdr;
+    time:datetime;
+    dummy:word;
+    numtime:longint;
+    tmp:string[19];
+
+
+begin
+    ar_member_size:=size;
+    fillchar(ar.ar_name,sizeof(ar.ar_name),' ');
+    move(name[1],ar.ar_name,length(name));
+    getdate(time.year,time.month,time.day,dummy);
+    gettime(time.hour,time.min,time.sec,dummy);
+    packtime(time,numtime);
+    str(numtime,tmp);
+    fillchar(ar.ar_date,sizeof(ar.ar_date),' ');
+    move(tmp[1],ar.ar_date,length(tmp));
+    ar.ar_uid:='0     ';
+    ar.ar_gid:='0     ';
+    ar.ar_mode:='100666'#0#0;
+    str(size,tmp);
+    fillchar(ar.ar_size,sizeof(ar.ar_size),' ');
+    move(tmp[1],ar.ar_size,length(tmp));
+    ar.ar_fmag:='`'#10;
+    blockwrite(out_file,ar,sizeof(ar));
+end;
+
+procedure finish_ar;
+
+var a:byte;
+
+begin
+    a:=0;
+    if odd(ar_member_size) then
+        blockwrite(out_file,a,1);
+end;
+
+procedure aout_init;
+
+begin
+  aout_str_size:=sizeof(longint);
+  aout_sym_count:=0;
+  aout_text_size:=0;
+  aout_treloc_count:=0;
+end;
+
+function aout_sym(const name:string;typ,other:byte;desc:word;
+                  value:longint):longint;
+
+begin
+    if aout_str_size+length(name)+1>sizeof(aout_str_tab) then
+        Do_halt($da);
+    if aout_sym_count>=sizeof(aout_sym_tab) div sizeof(aout_sym_tab[0]) then
+        Do_halt($da);
+    aout_sym_tab[aout_sym_count].strofs:=aout_str_size;
+    aout_sym_tab[aout_sym_count].typ:=typ;
+    aout_sym_tab[aout_sym_count].other:=other;
+    aout_sym_tab[aout_sym_count].desc:=desc;
+    aout_sym_tab[aout_sym_count].value:=value;
+    strPcopy(@aout_str_tab[aout_str_size],name);
+    aout_str_size:=aout_str_size+length(name)+1;
+    aout_sym:=aout_sym_count;
+    inc(aout_sym_count);
+end;
+
+procedure aout_text_byte(b:byte);
+
+begin
+    if aout_text_size>=sizeof(aout_text) then
+        Do_halt($da);
+    aout_text[aout_text_size]:=b;
+    inc(aout_text_size);
+end;
+
+procedure aout_text_dword(d:longint);
+
+type li_ar=array[0..3] of byte;
+
+begin
+    aout_text_byte(li_ar(d)[0]);
+    aout_text_byte(li_ar(d)[1]);
+    aout_text_byte(li_ar(d)[2]);
+    aout_text_byte(li_ar(d)[3]);
+end;
+
+procedure aout_treloc(address,symbolnum,pcrel,len,ext:longint);
+
+begin
+    if aout_treloc_count>=sizeof(aout_treloc_tab) div sizeof(reloc) then
+        Do_halt($da);
+    aout_treloc_tab[aout_treloc_count].address:=address;
+    aout_treloc_tab[aout_treloc_count].remaining:=symbolnum+pcrel shl 24+
+     len shl 25+ext shl 27;
+    inc(aout_treloc_count);
+end;
+
+procedure aout_finish;
+
+begin
+    while (aout_text_size and 3)<>0 do
+        aout_text_byte ($90);
+    aout_size:=sizeof(a_out_header)+aout_text_size+aout_treloc_count*
+     sizeof(reloc)+aout_sym_count*sizeof(aout_sym_tab[0])+aout_str_size;
+end;
+
+procedure aout_write;
+
+var ao:a_out_header;
+
+begin
+    ao.magic:=$0107;
+    ao.machtype:=0;
+    ao.flags:=0;
+    ao.text_size:=aout_text_size;
+    ao.data_size:=0;
+    ao.bss_size:=0;
+    ao.sym_size:=aout_sym_count*sizeof(aout_sym_tab[0]);
+    ao.entry:=0;
+    ao.trsize:=aout_treloc_count*sizeof(reloc);
+    ao.drsize:=0;
+    blockwrite(out_file,ao,sizeof(ao));
+    blockwrite(out_file,aout_text,aout_text_size);
+    blockwrite(out_file,aout_treloc_tab,sizeof(reloc)*aout_treloc_count);
+    blockwrite(out_file,aout_sym_tab,sizeof(aout_sym_tab[0])*aout_sym_count);
+    longint((@aout_str_tab)^):=aout_str_size;
+    blockwrite(out_file,aout_str_tab,aout_str_size);
+end;
+
+procedure timportlibos2.preparelib(const s:string);
+
+{This code triggers a lot of bugs in the compiler.
+const   armag='!<arch>'#10;
+        ar_magic:array[1..length(armag)] of char=armag;}
+const   ar_magic:array[1..8] of char='!<arch>'#10;
+var
+  libname : string;
+begin
+    libname:=FixFileName(s+'.ao2');
+    seq_no:=1;
+    current_module.linkunitstaticlibs.add(libname,link_allways);
+    assign(out_file,current_module.outputpath^+libname);
+    rewrite(out_file,1);
+    blockwrite(out_file,ar_magic,sizeof(ar_magic));
+end;
+
+procedure timportlibos2.importprocedure(const func,module:string;index:longint;const name:string);
+{func       = Name of function to import.
+ module     = Name of DLL to import from.
+ index      = Index of function in DLL. Use 0 to import by name.
+ name       = Name of function in DLL. Ignored when index=0;}
+var tmp1,tmp2,tmp3:string;
+    sym_mcount,sym_import:longint;
+    fixup_mcount,fixup_import:longint;
+begin
+    aout_init;
+    tmp2:=func;
+    if profile_flag and not (copy(func,1,4)='_16_') then
+        begin
+            {sym_entry:=aout_sym(func,n_text+n_ext,0,0,aout_text_size);}
+            sym_mcount:=aout_sym('__mcount',n_ext,0,0,0);
+            {Use, say, "_$U_DosRead" for "DosRead" to import the
+             non-profiled function.}
+            tmp2:='__$U_'+func;
+            sym_import:=aout_sym(tmp2,n_ext,0,0,0);
+            aout_text_byte($55);    {push ebp}
+            aout_text_byte($89);    {mov ebp, esp}
+            aout_text_byte($e5);
+            aout_text_byte($e8);    {call _mcount}
+            fixup_mcount:=aout_text_size;
+            aout_text_dword(0-(aout_text_size+4));
+            aout_text_byte($5d);    {pop ebp}
+            aout_text_byte($e9);    {jmp _$U_DosRead}
+            fixup_import:=aout_text_size;
+            aout_text_dword(0-(aout_text_size+4));
+
+            aout_treloc(fixup_mcount,sym_mcount,1,2,1);
+            aout_treloc (fixup_import, sym_import,1,2,1);
+        end;
+    str(seq_no,tmp1);
+    tmp1:='IMPORT#'+tmp1;
+    if name='' then
+        begin
+            str(index,tmp3);
+            tmp3:=func+'='+module+'.'+tmp3;
+        end
+    else
+        tmp3:=func+'='+module+'.'+name;
+    aout_sym(tmp2,n_imp1+n_ext,0,0,0);
+    aout_sym(tmp3,n_imp2+n_ext,0,0,0);
+    aout_finish;
+    write_ar(tmp1,aout_size);
+    aout_write;
+    finish_ar;
+    inc(seq_no);
+end;
+
+procedure timportlibos2.generatelib;
+
+begin
+    close(out_file);
+end;
+
+
+{****************************************************************************
+                               TLinkeros2
+****************************************************************************}
+
+Constructor TLinkeros2.Create;
+begin
+  Inherited Create;
+  { allow duplicated libs (PM) }
+  SharedLibFiles.doubles:=true;
+  StaticLibFiles.doubles:=true;
+end;
+
+
+procedure TLinkeros2.SetDefaultInfo;
+begin
+  with Info do
+   begin
+     ExeCmd[1]:='ld $OPT -o $EXE @$RES';
+     ExeCmd[2]:='emxbind -b $STRIP $APPTYPE $RSRC -k$STACKKB -h$HEAPMB -o $EXE.exe $EXE -aim -s$DOSHEAPKB';
+   end;
+end;
+
+
+Function TLinkeros2.WriteResponseFile(isdll:boolean) : Boolean;
+Var
+  linkres  : TLinkRes;
+  i        : longint;
+  HPath    : TStringListItem;
+  s        : string;
+begin
+  WriteResponseFile:=False;
+
+  { Open link.res file }
+  LinkRes.Init(outputexedir+Info.ResName);
+
+  { Write path to search libraries }
+  HPath:=TStringListItem(current_module.locallibrarysearchpath.First);
+  while assigned(HPath) do
+   begin
+     LinkRes.Add('-L'+HPath.Str);
+     HPath:=TStringListItem(HPath.Next);
+   end;
+  HPath:=TStringListItem(LibrarySearchPath.First);
+  while assigned(HPath) do
+   begin
+     LinkRes.Add('-L'+HPath.Str);
+     HPath:=TStringListItem(HPath.Next);
+   end;
+
+  { add objectfiles, start with prt0 always }
+  LinkRes.AddFileName(FindObjectFile('prt0',''));
+  while not ObjectFiles.Empty do
+   begin
+     s:=ObjectFiles.GetFirst;
+     if s<>'' then
+      LinkRes.AddFileName(s);
+   end;
+
+  { Write staticlibraries }
+  { No group !! This will not work correctly PM }
+  While not StaticLibFiles.Empty do
+   begin
+     S:=StaticLibFiles.GetFirst;
+     LinkRes.AddFileName(s)
+   end;
+
+  { Write sharedlibraries like -l<lib>, also add the needed dynamic linker
+    here to be sure that it gets linked this is needed for glibc2 systems (PFV) }
+  While not SharedLibFiles.Empty do
+   begin
+     S:=SharedLibFiles.GetFirst;
+     i:=Pos(target_os.sharedlibext,S);
+     if i>0 then
+      Delete(S,i,255);
+     LinkRes.Add('-l'+s);
+   end;
+
+{ Write and Close response }
+  linkres.writetodisk;
+  linkres.done;
+
+  WriteResponseFile:=True;
+end;
+
+
+function TLinkeros2.MakeExecutable:boolean;
+var
+  binstr,
+  cmdstr  : string;
+  success : boolean;
+  i       : longint;
+  AppTypeStr,
+  StripStr: string[40];
+  RsrcStr : string;
+begin
+  if not(cs_link_extern in aktglobalswitches) then
+   Message1(exec_i_linking,current_module.exefilename^);
+
+{ Create some replacements }
+  if (cs_link_strip in aktglobalswitches) then
+   StripStr := '-s'
+  else
+   StripStr := '';
+  if (usewindowapi) or (AppType = app_gui) then
+   AppTypeStr := '-p'
+  else if AppType = app_fs then
+   AppTypeStr := '-f'
+  else AppTypeStr := '-w';
+  if not (Current_module.ResourceFiles.Empty) then
+   RsrcStr := '-r ' + Current_module.ResourceFiles.GetFirst
+  else
+   RsrcStr := '';
+(* Only one resource file supported, discard everything else
+   (should be already empty anyway, however. *)
+  Current_module.ResourceFiles.Clear;
+{ Write used files and libraries }
+  WriteResponseFile(false);
+
+{ Call linker }
+  success:=false;
+  for i:=1 to 2 do
+   begin
+     SplitBinCmd(Info.ExeCmd[i],binstr,cmdstr);
+     if binstr<>'' then
+      begin
+        Replace(cmdstr,'$HEAPMB',tostr((maxheapsize+1048575) shr 20));
+        {Size of the stack when an EMX program runs in OS/2.}
+        Replace(cmdstr,'$STACKKB',tostr((stacksize+1023) shr 10));
+        {When an EMX program runs in DOS, the heap and stack share the
+         same memory pool. The heap grows upwards, the stack grows downwards.}
+        Replace(cmdstr,'$DOSHEAPKB',tostr((stacksize+maxheapsize+1023) shr 10));
+        Replace(cmdstr,'$STRIP',StripStr);
+        Replace(cmdstr,'$APPTYPE',AppTypeStr);
+        Replace(cmdstr,'$RES',outputexedir+Info.ResName);
+        Replace(cmdstr,'$OPT',Info.ExtraOptions);
+        Replace(cmdstr,'$RSRC',RsrcStr);
+        Replace(cmdstr,'$EXE',current_module.exefilename^);
+        success:=DoExec(FindUtil(binstr),cmdstr,(i=1),false);
+(* We still want to have the PPAS script complete, right?
+        if not success then
+         break;
+*)
+      end;
+   end;
+
+{ Remove ReponseFile }
+  if (success) and not(cs_link_extern in aktglobalswitches) then
+   RemoveFile(outputexedir+Info.ResName);
+
+  MakeExecutable:=success;   { otherwise a recursive call to link method }
+end;
+
+
+end.
+{
+  $Log$
+  Revision 1.1  2001-02-26 19:43:11  peter
+    * moved target units to subdir
+
+  Revision 1.7  2001/01/20 18:32:52  hajny
+    + APPTYPE support under OS/2, app_fs, GetEnvPChar for OS/2
+
+  Revision 1.6  2000/12/25 00:07:30  peter
+    + new tlinkedlist class (merge of old tstringqueue,tcontainer and
+      tlinkedlist objects)
+
+  Revision 1.5  2000/09/24 15:06:31  peter
+    * use defines.inc
+
+  Revision 1.4  2000/09/20 19:38:34  peter
+    * fixed staticlib filename and unitlink instead of otherlinky
+
+  Revision 1.3  2000/08/27 16:11:54  peter
+    * moved some util functions from globals,cobjects to cutils
+    * splitted files into finput,fmodule
+
+  Revision 1.2  2000/07/13 11:32:50  michael
+  + removed logs
+
+}

compiler/targets/t_sunos.pas

@@ -0,0 +1,480 @@
+{
+    $Id$
+    Copyright (c) 1998-2000 by Peter Vreman
+
+    This unit implements support import,export,link routines
+    for the (i386) sunos target
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+ ****************************************************************************
+}
+unit t_sunos;
+
+{$i defines.inc}
+
+interface
+
+{ copy from t_linux
+// Up to now we use gld since the solaris ld seems not support .res-files}
+{-$DEFINE LinkTest} { DON't del link.res and write Info }
+{$DEFINE GnuLd} {The other is not implemented }
+  uses
+    import,export,link;
+
+  type
+    timportlibsunos=class(timportlib)
+      procedure preparelib(const s:string);override;
+      procedure importprocedure(const func,module:string;index:longint;const name:string);override;
+      procedure importvariable(const varname,module:string;const name:string);override;
+      procedure generatelib;override;
+    end;
+
+    texportlibsunos=class(texportlib)
+      procedure preparelib(const s : string);override;
+      procedure exportprocedure(hp : texported_item);override;
+      procedure exportvar(hp : texported_item);override;
+      procedure generatelib;override;
+    end;
+
+    tlinkersunos=class(tlinker)
+    private
+      Glibc2,
+      Glibc21 : boolean;
+      Function  WriteResponseFile(isdll:boolean) : Boolean;
+    public
+      constructor Create;
+      procedure SetDefaultInfo;override;
+      function  MakeExecutable:boolean;override;
+      function  MakeSharedLibrary:boolean;override;
+    end;
+
+
+implementation
+
+  uses
+    cutils,cclasses,
+    verbose,systems,globtype,globals,
+    symconst,script,
+    fmodule,aasm,cpuasm,cpubase,symsym;
+
+{*****************************************************************************
+                               TIMPORTLIBsunos
+*****************************************************************************}
+
+procedure timportlibsunos.preparelib(const s : string);
+begin
+{$ifDef LinkTest}
+  WriteLN('Prepare import: ',s);
+{$EndIf}
+end;
+
+
+procedure timportlibsunos.importprocedure(const func,module : string;index : longint;const name : string);
+begin
+  { insert sharedlibrary }
+{$ifDef LinkTest}
+  WriteLN('Import: f:',func,' m:',module,' n:',name);
+{$EndIf}
+  current_module.linkothersharedlibs.add(SplitName(module),link_allways);
+  { do nothing with the procedure, only set the mangledname }
+  if name<>'' then
+    aktprocsym^.definition^.setmangledname(name)
+  else
+    message(parser_e_empty_import_name);
+end;
+
+
+procedure timportlibsunos.importvariable(const varname,module:string;const name:string);
+begin
+  { insert sharedlibrary }
+  current_module.linkothersharedlibs.add(SplitName(module),link_allways);
+  { reset the mangledname and turn off the dll_var option }
+  aktvarsym^.setmangledname(name);
+  exclude(aktvarsym^.varoptions,vo_is_dll_var);
+end;
+
+
+procedure timportlibsunos.generatelib;
+begin
+end;
+
+
+{*****************************************************************************
+                               TEXPORTLIBsunos
+*****************************************************************************}
+
+procedure texportlibsunos.preparelib(const s:string);
+begin
+end;
+
+
+procedure texportlibsunos.exportprocedure(hp : texported_item);
+var
+  hp2 : texported_item;
+begin
+  { first test the index value }
+  if (hp.options and eo_index)<>0 then
+   begin
+     Message1(parser_e_no_export_with_index_for_target,'SunOS');
+     exit;
+   end;
+  { use pascal name is none specified }
+  if (hp.options and eo_name)=0 then
+    begin
+       hp.name:=stringdup(hp.sym^.name);
+       hp.options:=hp.options or eo_name;
+    end;
+  { now place in correct order }
+  hp2:=texported_item(current_module._exports.first);
+  while assigned(hp2) and
+     (hp.name^>hp2.name^) do
+    hp2:=texported_item(hp2.next);
+  { insert hp there !! }
+  if assigned(hp2) and (hp2.name^=hp.name^) then
+    begin
+      { this is not allowed !! }
+      Message1(parser_e_export_name_double,hp.name^);
+      exit;
+    end;
+  if hp2=texported_item(current_module._exports.first) then
+    current_module._exports.insert(hp)
+  else if assigned(hp2) then
+    begin
+       hp.next:=hp2;
+       hp.previous:=hp2.previous;
+       if assigned(hp2.previous) then
+         hp2.previous.next:=hp;
+       hp2.previous:=hp;
+    end
+  else
+    current_module._exports.concat(hp);
+end;
+
+
+procedure texportlibsunos.exportvar(hp : texported_item);
+begin
+  hp.is_var:=true;
+  exportprocedure(hp);
+end;
+
+
+procedure texportlibsunos.generatelib;
+var
+  hp2 : texported_item;
+begin
+  hp2:=texported_item(current_module._exports.first);
+  while assigned(hp2) do
+   begin
+     if not hp2.is_var then
+      begin
+{$ifdef i386}
+        { place jump in codesegment }
+        codesegment.concat(Tai_align.Create_op(4,$90));
+        codeSegment.concat(Tai_symbol.Createname_global(hp2.name^,0));
+        codeSegment.concat(Taicpu.Op_sym(A_JMP,S_NO,newasmsymbol(hp2.sym^.mangledname)));
+        codeSegment.concat(Tai_symbol_end.Createname(hp2.name^));
+{$endif i386}
+      end
+     else
+      Message1(parser_e_no_export_of_variables_for_target,'SunOS');
+     hp2:=texported_item(hp2.next);
+   end;
+end;
+
+
+{*****************************************************************************
+                                  TLINKERSUNOS
+*****************************************************************************}
+
+Constructor TLinkersunos.Create;
+begin
+  Inherited Create;
+  LibrarySearchPath.AddPath('/lib;/usr/lib;/usr/X11R6/lib;/opt/sfw/lib',true);
+{$ifdef  LinkTest}
+     if (cs_link_staticflag in aktglobalswitches) then  WriteLN('ForceLinkStaticFlag');
+     if (cs_link_static in aktglobalswitches) then  WriteLN('LinkStatic-Flag');
+     if (cs_link_shared in aktglobalswitches) then  WriteLN('LinkSynamicFlag');
+{$EndIf}
+end;
+
+
+procedure TLinkersunos.SetDefaultInfo;
+{
+  This will also detect which libc version will be used
+}
+begin
+  Glibc2:=false;
+  Glibc21:=false;
+  with Info do
+   begin
+{$IFDEF GnuLd}
+     ExeCmd[1]:='gld $OPT $DYNLINK $STATIC $STRIP -L. -o $EXE $RES';
+     DllCmd[1]:='gld $OPT -shared -L. -o $EXE $RES';
+     DllCmd[2]:='strip --strip-unneeded $EXE';
+     DynamicLinker:=''; { Gnu uses the default }
+     Glibc21:=false;	
+{$ELSE}
+    Not Implememted
+{$ENDIF}
+(* Linux Stuff not needed?
+     { first try glibc2 } // muss noch gendert werden
+     if FileExists(DynamicLinker) then
+      begin
+        Glibc2:=true;
+        { Check for 2.0 files, else use the glibc 2.1 stub }
+        if FileExists('/lib/ld-2.0.*') then
+         Glibc21:=false
+        else
+         Glibc21:=true;
+      end
+     else
+      DynamicLinker:='/lib/ld-linux.so.1';
+*)
+   end;
+
+end;
+
+
+Function TLinkersunos.WriteResponseFile(isdll:boolean) : Boolean;
+Var
+  linkres      : TLinkRes;
+  i            : longint;
+  cprtobj,
+  gprtobj,
+  prtobj       : string[80];
+  HPath        : TStringListItem;
+  s            : string;
+  linkdynamic,
+  linklibc     : boolean;
+begin
+  WriteResponseFile:=False;
+{ set special options for some targets }
+  linkdynamic:=not(SharedLibFiles.empty);
+{  linkdynamic:=false; // da nicht getestet }
+  linklibc:=(SharedLibFiles.Find('c')<>nil);
+  prtobj:='prt0';
+  cprtobj:='cprt0';
+  gprtobj:='gprt0';
+(*  if glibc21 then
+   begin
+     cprtobj:='cprt21';
+     gprtobj:='gprt21';
+   end;
+*)
+  if cs_profile in aktmoduleswitches then
+   begin
+     prtobj:=gprtobj;
+     if not glibc2 then
+      AddSharedLibrary('gmon');
+     AddSharedLibrary('c');
+     linklibc:=true;
+   end
+  else
+   begin
+     if linklibc then
+       prtobj:=cprtobj
+      else
+       AddSharedLibrary('c'); { quick hack: this sunos implementation needs alwys libc }
+   end;
+
+  { Open link.res file }
+  LinkRes.Init(outputexedir+Info.ResName);
+
+  { Write path to search libraries }
+  HPath:=TStringListItem(current_module.locallibrarysearchpath.First);
+  while assigned(HPath) do
+   begin
+     LinkRes.Add('SEARCH_DIR('+HPath.Str+')');
+     HPath:=TStringListItem(HPath.Next);
+   end;
+  HPath:=TStringListItem(LibrarySearchPath.First);
+  while assigned(HPath) do
+   begin
+     LinkRes.Add('SEARCH_DIR('+HPath.Str+')');
+     HPath:=TStringListItem(HPath.Next);
+   end;
+
+  LinkRes.Add('INPUT(');
+  { add objectfiles, start with prt0 always }
+  if prtobj<>'' then
+   LinkRes.AddFileName(FindObjectFile(prtobj,''));
+  { try to add crti and crtbegin if linking to C }
+  if linklibc then { Needed in sunos? }
+   begin
+     if librarysearchpath.FindFile('crtbegin.o',s) then
+      LinkRes.AddFileName(s);
+     if librarysearchpath.FindFile('crti.o',s) then
+      LinkRes.AddFileName(s);
+   end;
+  { main objectfiles }
+  while not ObjectFiles.Empty do
+   begin
+     s:=ObjectFiles.GetFirst;
+     if s<>'' then
+      LinkRes.AddFileName(s);
+   end;
+  { objects which must be at the end }
+  if linklibc then { Needed in sunos? }
+   begin
+     if librarysearchpath.FindFile('crtend.o',s) then
+      LinkRes.AddFileName(s);
+     if librarysearchpath.FindFile('crtn.o',s) then
+      LinkRes.AddFileName(s);
+   end;
+  LinkRes.Add(')');
+
+  { Write staticlibraries }
+  if not StaticLibFiles.Empty then
+   begin
+     LinkRes.Add('GROUP(');
+     While not StaticLibFiles.Empty do
+      begin
+        S:=StaticLibFiles.GetFirst;
+        LinkRes.AddFileName(s)
+      end;
+     LinkRes.Add(')');
+   end;
+
+  { Write sharedlibraries like -l<lib>, also add the needed dynamic linker
+    here to be sure that it gets linked this is needed for glibc2 systems (PFV) }
+  if not SharedLibFiles.Empty then
+   begin
+     LinkRes.Add('INPUT(');
+     While not SharedLibFiles.Empty do
+      begin
+        S:=SharedLibFiles.GetFirst;
+        if s<>'c' then
+         begin
+           i:=Pos(target_os.sharedlibext,S);
+           if i>0 then
+            Delete(S,i,255);
+           LinkRes.Add('-l'+s);
+         end
+        else
+         begin
+           linklibc:=true;
+           linkdynamic:=false; { libc will include the ld-sunos (war ld-linux) for us }
+         end;
+      end;
+     { be sure that libc is the last lib }
+     if linklibc then
+      LinkRes.Add('-lc');
+     { when we have -static for the linker the we also need libgcc }
+     if (cs_link_staticflag in aktglobalswitches) then begin
+      LinkRes.Add('-lgcc');
+     end;
+     if linkdynamic and (Info.DynamicLinker<>'') then { gld has a default, DynamicLinker is not set in sunos }
+       LinkRes.AddFileName(Info.DynamicLinker);
+     LinkRes.Add(')');
+   end;
+{ Write and Close response }
+  linkres.writetodisk;
+  linkres.done;
+
+  WriteResponseFile:=True;
+end;
+
+
+function TLinkersunos.MakeExecutable:boolean;
+var
+  binstr,
+  cmdstr  : string;
+  success : boolean;
+  DynLinkStr : string[60];
+  StaticStr,
+  StripStr   : string[40];
+begin
+  if not(cs_link_extern in aktglobalswitches) then
+   Message1(exec_i_linking,current_module.exefilename^);
+
+{ Create some replacements }
+  StaticStr:='';
+  StripStr:='';
+  DynLinkStr:='';
+  if (cs_link_staticflag in aktglobalswitches) then
+    StaticStr:='-Bstatic';
+  if (cs_link_strip in aktglobalswitches) then
+   StripStr:='-s';
+  If (cs_profile in aktmoduleswitches) or
+     ((Info.DynamicLinker<>'') and (not SharedLibFiles.Empty)) then
+   DynLinkStr:='-dynamic-linker='+Info.DynamicLinker;
+  { sunos sets DynamicLinker, but gld will (hopefully) defaults to -Bdynamic and add the default-linker }
+{ Write used files and libraries }
+  WriteResponseFile(false);
+
+{ Call linker }
+  SplitBinCmd(Info.ExeCmd[1],binstr,cmdstr);
+  Replace(cmdstr,'$EXE',current_module.exefilename^);
+  Replace(cmdstr,'$OPT',Info.ExtraOptions);
+  Replace(cmdstr,'$RES',outputexedir+Info.ResName);
+  Replace(cmdstr,'$STATIC',StaticStr);
+  Replace(cmdstr,'$STRIP',StripStr);
+  Replace(cmdstr,'$DYNLINK',DynLinkStr);
+  success:=DoExec(FindUtil(BinStr),CmdStr,true,false);
+
+{ Remove ReponseFile }
+{$IFNDEF LinkTest}
+  if (success) and not(cs_link_extern in aktglobalswitches) then
+   RemoveFile(outputexedir+Info.ResName);
+{$ENDIF}
+  MakeExecutable:=success;   { otherwise a recursive call to link method }
+end;
+
+
+Function TLinkersunos.MakeSharedLibrary:boolean;
+var
+  binstr,
+  cmdstr  : string;
+  success : boolean;
+begin
+  MakeSharedLibrary:=false;
+  if not(cs_link_extern in aktglobalswitches) then
+   Message1(exec_i_linking,current_module.sharedlibfilename^);
+
+{ Write used files and libraries }
+  WriteResponseFile(true);
+
+{ Call linker }
+  SplitBinCmd(Info.DllCmd[1],binstr,cmdstr);
+  Replace(cmdstr,'$EXE',current_module.sharedlibfilename^);
+  Replace(cmdstr,'$OPT',Info.ExtraOptions);
+  Replace(cmdstr,'$RES',outputexedir+Info.ResName);
+  success:=DoExec(FindUtil(binstr),cmdstr,true,false);
+
+{ Strip the library ? }
+  if success and (cs_link_strip in aktglobalswitches) then
+   begin
+     SplitBinCmd(Info.DllCmd[2],binstr,cmdstr);
+     Replace(cmdstr,'$EXE',current_module.sharedlibfilename^);
+     success:=DoExec(FindUtil(binstr),cmdstr,true,false);
+   end;
+
+{ Remove ReponseFile }
+{$IFNDEF LinkTest}
+  if (success) and not(cs_link_extern in aktglobalswitches) then
+   RemoveFile(outputexedir+Info.ResName);
+{$ENDIF}
+  MakeSharedLibrary:=success;   { otherwise a recursive call to link method }
+end;
+
+
+end.
+{
+  $Log$
+  Revision 1.1  2001-02-26 19:43:11  peter
+    * moved target units to subdir
+
+}

compiler/targets/t_win32.pas

@@ -0,0 +1,1291 @@
+{
+    $Id$
+    Copyright (c) 1998-2000 by Peter Vreman
+
+    This unit implements support import,export,link routines
+    for the (i386) Win32 target
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+ ****************************************************************************
+}
+unit t_win32;
+
+{$i defines.inc}
+
+interface
+
+  uses
+    import,export,link;
+
+  const
+     winstackpagesize = 4096;
+
+  type
+    timportlibwin32=class(timportlib)
+      procedure preparelib(const s:string);override;
+      procedure importprocedure(const func,module:string;index:longint;const name:string);override;
+      procedure importvariable(const varname,module:string;const name:string);override;
+      procedure generatelib;override;
+      procedure generatenasmlib;virtual;
+      procedure generatesmartlib;override;
+    end;
+
+    texportlibwin32=class(texportlib)
+      st : string;
+      last_index : longint;
+      procedure preparelib(const s:string);override;
+      procedure exportprocedure(hp : texported_item);override;
+      procedure exportvar(hp : texported_item);override;
+      procedure generatelib;override;
+      procedure generatenasmlib;virtual;
+    end;
+
+    tlinkerwin32=class(tlinker)
+    private
+       Function  WriteResponseFile(isdll:boolean) : Boolean;
+       Function  PostProcessExecutable(const fn:string;isdll:boolean) : Boolean;
+    public
+       Constructor Create;
+       Procedure SetDefaultInfo;override;
+       function  MakeExecutable:boolean;override;
+       function  MakeSharedLibrary:boolean;override;
+    end;
+
+
+implementation
+
+    uses
+{$ifdef Delphi}
+       dmisc,
+{$else Delphi}
+       dos,
+{$endif Delphi}
+       cutils,cclasses,
+       aasm,fmodule,globtype,globals,systems,verbose,
+       script,gendef,impdef,
+       cpubase,cpuasm
+{$ifdef GDB}
+       ,gdb
+{$endif}
+       ;
+
+    function DllName(Const Name : string) : string;
+      var n : string;
+      begin
+         n:=Upper(SplitExtension(Name));
+         if (n='.DLL') or (n='.DRV') or (n='.EXE') then
+           DllName:=Name
+         else
+           DllName:=Name+target_os.sharedlibext;
+      end;
+
+
+    function FindDLL(const s:string):string;
+      var
+        sysdir : string;
+        FoundDll : string;
+        Found : boolean;
+      begin
+        Found:=false;
+        { Look for DLL in:
+          1. Current dir
+          2. Library Path
+          3. windir,windir/system,windir/system32 }
+        Found:=FindFile(s,'.'+DirSep,founddll);
+        if (not found) then
+         Found:=includesearchpath.FindFile(s,founddll);
+        if (not found) then
+         begin
+           sysdir:=FixPath(GetEnv('windir'),false);
+           Found:=FindFile(s,sysdir+';'+sysdir+'system'+DirSep+';'+sysdir+'system32'+DirSep,founddll);
+         end;
+        if (not found) then
+         begin
+           message1(exec_w_libfile_not_found,s);
+           FoundDll:=s;
+         end;
+        FindDll:=FoundDll;
+      end;
+
+
+{*****************************************************************************
+                             TIMPORTLIBWIN32
+*****************************************************************************}
+
+    procedure timportlibwin32.preparelib(const s : string);
+      begin
+         if not(assigned(importssection)) then
+           importssection:=TAAsmoutput.create;
+      end;
+
+
+    procedure timportlibwin32.importprocedure(const func,module : string;index : longint;const name : string);
+      var
+         hp1 : timportlist;
+         hp2 : timported_item;
+         hs  : string;
+      begin
+         hs:=DllName(module);
+         { search for the module }
+         hp1:=timportlist(current_module.imports.first);
+         while assigned(hp1) do
+           begin
+              if hs=hp1.dllname^ then
+                break;
+              hp1:=timportlist(hp1.next);
+           end;
+         { generate a new item ? }
+         if not(assigned(hp1)) then
+           begin
+              hp1:=timportlist.create(hs);
+              current_module.imports.concat(hp1);
+           end;
+         { search for reuse of old import item }
+         hp2:=timported_item(hp1.imported_items.first);
+         while assigned(hp2) do
+          begin
+            if hp2.func^=func then
+             break;
+            hp2:=timported_item(hp2.next);
+          end;
+         if not assigned(hp2) then
+          begin
+            hp2:=timported_item.create(func,name,index);
+            hp1.imported_items.concat(hp2);
+          end;
+      end;
+
+
+    procedure timportlibwin32.importvariable(const varname,module:string;const name:string);
+      var
+         hp1 : timportlist;
+         hp2 : timported_item;
+         hs  : string;
+      begin
+         hs:=DllName(module);
+         { search for the module }
+         hp1:=timportlist(current_module.imports.first);
+         while assigned(hp1) do
+           begin
+              if hs=hp1.dllname^ then
+                break;
+              hp1:=timportlist(hp1.next);
+           end;
+         { generate a new item ? }
+         if not(assigned(hp1)) then
+           begin
+              hp1:=timportlist.create(hs);
+              current_module.imports.concat(hp1);
+           end;
+         hp2:=timported_item.create_var(varname,name);
+         hp1.imported_items.concat(hp2);
+      end;
+
+    procedure timportlibwin32.generatenasmlib;
+      var
+         hp1 : timportlist;
+         hp2 : timported_item;
+         p : pchar;
+      begin
+         importssection.concat(tai_section.create(sec_code));
+         hp1:=timportlist(current_module.imports.first);
+         while assigned(hp1) do
+           begin
+             hp2:=timported_item(hp1.imported_items.first);
+             while assigned(hp2) do
+               begin
+                 if (aktoutputformat=as_i386_tasm) or
+                    (aktoutputformat=as_i386_masm) then
+                   p:=strpnew(#9+'EXTRN '+hp2.func^)
+                 else
+                   p:=strpnew(#9+'EXTERN '+hp2.func^);
+                 importssection.concat(tai_direct.create(p));
+                 p:=strpnew(#9+'import '+hp2.func^+' '+hp1.dllname^+' '+hp2.name^);
+                 importssection.concat(tai_direct.create(p));
+                 hp2:=timported_item(hp2.next);
+               end;
+             hp1:=timportlist(hp1.next);
+           end;
+      end;
+
+
+    procedure timportlibwin32.generatesmartlib;
+      var
+         hp1 : timportlist;
+         hp2 : timported_item;
+         lhead,lname,lcode,
+         lidata4,lidata5 : pasmlabel;
+         r : preference;
+      begin
+         if (aktoutputformat<>as_i386_asw) and
+            (aktoutputformat<>as_i386_pecoff) then
+          begin
+            generatenasmlib;
+            exit;
+          end;
+         hp1:=timportlist(current_module.imports.first);
+         while assigned(hp1) do
+           begin
+           { Get labels for the sections }
+             getdatalabel(lhead);
+             getdatalabel(lname);
+             getaddrlabel(lidata4);
+             getaddrlabel(lidata5);
+           { create header for this importmodule }
+             importsSection.concat(Tai_cut.Create_begin);
+             importsSection.concat(Tai_section.Create(sec_idata2));
+             importsSection.concat(Tai_label.Create(lhead));
+             { pointer to procedure names }
+             importsSection.concat(Tai_const_symbol.Create_rva(lidata4));
+             { two empty entries follow }
+             importsSection.concat(Tai_const.Create_32bit(0));
+             importsSection.concat(Tai_const.Create_32bit(0));
+             { pointer to dll name }
+             importsSection.concat(Tai_const_symbol.Create_rva(lname));
+             { pointer to fixups }
+             importsSection.concat(Tai_const_symbol.Create_rva(lidata5));
+             { first write the name references }
+             importsSection.concat(Tai_section.Create(sec_idata4));
+             importsSection.concat(Tai_const.Create_32bit(0));
+             importsSection.concat(Tai_label.Create(lidata4));
+             { then the addresses and create also the indirect jump }
+             importsSection.concat(Tai_section.Create(sec_idata5));
+             importsSection.concat(Tai_const.Create_32bit(0));
+             importsSection.concat(Tai_label.Create(lidata5));
+
+             { create procedures }
+             hp2:=timported_item(hp1.imported_items.first);
+             while assigned(hp2) do
+               begin
+                 { insert cuts }
+                 importsSection.concat(Tai_cut.Create);
+                 { create indirect jump }
+                 if not hp2.is_var then
+                  begin
+                    getlabel(lcode);
+                    new(r);
+                    reset_reference(r^);
+                    r^.symbol:=lcode;
+                    { place jump in codesegment, insert a code section in the
+                      importsection to reduce the amount of .s files (PFV) }
+                    importsSection.concat(Tai_section.Create(sec_code));
+{$IfDef GDB}
+                    if (cs_debuginfo in aktmoduleswitches) then
+                     importsSection.concat(Tai_stab_function_name.Create(nil));
+{$EndIf GDB}
+                    importsSection.concat(Tai_symbol.Createname_global(hp2.func^,0));
+                    importsSection.concat(Taicpu.Op_ref(A_JMP,S_NO,r));
+                    importsSection.concat(Tai_align.Create_op(4,$90));
+                  end;
+                 { create head link }
+                 importsSection.concat(Tai_section.Create(sec_idata7));
+                 importsSection.concat(Tai_const_symbol.Create_rva(lhead));
+                 { fixup }
+                 getlabel(pasmlabel(hp2.lab));
+                 importsSection.concat(Tai_section.Create(sec_idata4));
+                 importsSection.concat(Tai_const_symbol.Create_rva(hp2.lab));
+                 { add jump field to importsection }
+                 importsSection.concat(Tai_section.Create(sec_idata5));
+                 if hp2.is_var then
+                  importsSection.concat(Tai_symbol.Createname_global(hp2.func^,0))
+                 else
+                  importsSection.concat(Tai_label.Create(lcode));
+                  if hp2.name^<>'' then
+                    importsSection.concat(Tai_const_symbol.Create_rva(hp2.lab))
+                  else
+                    importsSection.concat(Tai_const.Create_32bit($80000000 or hp2.ordnr));
+                 { finally the import information }
+                 importsSection.concat(Tai_section.Create(sec_idata6));
+                 importsSection.concat(Tai_label.Create(hp2.lab));
+                 importsSection.concat(Tai_const.Create_16bit(hp2.ordnr));
+                 importsSection.concat(Tai_string.Create(hp2.name^+#0));
+                 importsSection.concat(Tai_align.Create_op(2,0));
+                 hp2:=timported_item(hp2.next);
+               end;
+
+              { write final section }
+              importsSection.concat(Tai_cut.Create_end);
+              { end of name references }
+              importsSection.concat(Tai_section.Create(sec_idata4));
+              importsSection.concat(Tai_const.Create_32bit(0));
+              { end if addresses }
+              importsSection.concat(Tai_section.Create(sec_idata5));
+              importsSection.concat(Tai_const.Create_32bit(0));
+              { dllname }
+              importsSection.concat(Tai_section.Create(sec_idata7));
+              importsSection.concat(Tai_label.Create(lname));
+              importsSection.concat(Tai_string.Create(hp1.dllname^+#0));
+
+              hp1:=timportlist(hp1.next);
+           end;
+       end;
+
+
+    procedure timportlibwin32.generatelib;
+      var
+         hp1 : timportlist;
+         hp2 : timported_item;
+         l1,l2,l3,l4 : pasmlabel;
+         r : preference;
+      begin
+         if (aktoutputformat<>as_i386_asw) and
+            (aktoutputformat<>as_i386_pecoff) then
+          begin
+            generatenasmlib;
+            exit;
+          end;
+         hp1:=timportlist(current_module.imports.first);
+         while assigned(hp1) do
+           begin
+              { align codesegment for the jumps }
+              importsSection.concat(Tai_section.Create(sec_code));
+              importsSection.concat(Tai_align.Create_op(4,$90));
+              { Get labels for the sections }
+              getlabel(l1);
+              getlabel(l2);
+              getlabel(l3);
+              importsSection.concat(Tai_section.Create(sec_idata2));
+              { pointer to procedure names }
+              importsSection.concat(Tai_const_symbol.Create_rva(l2));
+              { two empty entries follow }
+              importsSection.concat(Tai_const.Create_32bit(0));
+              importsSection.concat(Tai_const.Create_32bit(0));
+              { pointer to dll name }
+              importsSection.concat(Tai_const_symbol.Create_rva(l1));
+              { pointer to fixups }
+              importsSection.concat(Tai_const_symbol.Create_rva(l3));
+
+              { only create one section for each else it will
+                create a lot of idata* }
+
+              { first write the name references }
+              importsSection.concat(Tai_section.Create(sec_idata4));
+              importsSection.concat(Tai_label.Create(l2));
+
+              hp2:=timported_item(hp1.imported_items.first);
+              while assigned(hp2) do
+                begin
+                   getlabel(pasmlabel(hp2.lab));
+                   if hp2.name^<>'' then
+                     importsSection.concat(Tai_const_symbol.Create_rva(hp2.lab))
+                   else
+                     importsSection.concat(Tai_const.Create_32bit($80000000 or hp2.ordnr));
+                   hp2:=timported_item(hp2.next);
+                end;
+              { finalize the names ... }
+              importsSection.concat(Tai_const.Create_32bit(0));
+
+              { then the addresses and create also the indirect jump }
+              importsSection.concat(Tai_section.Create(sec_idata5));
+              importsSection.concat(Tai_label.Create(l3));
+              hp2:=timported_item(hp1.imported_items.first);
+              while assigned(hp2) do
+                begin
+                   if not hp2.is_var then
+                    begin
+                      getlabel(l4);
+                      { create indirect jump }
+                      new(r);
+                      reset_reference(r^);
+                      r^.symbol:=l4;
+                      { place jump in codesegment }
+                      importsSection.concat(Tai_section.Create(sec_code));
+                      importsSection.concat(Tai_symbol.Createname_global(hp2.func^,0));
+                      importsSection.concat(Taicpu.Op_ref(A_JMP,S_NO,r));
+                      importsSection.concat(Tai_align.Create_op(4,$90));
+                      { add jump field to importsection }
+                      importsSection.concat(Tai_section.Create(sec_idata5));
+                      importsSection.concat(Tai_label.Create(l4));
+                    end
+                   else
+                    begin
+                      importsSection.concat(Tai_symbol.Createname_global(hp2.func^,0));
+                    end;
+                   importsSection.concat(Tai_const_symbol.Create_rva(hp2.lab));
+                   hp2:=timported_item(hp2.next);
+                end;
+              { finalize the addresses }
+              importsSection.concat(Tai_const.Create_32bit(0));
+
+              { finally the import information }
+              importsSection.concat(Tai_section.Create(sec_idata6));
+              hp2:=timported_item(hp1.imported_items.first);
+              while assigned(hp2) do
+                begin
+                   importsSection.concat(Tai_label.Create(hp2.lab));
+                   { the ordinal number }
+                   importsSection.concat(Tai_const.Create_16bit(hp2.ordnr));
+                   importsSection.concat(Tai_string.Create(hp2.name^+#0));
+                   importsSection.concat(Tai_align.Create_op(2,0));
+                   hp2:=timported_item(hp2.next);
+                end;
+              { create import dll name }
+              importsSection.concat(Tai_section.Create(sec_idata7));
+              importsSection.concat(Tai_label.Create(l1));
+              importsSection.concat(Tai_string.Create(hp1.dllname^+#0));
+
+              hp1:=timportlist(hp1.next);
+           end;
+      end;
+
+
+{*****************************************************************************
+                             TEXPORTLIBWIN32
+*****************************************************************************}
+
+    procedure texportlibwin32.preparelib(const s:string);
+      begin
+         if not(assigned(exportssection)) then
+           exportssection:=TAAsmoutput.create;
+         last_index:=0;
+      end;
+
+
+
+    procedure texportlibwin32.exportvar(hp : texported_item);
+      begin
+         { same code used !! PM }
+         exportprocedure(hp);
+      end;
+
+
+    procedure texportlibwin32.exportprocedure(hp : texported_item);
+      { must be ordered at least for win32 !! }
+      var
+        hp2 : texported_item;
+      begin
+        { first test the index value }
+        if (hp.options and eo_index)<>0 then
+          begin
+             if (hp.index<=0) or (hp.index>$ffff) then
+               begin
+                 message1(parser_e_export_invalid_index,tostr(hp.index));
+                 exit;
+               end;
+             if (hp.index<=last_index) then
+               begin
+                 message1(parser_e_export_ordinal_double,tostr(hp.index));
+                 { disregard index value }
+                 inc(last_index);
+                 hp.index:=last_index;
+                 exit;
+               end
+             else
+               begin
+                 last_index:=hp.index;
+               end;
+          end
+        else
+          begin
+             inc(last_index);
+             hp.index:=last_index;
+          end;
+        { now place in correct order }
+        hp2:=texported_item(current_module._exports.first);
+        while assigned(hp2) and
+           (hp.name^>hp2.name^) do
+          hp2:=texported_item(hp2.next);
+        { insert hp there !! }
+        if assigned(hp2) and (hp2.name^=hp.name^) then
+          begin
+             { this is not allowed !! }
+             message1(parser_e_export_name_double,hp.name^);
+             exit;
+          end;
+        if hp2=texported_item(current_module._exports.first) then
+          current_module._exports.concat(hp)
+        else if assigned(hp2) then
+          begin
+             hp.next:=hp2;
+             hp.previous:=hp2.previous;
+             if assigned(hp2.previous) then
+               hp2.previous.next:=hp;
+             hp2.previous:=hp;
+          end
+        else
+          current_module._exports.concat(hp);
+      end;
+
+
+    procedure texportlibwin32.generatelib;
+      var
+         ordinal_base,ordinal_max,ordinal_min : longint;
+         current_index : longint;
+         entries,named_entries : longint;
+         name_label,dll_name_label,export_address_table : pasmlabel;
+         export_name_table_pointers,export_ordinal_table : pasmlabel;
+         hp,hp2 : texported_item;
+         temtexport : TLinkedList;
+         address_table,name_table_pointers,
+         name_table,ordinal_table : TAAsmoutput;
+      begin
+        if (aktoutputformat<>as_i386_asw) and
+           (aktoutputformat<>as_i386_pecoff) then
+         begin
+           generatenasmlib;
+           exit;
+         end;
+
+         hp:=texported_item(current_module._exports.first);
+         if not assigned(hp) then
+           exit;
+
+         ordinal_max:=0;
+         ordinal_min:=$7FFFFFFF;
+         entries:=0;
+         named_entries:=0;
+         getlabel(dll_name_label);
+         getlabel(export_address_table);
+         getlabel(export_name_table_pointers);
+         getlabel(export_ordinal_table);
+
+         { count entries }
+         while assigned(hp) do
+           begin
+              inc(entries);
+              if (hp.index>ordinal_max) then
+                ordinal_max:=hp.index;
+              if (hp.index>0) and (hp.index<ordinal_min) then
+                ordinal_min:=hp.index;
+              if assigned(hp.name) then
+                inc(named_entries);
+              hp:=texported_item(hp.next);
+           end;
+
+         { no support for higher ordinal base yet !! }
+         ordinal_base:=1;
+         current_index:=ordinal_base;
+         { we must also count the holes !! }
+         entries:=ordinal_max-ordinal_base+1;
+
+         exportsSection.concat(Tai_section.Create(sec_edata));
+         { export flags }
+         exportsSection.concat(Tai_const.Create_32bit(0));
+         { date/time stamp }
+         exportsSection.concat(Tai_const.Create_32bit(0));
+         { major version }
+         exportsSection.concat(Tai_const.Create_16bit(0));
+         { minor version }
+         exportsSection.concat(Tai_const.Create_16bit(0));
+         { pointer to dll name }
+         exportsSection.concat(Tai_const_symbol.Create_rva(dll_name_label));
+         { ordinal base normally set to 1 }
+         exportsSection.concat(Tai_const.Create_32bit(ordinal_base));
+         { number of entries }
+         exportsSection.concat(Tai_const.Create_32bit(entries));
+         { number of named entries }
+         exportsSection.concat(Tai_const.Create_32bit(named_entries));
+         { address of export address table }
+         exportsSection.concat(Tai_const_symbol.Create_rva(export_address_table));
+         { address of name pointer pointers }
+         exportsSection.concat(Tai_const_symbol.Create_rva(export_name_table_pointers));
+         { address of ordinal number pointers }
+         exportsSection.concat(Tai_const_symbol.Create_rva(export_ordinal_table));
+         { the name }
+         exportsSection.concat(Tai_label.Create(dll_name_label));
+         if st='' then
+           exportsSection.concat(Tai_string.Create(current_module.modulename^+target_os.sharedlibext+#0))
+         else
+           exportsSection.concat(Tai_string.Create(st+target_os.sharedlibext+#0));
+
+         {  export address table }
+         address_table:=TAAsmoutput.create;
+         address_table.concat(Tai_align.Create_op(4,0));
+         address_table.concat(Tai_label.Create(export_address_table));
+         name_table_pointers:=TAAsmoutput.create;
+         name_table_pointers.concat(Tai_align.Create_op(4,0));
+         name_table_pointers.concat(Tai_label.Create(export_name_table_pointers));
+         ordinal_table:=TAAsmoutput.create;
+         ordinal_table.concat(Tai_align.Create_op(4,0));
+         ordinal_table.concat(Tai_label.Create(export_ordinal_table));
+         name_table:=TAAsmoutput.Create;
+         name_table.concat(Tai_align.Create_op(4,0));
+         { write each address }
+         hp:=texported_item(current_module._exports.first);
+         while assigned(hp) do
+           begin
+              if (hp.options and eo_name)<>0 then
+                begin
+                   getlabel(name_label);
+                   name_table_pointers.concat(Tai_const_symbol.Create_rva(name_label));
+                   ordinal_table.concat(Tai_const.Create_16bit(hp.index-ordinal_base));
+                   name_table.concat(Tai_align.Create_op(2,0));
+                   name_table.concat(Tai_label.Create(name_label));
+                   name_table.concat(Tai_string.Create(hp.name^+#0));
+                end;
+              hp:=texported_item(hp.next);
+           end;
+         { order in increasing ordinal values }
+         { into temtexport list }
+         temtexport:=TLinkedList.Create;
+         hp:=texported_item(current_module._exports.first);
+         while assigned(hp) do
+           begin
+              current_module._exports.remove(hp);
+              hp2:=texported_item(temtexport.first);
+              while assigned(hp2) and (hp.index>hp2.index) do
+                begin
+                   hp2:=texported_item(hp2.next);
+                end;
+              if hp2=texported_item(temtexport.first) then
+                 temtexport.insert(hp)
+              else
+                begin
+                   if assigned(hp2) then
+                     begin
+                        hp.next:=hp2;
+                        hp.previous:=hp2.previous;
+                        hp2.previous:=hp;
+                        if assigned(hp.previous) then
+                          hp.previous.next:=hp;
+                      end
+                    else
+                      temtexport.concat(hp);
+                end;
+              hp:=texported_item(current_module._exports.first);;
+           end;
+
+         { write the export adress table }
+         current_index:=ordinal_base;
+         hp:=texported_item(temtexport.first);
+         while assigned(hp) do
+           begin
+              { fill missing values }
+              while current_index<hp.index do
+                begin
+                   address_table.concat(Tai_const.Create_32bit(0));
+                   inc(current_index);
+                end;
+              address_table.concat(Tai_const_symbol.Createname_rva(hp.sym^.mangledname));
+              inc(current_index);
+              hp:=texported_item(hp.next);
+           end;
+
+         exportsSection.concatlist(address_table);
+         exportsSection.concatlist(name_table_pointers);
+         exportsSection.concatlist(ordinal_table);
+         exportsSection.concatlist(name_table);
+         address_table.Free;
+         name_table_pointers.free;
+         ordinal_table.free;
+         name_table.free;
+         temtexport.free;
+      end;
+
+    procedure texportlibwin32.generatenasmlib;
+      var
+         hp : texported_item;
+         p : pchar;
+      begin
+         exportssection.concat(tai_section.create(sec_code));
+         hp:=texported_item(current_module._exports.first);
+         while assigned(hp) do
+           begin
+             p:=strpnew(#9+'export '+hp.sym^.mangledname+' '+hp.name^+' '+tostr(hp.index));
+             exportssection.concat(tai_direct.create(p));
+             hp:=texported_item(hp.next);
+           end;
+      end;
+
+
+{****************************************************************************
+                              TLINKERWIN32
+****************************************************************************}
+
+
+Constructor TLinkerWin32.Create;
+begin
+  Inherited Create;
+  { allow duplicated libs (PM) }
+  SharedLibFiles.doubles:=true;
+  StaticLibFiles.doubles:=true;
+  If not ForceDeffileForExport then
+    UseDeffileForExport:=false;
+end;
+
+Procedure TLinkerWin32.SetDefaultInfo;
+begin
+  with Info do
+   begin
+     ExeCmd[1]:='ldw $OPT $STRIP $APPTYPE $IMAGEBASE $RELOC -o $EXE $RES';
+     DllCmd[1]:='ldw $OPT $STRIP --dll $APPTYPE $IMAGEBASE $RELOC -o $EXE $RES';
+     if RelocSection or UseDeffileForExport then
+       begin
+          { ExeCmd[2]:='dlltool --as $ASBIN --dllname $EXE --output-exp exp.$$$ $RELOC $DEF';
+            use short forms to avoid 128 char limitation problem }
+          ExeCmd[2]:='dlltool -S $ASBIN -D $EXE -e exp.$$$ $RELOC $DEF';
+          ExeCmd[3]:='ldw $OPT $STRIP $APPTYPE $IMAGEBASE -o $EXE $RES exp.$$$';
+          { DllCmd[2]:='dlltool --as $ASBIN --dllname $EXE --output-exp exp.$$$ $RELOC $DEF'; }
+          DllCmd[2]:='dlltool -S $ASBIN -D $EXE -e exp.$$$ $RELOC $DEF';
+          DllCmd[3]:='ldw $OPT $STRIP --dll $APPTYPE $IMAGEBASE -o $EXE $RES exp.$$$';
+       end;
+   end;
+end;
+
+
+
+Function TLinkerWin32.WriteResponseFile(isdll:boolean) : Boolean;
+
+  function do_makedef(const DllName,LibName:string):boolean;
+  var
+    CmdLine : string;
+  begin
+    if (not do_build) and
+       FileExists(LibName) then
+     begin
+       if GetNamedFileTime(LibName)>GetNamedFileTime(DllName) then
+        begin
+          do_makedef:=true;
+          exit;
+        end;
+     end;
+    asw_name:=FindUtil('asw');
+    arw_name:=FindUtil('arw');
+    if cs_link_extern in aktglobalswitches then
+     begin
+       CmdLine:='-l '+LibName+' -i '+DLLName;
+       if asw_name<>'' then
+        CmdLine:=CmdLine+' -a '+asw_name;
+       if arw_name<>'' then
+        CmdLine:=CmdLine+' -r '+arw_name;
+       do_makedef:=DoExec(FindUtil('fpimpdef'),CmdLine,false,false);
+     end
+    else
+     do_makedef:=makedef(DLLName,LIbName);
+  end;
+
+Var
+  linkres  : TLinkRes;
+  i        : longint;
+  HPath    : TStringListItem;
+  s,s2     : string;
+  found,
+  linklibc : boolean;
+begin
+  WriteResponseFile:=False;
+
+  { Create static import libraries for DLL that are
+    included using the $linklib directive }
+  While not SharedLibFiles.Empty do
+   begin
+     s:=SharedLibFiles.GetFirst;
+     s2:=AddExtension(s,target_os.sharedlibext);
+     s:=target_os.libprefix+SplitName(s)+target_os.staticlibext;
+     if Do_makedef(FindDLL(s2),s) then
+      begin
+        if s<>''then
+         StaticLibFiles.insert(s);
+      end
+     else
+      begin
+        Message(exec_w_error_while_linking);
+        aktglobalswitches:=aktglobalswitches+[cs_link_extern];
+      end;
+   end;
+
+  { Open link.res file }
+  LinkRes.Init(outputexedir+Info.ResName);
+
+  { Write path to search libraries }
+  HPath:=TStringListItem(current_module.locallibrarysearchpath.First);
+  while assigned(HPath) do
+   begin
+     LinkRes.Add('SEARCH_DIR('+GetShortName(HPath.Str)+')');
+     HPath:=TStringListItem(HPath.Next);
+   end;
+  HPath:=TStringListItem(LibrarySearchPath.First);
+  while assigned(HPath) do
+   begin
+     LinkRes.Add('SEARCH_DIR('+GetShortName(HPath.Str)+')');
+     HPath:=TStringListItem(HPath.Next);
+   end;
+
+  { add objectfiles, start with prt0 always }
+  LinkRes.Add('INPUT(');
+  if isdll then
+   LinkRes.AddFileName(GetShortName(FindObjectFile('wdllprt0','')))
+  else
+   LinkRes.AddFileName(GetShortName(FindObjectFile('wprt0','')));
+  while not ObjectFiles.Empty do
+   begin
+     s:=ObjectFiles.GetFirst;
+     if s<>'' then
+      LinkRes.AddFileName(GetShortName(s));
+   end;
+  LinkRes.Add(')');
+
+  { Write staticlibraries }
+  if not StaticLibFiles.Empty then
+   begin
+     LinkRes.Add('GROUP(');
+     While not StaticLibFiles.Empty do
+      begin
+        S:=StaticLibFiles.GetFirst;
+        LinkRes.AddFileName(GetShortName(s));
+      end;
+     LinkRes.Add(')');
+   end;
+
+  { Write sharedlibraries like -l<lib>, also add the needed dynamic linker
+    here to be sure that it gets linked this is needed for glibc2 systems (PFV) }
+  if not SharedLibFiles.Empty then
+   begin
+     linklibc:=false;
+     LinkRes.Add('INPUT(');
+     While not SharedLibFiles.Empty do
+      begin
+        S:=SharedLibFiles.GetFirst;
+        if pos('.',s)=0 then
+          { we never directly link a DLL
+            its allways through an import library PM }
+          { libraries created by C compilers have .a extensions }
+          s2:=s+'.a'{ target_os.sharedlibext }
+        else
+          s2:=s;
+        s2:=FindLibraryFile(s2,'',found);
+        if found then
+          begin
+            LinkRes.Add(s2);
+            continue;
+          end;
+        if pos(target_os.libprefix,s)=1 then
+          s:=copy(s,length(target_os.libprefix)+1,255);
+        if s<>'c' then
+         begin
+           i:=Pos(target_os.sharedlibext,S);
+           if i>0 then
+            Delete(S,i,255);
+           LinkRes.Add('-l'+s);
+         end
+        else
+         begin
+           LinkRes.Add('-l'+s);
+           linklibc:=true;
+         end;
+      end;
+     { be sure that libc is the last lib }
+     if linklibc then
+      LinkRes.Add('-lc');
+     LinkRes.Add(')');
+   end;
+{ Write and Close response }
+  linkres.writetodisk;
+  linkres.done;
+
+  WriteResponseFile:=True;
+end;
+
+
+function TLinkerWin32.MakeExecutable:boolean;
+var
+  binstr,
+  cmdstr  : string;
+  success : boolean;
+  i       : longint;
+  AsBinStr     : string[80];
+  StripStr,
+  RelocStr,
+  AppTypeStr,
+  ImageBaseStr : string[40];
+begin
+  if not(cs_link_extern in aktglobalswitches) then
+   Message1(exec_i_linking,current_module.exefilename^);
+
+{ Create some replacements }
+  RelocStr:='';
+  AppTypeStr:='';
+  ImageBaseStr:='';
+  StripStr:='';
+  FindExe('asw',AsBinStr);
+  if RelocSection then
+   { Using short form to avoid problems with 128 char limitation under Dos. }
+   RelocStr:='-b base.$$$';
+  if apptype=app_gui then
+   AppTypeStr:='--subsystem windows';
+  if assigned(DLLImageBase) then
+   ImageBaseStr:='--image-base=0x'+DLLImageBase^;
+  if (cs_link_strip in aktglobalswitches) then
+   StripStr:='-s';
+
+{ Write used files and libraries }
+  WriteResponseFile(false);
+
+{ Call linker }
+  success:=false;
+  for i:=1 to 3 do
+   begin
+     SplitBinCmd(Info.ExeCmd[i],binstr,cmdstr);
+     if binstr<>'' then
+      begin
+        Replace(cmdstr,'$EXE',current_module.exefilename^);
+        Replace(cmdstr,'$OPT',Info.ExtraOptions);
+        Replace(cmdstr,'$RES',outputexedir+Info.ResName);
+        Replace(cmdstr,'$APPTYPE',AppTypeStr);
+        Replace(cmdstr,'$ASBIN',AsbinStr);
+        Replace(cmdstr,'$RELOC',RelocStr);
+        Replace(cmdstr,'$IMAGEBASE',ImageBaseStr);
+        Replace(cmdstr,'$STRIP',StripStr);
+        if not DefFile.Empty {and UseDefFileForExport} then
+          begin
+            DefFile.WriteFile;
+            Replace(cmdstr,'$DEF','-d '+deffile.fname);
+          end
+        else
+          Replace(cmdstr,'$DEF','');
+        success:=DoExec(FindUtil(binstr),cmdstr,(i=1),false);
+        if not success then
+         break;
+      end;
+   end;
+
+{ Post process }
+  if success then
+   success:=PostProcessExecutable(current_module.exefilename^,false);
+
+{ Remove ReponseFile }
+  if (success) and not(cs_link_extern in aktglobalswitches) then
+   begin
+     RemoveFile(outputexedir+Info.ResName);
+     RemoveFile('base.$$$');
+     RemoveFile('exp.$$$');
+     RemoveFile('deffile.$$$');
+   end;
+
+  MakeExecutable:=success;   { otherwise a recursive call to link method }
+end;
+
+
+Function TLinkerWin32.MakeSharedLibrary:boolean;
+var
+  binstr,
+  cmdstr  : string;
+  success : boolean;
+  i       : longint;
+  AsBinStr     : string[80];
+  StripStr,
+  RelocStr,
+  AppTypeStr,
+  ImageBaseStr : string[40];
+begin
+  MakeSharedLibrary:=false;
+  if not(cs_link_extern in aktglobalswitches) then
+   Message1(exec_i_linking,current_module.sharedlibfilename^);
+
+{ Create some replacements }
+  RelocStr:='';
+  AppTypeStr:='';
+  ImageBaseStr:='';
+  StripStr:='';
+  FindExe('asw',AsBinStr);
+  if RelocSection then
+   { Using short form to avoid problems with 128 char limitation under Dos. }
+   RelocStr:='-b base.$$$';
+  if apptype=app_gui then
+   AppTypeStr:='--subsystem windows';
+  if assigned(DLLImageBase) then
+   ImageBaseStr:='--image-base=0x'+DLLImageBase^;
+  if (cs_link_strip in aktglobalswitches) then
+   StripStr:='-s';
+
+{ Write used files and libraries }
+  WriteResponseFile(true);
+
+{ Call linker }
+  success:=false;
+  for i:=1 to 3 do
+   begin
+     SplitBinCmd(Info.DllCmd[i],binstr,cmdstr);
+     if binstr<>'' then
+      begin
+        Replace(cmdstr,'$EXE',current_module.sharedlibfilename^);
+        Replace(cmdstr,'$OPT',Info.ExtraOptions);
+        Replace(cmdstr,'$RES',outputexedir+Info.ResName);
+        Replace(cmdstr,'$APPTYPE',AppTypeStr);
+        Replace(cmdstr,'$ASBIN',AsbinStr);
+        Replace(cmdstr,'$RELOC',RelocStr);
+        Replace(cmdstr,'$IMAGEBASE',ImageBaseStr);
+        Replace(cmdstr,'$STRIP',StripStr);
+        if not DefFile.Empty {and UseDefFileForExport} then
+          begin
+            DefFile.WriteFile;
+            Replace(cmdstr,'$DEF','-d '+deffile.fname);
+          end
+        else
+          Replace(cmdstr,'$DEF','');
+        success:=DoExec(FindUtil(binstr),cmdstr,(i=1),false);
+        if not success then
+         break;
+      end;
+   end;
+
+{ Post process }
+  if success then
+   success:=PostProcessExecutable(current_module.sharedlibfilename^,true);
+
+{ Remove ReponseFile }
+  if (success) and not(cs_link_extern in aktglobalswitches) then
+   begin
+     RemoveFile(outputexedir+Info.ResName);
+     RemoveFile('base.$$$');
+     RemoveFile('exp.$$$');
+   end;
+  MakeSharedLibrary:=success;   { otherwise a recursive call to link method }
+end;
+
+
+function tlinkerwin32.postprocessexecutable(const fn : string;isdll:boolean):boolean;
+type
+  tdosheader = packed record
+     e_magic : word;
+     e_cblp : word;
+     e_cp : word;
+     e_crlc : word;
+     e_cparhdr : word;
+     e_minalloc : word;
+     e_maxalloc : word;
+     e_ss : word;
+     e_sp : word;
+     e_csum : word;
+     e_ip : word;
+     e_cs : word;
+     e_lfarlc : word;
+     e_ovno : word;
+     e_res : array[0..3] of word;
+     e_oemid : word;
+     e_oeminfo : word;
+     e_res2 : array[0..9] of word;
+     e_lfanew : longint;
+  end;
+  tpeheader = packed record
+     PEMagic : array[0..3] of char;
+     Machine : word;
+     NumberOfSections : word;
+     TimeDateStamp : longint;
+     PointerToSymbolTable : longint;
+     NumberOfSymbols : longint;
+     SizeOfOptionalHeader : word;
+     Characteristics : word;
+     Magic : word;
+     MajorLinkerVersion : byte;
+     MinorLinkerVersion : byte;
+     SizeOfCode : longint;
+     SizeOfInitializedData : longint;
+     SizeOfUninitializedData : longint;
+     AddressOfEntryPoint : longint;
+     BaseOfCode : longint;
+     BaseOfData : longint;
+     ImageBase : longint;
+     SectionAlignment : longint;
+     FileAlignment : longint;
+     MajorOperatingSystemVersion : word;
+     MinorOperatingSystemVersion : word;
+     MajorImageVersion : word;
+     MinorImageVersion : word;
+     MajorSubsystemVersion : word;
+     MinorSubsystemVersion : word;
+     Reserved1 : longint;
+     SizeOfImage : longint;
+     SizeOfHeaders : longint;
+     CheckSum : longint;
+     Subsystem : word;
+     DllCharacteristics : word;
+     SizeOfStackReserve : longint;
+     SizeOfStackCommit : longint;
+     SizeOfHeapReserve : longint;
+     SizeOfHeapCommit : longint;
+     LoaderFlags : longint;
+     NumberOfRvaAndSizes : longint;
+     DataDirectory : array[1..$80] of byte;
+  end;
+  tcoffsechdr=packed record
+    name     : array[0..7] of char;
+    vsize    : longint;
+    rvaofs   : longint;
+    datalen  : longint;
+    datapos  : longint;
+    relocpos : longint;
+    lineno1  : longint;
+    nrelocs  : word;
+    lineno2  : word;
+    flags    : longint;
+  end;
+  psecfill=^tsecfill;
+  tsecfill=record
+    fillpos,
+    fillsize : longint;
+    next : psecfill;
+  end;
+var
+  f : file;
+  cmdstr : string;
+  dosheader : tdosheader;
+  peheader : tpeheader;
+  firstsecpos,
+  maxfillsize,
+  l,peheaderpos : longint;
+  coffsec : tcoffsechdr;
+  secroot,hsecroot : psecfill;
+  zerobuf : pointer;
+begin
+  postprocessexecutable:=false;
+  { when -s is used or it's a dll then quit }
+  if (cs_link_extern in aktglobalswitches) then
+   begin
+     case apptype of
+       app_gui :
+         cmdstr:='--subsystem gui';
+       app_cui :
+         cmdstr:='--subsystem console';
+     end;
+     if dllversion<>'' then
+       cmdstr:=cmdstr+' --version '+dllversion;
+     cmdstr:=cmdstr+' --input '+fn;
+     cmdstr:=cmdstr+' --stack '+tostr(stacksize);
+     DoExec(FindUtil('postw32'),cmdstr,false,false);
+     postprocessexecutable:=true;
+     exit;
+   end;
+  { open file }
+  assign(f,fn);
+  {$I-}
+   reset(f,1);
+  if ioresult<>0 then
+    Message1(execinfo_f_cant_open_executable,fn);
+  { read headers }
+  blockread(f,dosheader,sizeof(tdosheader));
+  peheaderpos:=dosheader.e_lfanew;
+  seek(f,peheaderpos);
+  blockread(f,peheader,sizeof(tpeheader));
+  { write info }
+  Message1(execinfo_x_codesize,tostr(peheader.SizeOfCode));
+  Message1(execinfo_x_initdatasize,tostr(peheader.SizeOfInitializedData));
+  Message1(execinfo_x_uninitdatasize,tostr(peheader.SizeOfUninitializedData));
+  { change stack size (PM) }
+  { I am not sure that the default value is adequate !! }
+  peheader.SizeOfStackReserve:=stacksize;
+  { change the header }
+  { sub system }
+  { gui=2 }
+  { cui=3 }
+  case apptype of
+    app_gui :
+      peheader.Subsystem:=2;
+    app_cui :
+      peheader.Subsystem:=3;
+  end;
+  if dllversion<>'' then
+    begin
+     peheader.MajorImageVersion:=dllmajor;
+     peheader.MinorImageVersion:=dllminor;
+    end;
+  { reset timestamp }
+  peheader.TimeDateStamp:=0;
+  { write header back }
+  seek(f,peheaderpos);
+  blockwrite(f,peheader,sizeof(tpeheader));
+  if ioresult<>0 then
+    Message1(execinfo_f_cant_process_executable,fn);
+  seek(f,peheaderpos);
+  blockread(f,peheader,sizeof(tpeheader));
+  { write the value after the change }
+  Message1(execinfo_x_stackreserve,tostr(peheader.SizeOfStackReserve));
+  Message1(execinfo_x_stackcommit,tostr(peheader.SizeOfStackCommit));
+  { read section info }
+  maxfillsize:=0;
+  firstsecpos:=0;
+  secroot:=nil;
+  for l:=1 to peheader.NumberOfSections do
+   begin
+     blockread(f,coffsec,sizeof(tcoffsechdr));
+     if coffsec.datapos>0 then
+      begin
+        if secroot=nil then
+         firstsecpos:=coffsec.datapos;
+        new(hsecroot);
+        hsecroot^.fillpos:=coffsec.datapos+coffsec.vsize;
+        hsecroot^.fillsize:=coffsec.datalen-coffsec.vsize;
+        hsecroot^.next:=secroot;
+        secroot:=hsecroot;
+        if secroot^.fillsize>maxfillsize then
+         maxfillsize:=secroot^.fillsize;
+      end;
+   end;
+  if firstsecpos>0 then
+   begin
+     l:=firstsecpos-filepos(f);
+     if l>maxfillsize then
+      maxfillsize:=l;
+   end
+  else
+   l:=0;
+  { get zero buffer }
+  getmem(zerobuf,maxfillsize);
+  fillchar(zerobuf^,maxfillsize,0);
+  { zero from sectioninfo until first section }
+  blockwrite(f,zerobuf^,l);
+  { zero section alignments }
+  while assigned(secroot) do
+   begin
+     seek(f,secroot^.fillpos);
+     blockwrite(f,zerobuf^,secroot^.fillsize);
+     hsecroot:=secroot;
+     secroot:=secroot^.next;
+     dispose(hsecroot);
+   end;
+  freemem(zerobuf,maxfillsize);
+  close(f);
+  {$I+}
+  if ioresult<>0 then;
+  postprocessexecutable:=true;
+end;
+
+end.
+{
+  $Log$
+  Revision 1.1  2001-02-26 19:43:11  peter
+    * moved target units to subdir
+
+  Revision 1.10  2001/02/20 21:41:16  peter
+    * new fixfilename, findfile for unix. Look first for lowercase, then
+      NormalCase and last for UPPERCASE names.
+
+  Revision 1.9  2001/01/13 00:09:22  peter
+    * made Pavel O. happy ;)
+
+  Revision 1.8  2000/12/30 22:53:25  peter
+    * export with the case provided in the exports section
+
+  Revision 1.7  2000/12/25 00:07:30  peter
+    + new tlinkedlist class (merge of old tstringqueue,tcontainer and
+      tlinkedlist objects)
+
+  Revision 1.6  2000/11/12 22:20:37  peter
+    * create generic toutputsection for binary writers
+
+  Revision 1.5  2000/09/24 15:06:31  peter
+    * use defines.inc
+
+  Revision 1.4  2000/08/27 16:11:54  peter
+    * moved some util functions from globals,cobjects to cutils
+    * splitted files into finput,fmodule
+
+  Revision 1.3  2000/07/21 15:14:02  jonas
+    + added is_addr field for labels, if they are only used for getting the address
+       (e.g. for io checks) and corresponding getaddrlabel() procedure
+
+  Revision 1.2  2000/07/13 11:32:50  michael
+  + removed logs
+
+}