From 8e0b1c84d214b60bb9401aa3ed0e350a54631754 Mon Sep 17 00:00:00 2001 From: peter Date: Mon, 26 Feb 2001 19:43:11 +0000 Subject: [PATCH] * moved target units to subdir --- compiler/Makefile | 2 +- compiler/Makefile.fpc | 2 +- compiler/targets/t_fbsd.pas | 472 ++++++++++++ compiler/targets/t_go32v1.pas | 209 ++++++ compiler/targets/t_go32v2.pas | 445 ++++++++++++ compiler/targets/t_linux.pas | 481 ++++++++++++ compiler/targets/t_nwm.pas | 449 ++++++++++++ compiler/targets/t_os2.pas | 529 ++++++++++++++ compiler/targets/t_sunos.pas | 480 ++++++++++++ compiler/targets/t_win32.pas | 1291 +++++++++++++++++++++++++++++++++ 10 files changed, 4358 insertions(+), 2 deletions(-) create mode 100644 compiler/targets/t_fbsd.pas create mode 100644 compiler/targets/t_go32v1.pas create mode 100644 compiler/targets/t_go32v2.pas create mode 100644 compiler/targets/t_linux.pas create mode 100644 compiler/targets/t_nwm.pas create mode 100644 compiler/targets/t_os2.pas create mode 100644 compiler/targets/t_sunos.pas create mode 100644 compiler/targets/t_win32.pas diff --git a/compiler/Makefile b/compiler/Makefile index ee0aeaac2d..1fb0123ddc 100644 --- a/compiler/Makefile +++ b/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)))) diff --git a/compiler/Makefile.fpc b/compiler/Makefile.fpc index e6202baf86..6a4e880217 100644 --- a/compiler/Makefile.fpc +++ b/compiler/Makefile.fpc @@ -8,7 +8,7 @@ version=1.1 [compiler] targetdir=. -unitdir=$(CPU_TARGET) +unitdir=$(CPU_TARGET) targets includedir=$(CPU_TARGET) [require] diff --git a/compiler/targets/t_fbsd.pas b/compiler/targets/t_fbsd.pas new file mode 100644 index 0000000000..5b9dcecb9b --- /dev/null +++ b/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, 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 +} diff --git a/compiler/targets/t_go32v1.pas b/compiler/targets/t_go32v1.pas new file mode 100644 index 0000000000..993670bf9b --- /dev/null +++ b/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, 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 + +} diff --git a/compiler/targets/t_go32v2.pas b/compiler/targets/t_go32v2.pas new file mode 100644 index 0000000000..a4567b2685 --- /dev/null +++ b/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, 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, 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 + +} diff --git a/compiler/targets/t_linux.pas b/compiler/targets/t_linux.pas new file mode 100644 index 0000000000..84f1e749bb --- /dev/null +++ b/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, 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 + +} diff --git a/compiler/targets/t_nwm.pas b/compiler/targets/t_nwm.pas new file mode 100644 index 0000000000..082958ed03 --- /dev/null +++ b/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 (diehl@nordrhein.de) for providing the patches + +} diff --git a/compiler/targets/t_os2.pas b/compiler/targets/t_os2.pas new file mode 100644 index 0000000000..fe5e63e423 --- /dev/null +++ b/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 + . +} +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='!'#10; + ar_magic:array[1..length(armag)] of char=armag;} +const ar_magic:array[1..8] of char='!'#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, 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 + +} diff --git a/compiler/targets/t_sunos.pas b/compiler/targets/t_sunos.pas new file mode 100644 index 0000000000..bb24afbfe3 --- /dev/null +++ b/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, 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 + +} diff --git a/compiler/targets/t_win32.pas b/compiler/targets/t_win32.pas new file mode 100644 index 0000000000..88e929a8ec --- /dev/null +++ b/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.index0 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_indexGetNamedFileTime(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, 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 + +}