From ea13526914a14d1bad2f09914b12a96f32b6be42 Mon Sep 17 00:00:00 2001 From: pierre Date: Tue, 23 May 2000 20:18:25 +0000 Subject: [PATCH] + pavel's code integrated, but onyl inside ifdef pavel_linklib ! --- compiler/impdef.pas | 146 ++++++++++++++++++++++++++++ compiler/scandir.inc | 88 ++++++++++++++++- compiler/t_win32.pas | 194 ++++++++++++++++++++++++++++++++++++- compiler/utils/fpimpdef.pp | 56 +++++++++++ 4 files changed, 480 insertions(+), 4 deletions(-) create mode 100644 compiler/impdef.pas create mode 100644 compiler/utils/fpimpdef.pp diff --git a/compiler/impdef.pas b/compiler/impdef.pas new file mode 100644 index 0000000000..ab07662a31 --- /dev/null +++ b/compiler/impdef.pas @@ -0,0 +1,146 @@ +unit impdef; +{ +C source code of DEWIN Windows disassembler (written by A. Milukov) was +partially used +} +interface +function makedef(const binname,textname:string):longbool; +implementation +var +f:file; +t:text; +TheWord:array[0..1]of char; +PEoffset:cardinal; +loaded:{$ifdef fpc}longint{$else}integer{$endif}; +FileCreated:longbool; +function DOSstubOK(var x:cardinal):longbool; +begin + blockread(f,TheWord,2,loaded); + if loaded<>2 then + DOSstubOK:=false + else + begin + DOSstubOK:=TheWord='MZ'; + seek(f,$3C); + blockread(f,x,4,loaded); + if(loaded<>4)or(x>filesize(f))then + DOSstubOK:=false; + end; +end; +function isPE(x:cardinal):longbool; +begin + seek(f,x); + blockread(f,TheWord,2,loaded); + isPE:=(loaded=2)and(TheWord='PE'); +end; +var +cstring:array[0..127]of char; + +function GetEdata(PE:cardinal):longbool; +type + TObjInfo=packed record + ObjName:array[0..7]of char; + VirtSize, + VirtAddr, + RawSize, + RawOffset, + Reloc, + LineNum:cardinal; + RelCount, + LineCount:word; + flags:cardinal; + end; +var + i:cardinal; + ObjOfs:cardinal; + Obj:TObjInfo; + APE_obj,APE_Optsize:word; + ExportRVA:cardinal; + delta:cardinal; +procedure ProcessEdata; + var + j:cardinal; + ulongval:cardinal; + ExpDir:packed record + flag, + stamp:cardinal; + Major, + Minor:word; + Name, + Base, + NumFuncs, + NumNames, + AddrFuncs, + AddrNames, + AddrOrds:cardinal; + end; + begin + with Obj do + begin + seek(f,RawOffset+delta); + blockread(f,ExpDir,sizeof(ExpDir)); + seek(f,RawOffset-VirtAddr+ExpDir.Name); + blockread(f,cstring,sizeof(cstring)); + for j:=0 to pred(ExpDir.NumNames)do + begin + seek(f,RawOffset-VirtAddr+ExpDir.AddrNames+j*4); + blockread(f,ulongval,4); + seek(f,RawOffset-VirtAddr+ulongval); + blockread(f,cstring,sizeof(cstring)); + if not FileCreated then + begin + FileCreated:=true; + rewrite(t); + writeln(t,'EXPORTS'); + end; + { do not use the implicit '_' } + writeln(t,cstring,'=',cstring); + end; + end; + end; +begin + GetEdata:=false; + FileCreated:=false; + seek(f,PE+120); + blockread(f,ExportRVA,4); + seek(f,PE+6); + blockread(f,APE_Obj,2); + seek(f,PE+20); + blockread(f,APE_OptSize,2); + ObjOfs:=APE_OptSize+PEoffset+24; + for i:=1 to APE_obj do + begin + seek(f,ObjOfs); + blockread(f,Obj,sizeof(Obj)); + inc(ObjOfs,sizeof(Obj)); + with Obj do + if(VirtAddr<=ExportRva)and(ExportRva0 then + linkmodeStr:=copy(linkmodeStr,1,pred(p)); + for p:=1 to length(linkmodeStr)do + linkmodeStr[p]:=upcase(linkmodeStr[p]); + if linkmodeStr='STATIC' then + ExtractLinkMode:=lm_static + else + ExtractLinkMode:=lm_dynamic + end; + procedure MangleLibName(mode:tLinkMode); + begin + if (libname[1]='''')and(libname[length(libname)]='''')then + begin + delete(libname,1,1); + delete(libname,length(libname),1); + end + else + begin + libname:=target_os.libprefix+libname; + case mode of + lm_static: + libname:=AddExtension(FixFileName(libname),target_os.staticlibext); + lm_dynamic: + libname:=AddExtension(FixFileName(libname),target_os.sharedlibext); + end; + end; + end; + begin + current_scanner^.skipspace; + s:=current_scanner^.readcomment; + p:=pos(',',s); + if p=0 then + begin + libname:=s; + linkmodeStr:='' + end + else + begin + libname:=copy(s,1,pred(p)); + linkmodeStr:=copy(s,succ(p),255); + end; + if(libname='')or(libname='''''')then + exit; + linkMode:=ExtractLinkMode; + MangleLibName(linkMode); + if linkMode=lm_static then +{$IFDEF NEWST} + current_module^.linkOtherStaticLibs. + insert(new(Plinkitem,init(FixFileName(libname),link_allways))) +{$ELSE} + current_module^.linkOtherStaticLibs. + insert(FixFileName(libname),link_allways) +{$ENDIF} + else +{$IFDEF NEWST} + current_module^.linkOtherSharedLibs. + insert(new(Plinkitem,init(FixFileName(libname),link_allways))); +{$ELSE} + current_module^.linkOtherSharedLibs. + insert(FixFileName(libname),link_allways); +{$ENDIF} + end; + + +{$endif PAVEL_LINKLIB} procedure dir_outputformat(t:tdirectivetoken); @@ -1335,7 +1415,11 @@ const { $Log$ - Revision 1.80 2000-05-09 21:31:50 pierre + Revision 1.81 2000-05-23 20:18:25 pierre + + pavel's code integrated, but onyl inside + ifdef pavel_linklib ! + + Revision 1.80 2000/05/09 21:31:50 pierre * fix problem when modifying several local switches in a row Revision 1.79 2000/05/03 14:36:58 pierre diff --git a/compiler/t_win32.pas b/compiler/t_win32.pas index 39f39fe515..0f8d7beba9 100644 --- a/compiler/t_win32.pas +++ b/compiler/t_win32.pas @@ -67,6 +67,14 @@ unit t_win32; implementation uses +{$ifdef PAVEL_LINKLIB} +{$ifdef Delphi} + dmisc, +{$else Delphi} + dos, +{$endif Delphi} + impdef, +{$endif PAVEL_LINKLIB} aasm,files,globtype,globals,cobjects,systems,verbose, script,gendef, cpubase,cpuasm @@ -643,7 +651,7 @@ begin end; end; - +{$ifndef PAVEL_LINKLIB} Function TLinkerWin32.WriteResponseFile(isdll:boolean) : Boolean; Var linkres : TLinkRes; @@ -749,6 +757,183 @@ begin WriteResponseFile:=True; end; +{$else PAVEL_LINKLIB} +Function TLinkerWin32.WriteResponseFile(isdll:boolean) : Boolean; +Var + linkres : TLinkRes; + HPath : {$ifdef NEWST} PStringItem {$else} PStringQueueItem {$endif}; + s,s2 : string; + success : boolean; +function ExpandName(const s:string):string; +var + sysdir:string; +procedure GetSysDir; + begin + sysdir:=GetEnv('windir'); + if sysdir<>''then + begin + if not(sysdir[length(sysdir)]in['\','/'])then + sysdir:=sysdir+dirsep; + end; + end; +function IsFile(d:string;var PathToDll:string):longbool; + var + f:file; + attr:word; + begin + PathToDll:=''; + if d<>''then + if d[length(d)]<>dirsep then + d:=d+dirsep; + d:=d+s; + assign(f,d); + GetFattr(f,Attr); + if DOSerror<>0 then + IsFile:=false + else + begin + if(attr and directory)=0 then + begin + IsFile:=true; + PathToDll:=GetShortName(d); + end + else + IsFile:=false; + end; + end; +var + PathToDll:string; +begin + if not isFile('',PathToDll)then + begin + HPath:=LibrarySearchPath.First; + while assigned(HPath) do + begin + if isFile(GetShortName(HPath^.Data^),PathToDll)then + break; + HPath:=HPath^.Next; + end; + if PathToDll='' then + begin + GetSysDir; + if not isFile(sysdir,PathToDll)then + if not isFile(sysdir+'system32',PathToDll)then + if not isFile(sysdir+'system',PathToDll)then + begin + message1(exec_w_libfile_not_found,S2); + PathToDll:=S2; + end; + end; + end; + ExpandName:=PathToDll; +end; +function DotPos(const s:string):longint; +var + i:longint; +begin + DotPos:=0; + for i:=length(s)downto 1 do + begin + if s[i]in['/','\',':']then + exit + else if s[i]='.'then + begin + DotPos:=i; + exit; + end; + end; +end; +procedure strip(var s:string); + var + d:dirstr; + n:namestr; + e:extstr; + begin + fsplit(s,d,n,e); + s:=n; + end; +function do_makedef(const s:string):longbool; + begin + if cs_link_extern in aktglobalswitches then + do_makedef:=DoExec(FindUtil('fpimpdef'),'-o deffile.$$$ -i '+s,false,false) + else + do_makedef:=makedef(s,'deffile.$$$'); + end; +begin + WriteResponseFile:=False; + While not SharedLibFiles.Empty do + begin + S:=SharedLibFiles.Get; + if DotPos(s)=0 then + s2:=s+target_os.sharedlibext + else + s2:=s; + strip(s); + if not do_makedef(ExpandName(s2))then + begin + Message(exec_w_error_while_linking); + aktglobalswitches:=aktglobalswitches+[cs_link_extern]; + end + else + begin + s:=target_os.libprefix+s+target_os.staticlibext; + success:=DoExec(FindUtil('dlltool'),'-l '+s+' -D '+s2+' -d deffile.$$$',false,false); + ObjectFiles.insert(s); + if not success then + break; + end; + end; + + { Open link.res file } + LinkRes.Init(outputexedir+Info.ResName); + + { Write path to search libraries } + HPath:=current_module^.locallibrarysearchpath.First; + while assigned(HPath) do + begin + LinkRes.Add('SEARCH_DIR('+GetShortName(HPath^.Data^)+')'); + HPath:=HPath^.Next; + end; + HPath:=LibrarySearchPath.First; + while assigned(HPath) do + begin + LinkRes.Add('SEARCH_DIR('+GetShortName(HPath^.Data^)+')'); + HPath:=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.Get; + 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.Get; + LinkRes.AddFileName(GetShortName(s)); + end; + LinkRes.Add(')'); + end; + +{ Write and Close response } + linkres.writetodisk; + linkres.done; + + WriteResponseFile:=True; +end; +{$endif PAVEL_LINKLIB} function TLinkerWin32.MakeExecutable:boolean; @@ -824,6 +1009,7 @@ begin RemoveFile(outputexedir+Info.ResName); RemoveFile('base.$$$'); RemoveFile('exp.$$$'); + RemoveFile('deffile.$$$'); end; MakeExecutable:=success; { otherwise a recursive call to link method } @@ -1114,7 +1300,11 @@ end; end. { $Log$ - Revision 1.22 2000-04-14 11:16:10 pierre + Revision 1.23 2000-05-23 20:18:25 pierre + + pavel's code integrated, but onyl inside + ifdef pavel_linklib ! + + Revision 1.22 2000/04/14 11:16:10 pierre * partial linklib change I could not use Pavel's code because it broke the current way linklib is used, which is messy :( diff --git a/compiler/utils/fpimpdef.pp b/compiler/utils/fpimpdef.pp new file mode 100644 index 0000000000..7c5e4527cc --- /dev/null +++ b/compiler/utils/fpimpdef.pp @@ -0,0 +1,56 @@ +program FPimpdef; +uses +ImpDef; +var +binname:string; +function Ofound(const short,full:string):longint; +var + i:longint; +begin + Ofound:=-1; + for i:=1 to ParamCount do + if(paramstr(i)=short)or(paramstr(i)=full)then + begin + Ofound:=i; + exit; + end; +end; +function GetOption(const short,full:string):string; +var + i:longint; +begin + i:=Ofound(short,full); + if i>0 then + GetOption:=paramstr(succ(i)) + else + GetOption:=''; +end; +procedure help_info; +var + fn:string[255]; + jj:cardinal; +begin + fn:=paramstr(0); + for jj:=length(fn)downto 1 do + if fn[jj] in [':','\','/']then + begin + fn:=copy(fn,succ(jj),255); + break; + end; + writeln('Usage: ',fn,' [options]'); + writeln('Options:'); + writeln('-i | --input - set input file;'); + writeln('-o | --output - set output file'); + writeln('-h | --help - show this screen'); + halt; +end; +begin +binname:=GetOption('-i','--input'); +if(binname='')or(Ofound('-h','--help')>0)then + help_info; +if not makedef(binname,GetOption('-o','--output'))then + begin + writeln('Export names not found'); + halt(1); + end; +end. \ No newline at end of file