diff --git a/compiler/impdef.pas b/compiler/impdef.pas index dfe32a90c6..de437b8345 100644 --- a/compiler/impdef.pas +++ b/compiler/impdef.pas @@ -1,6 +1,6 @@ { $Id$ - Copyright (c) 1998-2000 by Florian Klaempfl + Copyright (c) 1998-2000 by Pavel This unit finds the export defs from PE files @@ -25,22 +25,53 @@ } unit impdef; -{$i defines.inc} +{$ifndef STANDALONE} + {$i defines.inc} +{$endif} interface -function makedef(const binname,textname:string):longbool; + uses + {$ifdef Delphi} + SysUtils, + Dmisc; + {$else} + Dos; + {$endif} + + var + asw_name, + arw_name : string; + + function makedef(const binname, +{$IFDEF STANDALONE} + textname, +{$ENDIF} + libname:string):longbool; + implementation + +{$IFDEF STANDALONE} +var + __textname : string; +const + kind : array[longbool] of pchar=('',' DATA'); +{$ENDIF} + var f:file; +{$IFDEF STANDALONE} t:text; + FileCreated:longbool; +{$ENDIF} + lname:string; + impname:string; TheWord:array[0..1]of char; PEoffset:cardinal; - loaded:longint; - FileCreated:longbool; + loaded:{$ifdef fpc}longint{$else}integer{$endif}; -function DOSstubOK(var x:cardinal):longbool; +function DOSstubOK(var x:longint):longbool; begin blockread(f,TheWord,2,loaded); if loaded<>2 then @@ -55,16 +86,17 @@ begin end; end; -function isPE(x:cardinal):longbool; + +function isPE(x:longint):longbool; begin seek(f,x); blockread(f,TheWord,2,loaded); isPE:=(loaded=2)and(TheWord='PE'); end; -var - cstring:array[0..127]of char; +var + cstring : array[0..127]of char; function GetEdata(PE:cardinal):longbool; type TObjInfo=packed record @@ -86,11 +118,234 @@ var APE_obj,APE_Optsize:word; ExportRVA:cardinal; delta:cardinal; - +const + IMAGE_SCN_CNT_CODE=$00000020; + const +{$ifdef unix} + DirSep = '/'; +{$else} + {$ifdef amiga} + DirSep = '/'; + {$else} + DirSep = '\'; + {$endif} +{$endif} +var + path:string; + _d:dirstr; + _n:namestr; + _e:extstr; + common_created:longbool; +procedure cleardir(const s,ext:string); + var + ff:file; + dir:searchrec; + attr:word; + begin + findfirst(s+dirsep+ext,anyfile,dir); + while (doserror=0) do + begin + assign(ff,s+dirsep+dir.name); + GetFattr(ff,attr); + if not((DOSError<>0)or(Attr and Directory<>0))then + Erase(ff); + findnext(dir); + end; + findclose(dir); + end; +procedure CreateTempDir(const s:string); + var + attr:word; + ff:file; + begin + assign(ff,s); + GetFattr(ff,attr); + if DosError=0 then + begin + cleardir(s,'*.sw'); + cleardir(s,'*.swo'); + end + else + begin + {$I-} + mkdir(s); + {$I+} + if ioresult<>0 then; + end; + end; +procedure call_asw(const name:string); + begin + writeln(name); + exec(asw_name,'-o '+name+'o '+name); + end; +procedure call_arw; + var + f:file; + attr:word; + begin +{$IFDEF STANDALONE} + if impname='' then + exit; +{$ENDIF} + assign(f,impname); + GetFAttr(f,attr); + If DOSError=0 then + erase(f); + exec(arw_name,'rs '+impname+' '+path+dirsep+'*.swo'); + cleardir(path,'*.sw'); + cleardir(path,'*.swo'); + {$i-} + RmDir(path); + {$i+} + if ioresult<>0 then; + end; +procedure makeasm(index:cardinal;name:pchar;isData:longbool); + type + tt=array[1..1]of pchar; + pt=^tt; + const + fn_template:array[1..24]of pchar=( + '.section .idata$2', + '.rva .L4', + '.long 0,0', + '.rva ', + '.rva .L5', + '.section .idata$4', + '.L4:', + '.rva .L6', + '.long 0', + '.section .idata$5', + '.L5:', + '.text', + '.globl ', + ':', + 'jmp *.L7', + '.balign 4,144', + '.section .idata$5', + '.L7:', + '.rva .L6', + '.long 0', + '.section .idata$6', + '.L6:', + '.short 0', + '.ascii "\000"' + ); + var_template:array[1..19]of pchar=( + '.section .idata$2', + '.rva .L7', + '.long 0,0', + '.rva ', + '.rva .L8', + '.section .idata$4', + '.L7:', + '.rva .L9', + '.long 0', + '.section .idata$5', + '.L8:', + '.globl ', + ':', + '.rva .L9', + '.long 0', + '.section .idata$6', + '.L9:', + '.short 0', + '.ascii "\000"' + ); + __template:array[longbool]of pointer=(@fn_template,@var_template); + common_part:array[1..5]of pchar=( + '.balign 2,0', + '.section .idata$7', + '.globl ', + ':', + '.ascii "\000"' + ); + posit:array[longbool,1..4]of longint=((4,13,14,24),(4,12,13,19)); + var + template:array[longbool]of pt absolute __template; + f:text; + s:string; + i:longint; + n:string; + common_name,asmout:string; + __d:dirstr; + __n:namestr; + __x:extstr; + begin + if not common_created then + begin + common_name:='_$'+_n+'@common'; + asmout:=path+dirsep+'0.sw'; + assign(f,asmout); + rewrite(f); + for i:=1 to 5 do + begin + s:=StrPas(Common_part[i]); + case i of + 3: + s:=s+common_name; + 4: + s:=common_name+s; + 5: + begin + fsplit(lname,__d,__n,__x); + insert(__n+__x,s,9); + end; + end; + writeln(f,s); + end; + close(f); + call_asw(asmout); + common_created:=true; + end; + n:=strpas(name); + str(succ(index):0,s); + asmout:=path+dirsep+s+'.sw'; + assign(f,asmout); + rewrite(f); + for i:=1 to posit[isData,4]do + begin + s:=StrPas(template[isData]^[i]); + if i=posit[isData,1]then + s:=s+common_name + else if i=posit[isData,2]then + s:=s+n + else if i=posit[isData,3]then + s:=n+s + else if i=posit[isData,4]then + insert(n,s,9); + writeln(f,s); + end; + close(f); + call_asw(asmout); + end; procedure ProcessEdata; + type + a8=array[0..7]of char; + function GetSectionName(rva:cardinal;var Flags:cardinal):a8; + var + i:cardinal; + LocObjOfs:cardinal; + LocObj:TObjInfo; + begin + GetSectionName:=''; + Flags:=0; + LocObjOfs:=APE_OptSize+PEoffset+24; + for i:=1 to APE_obj do + begin + seek(f,LocObjOfs); + blockread(f,LocObj,sizeof(LocObj)); + if(rva>=LocObj.VirtAddr)and(rva<=LocObj.VirtAddr+LocObj.RawSize)then + begin + GetSectionName:=a8(LocObj.ObjName); + Flags:=LocObj.flags; + end; + end; + end; var - j:cardinal; - ulongval:cardinal; + j,Fl:cardinal; + ulongval,procEntry:cardinal; + Ordinal:word; + isData:longbool; ExpDir:packed record flag, stamp:cardinal; @@ -109,28 +364,53 @@ procedure ProcessEdata; begin seek(f,RawOffset+delta); blockread(f,ExpDir,sizeof(ExpDir)); - seek(f,RawOffset-VirtAddr+ExpDir.Name); - blockread(f,cstring,sizeof(cstring)); + fsplit(impname,_d,_n,_e); + path:=_d+_n+'.ils'; +{$IFDEF STANDALONE} + if impname<>'' then +{$ENDIF} + CreateTempDir(path); + Common_created:=false; for j:=0 to pred(ExpDir.NumNames)do begin + seek(f,RawOffset-VirtAddr+ExpDir.AddrOrds+j*2); + blockread(f,Ordinal,2); + seek(f,RawOffset-VirtAddr+ExpDir.AddrFuncs+Cardinal(Ordinal*4)); + blockread(f,ProcEntry,4); seek(f,RawOffset-VirtAddr+ExpDir.AddrNames+j*4); blockread(f,ulongval,4); seek(f,RawOffset-VirtAddr+ulongval); blockread(f,cstring,sizeof(cstring)); +{$IFDEF STANDALONE} if not FileCreated then begin FileCreated:=true; - rewrite(t); - writeln(t,'EXPORTS'); + if(__textname<>'')or(impname='')then + begin + rewrite(t); + writeln(t,'EXPORTS'); + end; end; - { do not use the implicit '_' } - writeln(t,cstring,'=',cstring); +{$ENDIF} + isData:=GetSectionName(procentry,Fl)=''; + if not isData then + isData:=Fl and IMAGE_SCN_CNT_CODE<>IMAGE_SCN_CNT_CODE; +{$IFDEF STANDALONE} + if(__textname<>'')or(impname='')then + writeln(t,cstring,' @',succ(ordinal):0,' ',kind[isData]); + if impname<>''then +{$ENDIF} + makeasm(j,cstring,isData); end; + call_arw; end; end; + begin GetEdata:=false; +{$IFDEF STANDALONE} FileCreated:=false; +{$ENDIF} seek(f,PE+120); blockread(f,ExportRVA,4); seek(f,PE+6); @@ -154,17 +434,33 @@ begin end; -function makedef(const binname,textname:string):longbool; +function makedef(const binname, +{$IFDEF STANDALONE} + textname, +{$ENDIF} + libname:string):longbool; var OldFileMode:longint; begin - FileCreated:=false; assign(f,binname); +{$IFDEF STANDALONE} + FileCreated:=false; assign(t,textname); + __textname:=textname; +{$ENDIF} + impname:=libname; + lname:=binname; OldFileMode:=filemode; - filemode:=0; - reset(f,1); - filemode:=OldFileMode; + {$I-} + filemode:=0; + reset(f,1); + filemode:=OldFileMode; + {$I+} + if IOResult<>0 then + begin + makedef:=false; + exit; + end; if not DOSstubOK(PEoffset)then makedef:=false else if not IsPE(PEoffset)then @@ -172,15 +468,21 @@ begin else makedef:=GetEdata(PEoffset); close(f); +{$IFDEF STANDALONE} if FileCreated then - close(t); + if(textname<>'')or(impname='')then + close(t); +{$ENDIF} end; end. { $Log$ - Revision 1.4 2000-11-20 13:58:19 pierre + Revision 1.5 2001-01-13 00:09:21 peter + * made Pavel O. happy ;) + + Revision 1.4 2000/11/20 13:58:19 pierre * missing end. added Revision 1.3 2000/09/24 15:06:17 peter diff --git a/compiler/scandir.inc b/compiler/scandir.inc index e8607f2728..fd3c87391d 100644 --- a/compiler/scandir.inc +++ b/compiler/scandir.inc @@ -828,107 +828,60 @@ const Message(scan_e_resourcefiles_not_supported); end; -{$ifndef PAVEL_LINKLIB} + procedure dir_linklib(t:tdirectivetoken); + type + tLinkMode=(lm_shared,lm_static); var s : string; quote : char; + libname, + linkmodestr : string; + p : longint; + linkMode : tLinkMode; begin current_scanner^.skipspace; - { This way spaces are also allowed in library names - if quoted PM } - if (c='''') or (c='"') then - begin - quote:=c; - current_scanner^.readchar; - s:=current_scanner^.readcomment; - if pos(quote,s)>0 then - s:=copy(s,1,pos(quote,s)-1); - end - else - begin - current_scanner^.readstring; - s:=orgpattern; - if c='.' then - begin - s:=s+'.'; - current_scanner^.readchar; - current_scanner^.readstring; - s:=s+orgpattern; - end; - end; - current_module.linkOtherSharedLibs.add(s,link_allways); - end; -{$else PAVEL_LINKLIB} - procedure dir_linklib(t:tdirectivetoken); - var - s:string; - libname,linkmodeStr:string; - p:longint; - type - tLinkMode=(lm_dynamic,lm_static); - var - linkMode:tLinkMode; - function ExtractLinkMode:tLinkMode; - var - p:longint; - begin - p:=pos(',',linkmodeStr); - if p>0 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 + s:=current_scanner^.readcomment; + p:=pos(',',s); + if p=0 then begin - delete(libname,1,1); - delete(libname,length(libname),1); + libname:=TrimSpace(s); + linkmodeStr:=''; 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; + libname:=TrimSpace(copy(s,1,p-1)); + linkmodeStr:=Upper(TrimSpace(copy(s,p+1,255))); 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 - current_module.linkOtherStaticLibs.add(FixFileName(libname),link_allways) - else - current_module.linkOtherSharedLibs.add(FixFileName(libname),link_allways); + if (libname='') or (libname='''''') or (libname='""') then + exit; + { get linkmode, default is shared linking } + if linkModeStr='STATIC' then + linkmode:=lm_static + else if (LinkModeStr='SHARED') or (LinkModeStr='') then + linkmode:=lm_shared + else + begin + Comment(V_Error,'Wrong link mode specified: "'+Linkmodestr+'"'); + exit; + end; + { create library name } + if libname[1] in ['''','"'] then + begin + quote:=libname[1]; + Delete(libname,1,1); + p:=pos(quote,libname); + if p>0 then + Delete(libname,p,1); + end; + { add to the list of libraries to link } + if linkMode=lm_static then + current_module.linkOtherStaticLibs.add(FixFileName(libname),link_allways) + else + current_module.linkOtherSharedLibs.add(FixFileName(libname),link_allways); end; -{$endif PAVEL_LINKLIB} - - procedure dir_outputformat(t:tdirectivetoken); begin if not current_module.in_global then @@ -1437,7 +1390,10 @@ const { $Log$ - Revision 1.15 2000-12-25 00:07:28 peter + Revision 1.16 2001-01-13 00:09:21 peter + * made Pavel O. happy ;) + + Revision 1.15 2000/12/25 00:07:28 peter + new tlinkedlist class (merge of old tstringqueue,tcontainer and tlinkedlist objects) diff --git a/compiler/t_win32.pas b/compiler/t_win32.pas index 57c7ebde00..792eb5ec16 100644 --- a/compiler/t_win32.pas +++ b/compiler/t_win32.pas @@ -18,7 +18,6 @@ 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; @@ -66,17 +65,14 @@ interface implementation uses -{$ifdef PAVEL_LINKLIB} {$ifdef Delphi} - dmisc, + dmisc, {$else Delphi} - dos, + dos, {$endif Delphi} - impdef, -{$endif PAVEL_LINKLIB} cutils,cclasses, aasm,fmodule,globtype,globals,systems,verbose, - script,gendef, + script,gendef,impdef, cpubase,cpuasm {$ifdef GDB} ,gdb @@ -94,6 +90,34 @@ implementation 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 } + FoundDll:=FindFile(s,'.'+DirSep,found)+s; + if (not found) then + FoundDll:=includesearchpath.FindFile(s,found)+s; + if (not found) then + begin + sysdir:=FixPath(GetEnv('windir'),false); + FoundDll:=FindFile(s,sysdir+';'+sysdir+'system'+DirSep+';'+sysdir+'system32'+DirSep,found)+s; + end; + if (not found) then + begin + message1(exec_w_libfile_not_found,s); + FoundDll:=s; + end; + FindDll:=FoundDll; + end; + + {***************************************************************************** TIMPORTLIBWIN32 *****************************************************************************} @@ -648,17 +672,67 @@ begin end; end; -{$ifndef PAVEL_LINKLIB} + + Function TLinkerWin32.WriteResponseFile(isdll:boolean) : Boolean; + + function do_makedef(const DllName,LibName:string):boolean; + var + CmdLine : string; + begin + if (not do_build) and + FileExists(LibName) then + begin + if GetNamedFileTime(LibName)>GetNamedFileTime(DllName) then + begin + do_makedef:=true; + exit; + end; + end; + asw_name:=FindUtil('asw'); + arw_name:=FindUtil('arw'); + if cs_link_extern in aktglobalswitches then + begin + CmdLine:='-l '+LibName+' -i '+DLLName; + if asw_name<>'' then + CmdLine:=CmdLine+' -a '+asw_name; + if arw_name<>'' then + CmdLine:=CmdLine+' -r '+arw_name; + do_makedef:=DoExec(FindUtil('fpimpdef'),CmdLine,false,false); + end + else + do_makedef:=makedef(DLLName,LIbName); + end; + Var linkres : TLinkRes; i : longint; HPath : TStringListItem; - s,s2 : string; - found,linklibc : boolean; + 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); @@ -750,183 +824,6 @@ begin WriteResponseFile:=True; end; -{$else PAVEL_LINKLIB} -Function TLinkerWin32.WriteResponseFile(isdll:boolean) : Boolean; -Var - linkres : TLinkRes; - HPath : PStringQueueItem; - 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; @@ -1297,7 +1194,10 @@ end; end. { $Log$ - Revision 1.8 2000-12-30 22:53:25 peter + 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