mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-12 13:06:18 +02:00
* made Pavel O. happy ;)
This commit is contained in:
peter
parent
00a1168246
commit
a13360ee96
@ -1,6 +1,6 @@
|
|||||||
{
|
{
|
||||||
$Id$
|
$Id$
|
||||||
Copyright (c) 1998-2000 by Florian Klaempfl
|
Copyright (c) 1998-2000 by Pavel
|
||||||
|
|
||||||
This unit finds the export defs from PE files
|
This unit finds the export defs from PE files
|
||||||
|
|
||||||
@ -25,22 +25,53 @@
|
|||||||
}
|
}
|
||||||
unit impdef;
|
unit impdef;
|
||||||
|
|
||||||
{$i defines.inc}
|
{$ifndef STANDALONE}
|
||||||
|
{$i defines.inc}
|
||||||
|
{$endif}
|
||||||
|
|
||||||
interface
|
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
|
implementation
|
||||||
|
|
||||||
|
{$IFDEF STANDALONE}
|
||||||
|
var
|
||||||
|
__textname : string;
|
||||||
|
const
|
||||||
|
kind : array[longbool] of pchar=('',' DATA');
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
var
|
var
|
||||||
f:file;
|
f:file;
|
||||||
|
{$IFDEF STANDALONE}
|
||||||
t:text;
|
t:text;
|
||||||
|
FileCreated:longbool;
|
||||||
|
{$ENDIF}
|
||||||
|
lname:string;
|
||||||
|
impname:string;
|
||||||
TheWord:array[0..1]of char;
|
TheWord:array[0..1]of char;
|
||||||
PEoffset:cardinal;
|
PEoffset:cardinal;
|
||||||
loaded:longint;
|
loaded:{$ifdef fpc}longint{$else}integer{$endif};
|
||||||
FileCreated:longbool;
|
|
||||||
|
|
||||||
function DOSstubOK(var x:cardinal):longbool;
|
function DOSstubOK(var x:longint):longbool;
|
||||||
begin
|
begin
|
||||||
blockread(f,TheWord,2,loaded);
|
blockread(f,TheWord,2,loaded);
|
||||||
if loaded<>2 then
|
if loaded<>2 then
|
||||||
@ -55,16 +86,17 @@ begin
|
|||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
function isPE(x:cardinal):longbool;
|
|
||||||
|
function isPE(x:longint):longbool;
|
||||||
begin
|
begin
|
||||||
seek(f,x);
|
seek(f,x);
|
||||||
blockread(f,TheWord,2,loaded);
|
blockread(f,TheWord,2,loaded);
|
||||||
isPE:=(loaded=2)and(TheWord='PE');
|
isPE:=(loaded=2)and(TheWord='PE');
|
||||||
end;
|
end;
|
||||||
|
|
||||||
var
|
|
||||||
cstring:array[0..127]of char;
|
|
||||||
|
|
||||||
|
var
|
||||||
|
cstring : array[0..127]of char;
|
||||||
function GetEdata(PE:cardinal):longbool;
|
function GetEdata(PE:cardinal):longbool;
|
||||||
type
|
type
|
||||||
TObjInfo=packed record
|
TObjInfo=packed record
|
||||||
@ -86,11 +118,234 @@ var
|
|||||||
APE_obj,APE_Optsize:word;
|
APE_obj,APE_Optsize:word;
|
||||||
ExportRVA:cardinal;
|
ExportRVA:cardinal;
|
||||||
delta: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;
|
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
|
var
|
||||||
j:cardinal;
|
j,Fl:cardinal;
|
||||||
ulongval:cardinal;
|
ulongval,procEntry:cardinal;
|
||||||
|
Ordinal:word;
|
||||||
|
isData:longbool;
|
||||||
ExpDir:packed record
|
ExpDir:packed record
|
||||||
flag,
|
flag,
|
||||||
stamp:cardinal;
|
stamp:cardinal;
|
||||||
@ -109,28 +364,53 @@ procedure ProcessEdata;
|
|||||||
begin
|
begin
|
||||||
seek(f,RawOffset+delta);
|
seek(f,RawOffset+delta);
|
||||||
blockread(f,ExpDir,sizeof(ExpDir));
|
blockread(f,ExpDir,sizeof(ExpDir));
|
||||||
seek(f,RawOffset-VirtAddr+ExpDir.Name);
|
fsplit(impname,_d,_n,_e);
|
||||||
blockread(f,cstring,sizeof(cstring));
|
path:=_d+_n+'.ils';
|
||||||
|
{$IFDEF STANDALONE}
|
||||||
|
if impname<>'' then
|
||||||
|
{$ENDIF}
|
||||||
|
CreateTempDir(path);
|
||||||
|
Common_created:=false;
|
||||||
for j:=0 to pred(ExpDir.NumNames)do
|
for j:=0 to pred(ExpDir.NumNames)do
|
||||||
begin
|
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);
|
seek(f,RawOffset-VirtAddr+ExpDir.AddrNames+j*4);
|
||||||
blockread(f,ulongval,4);
|
blockread(f,ulongval,4);
|
||||||
seek(f,RawOffset-VirtAddr+ulongval);
|
seek(f,RawOffset-VirtAddr+ulongval);
|
||||||
blockread(f,cstring,sizeof(cstring));
|
blockread(f,cstring,sizeof(cstring));
|
||||||
|
{$IFDEF STANDALONE}
|
||||||
if not FileCreated then
|
if not FileCreated then
|
||||||
begin
|
begin
|
||||||
FileCreated:=true;
|
FileCreated:=true;
|
||||||
rewrite(t);
|
if(__textname<>'')or(impname='')then
|
||||||
writeln(t,'EXPORTS');
|
begin
|
||||||
|
rewrite(t);
|
||||||
|
writeln(t,'EXPORTS');
|
||||||
|
end;
|
||||||
end;
|
end;
|
||||||
{ do not use the implicit '_' }
|
{$ENDIF}
|
||||||
writeln(t,cstring,'=',cstring);
|
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;
|
end;
|
||||||
|
call_arw;
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
GetEdata:=false;
|
GetEdata:=false;
|
||||||
|
{$IFDEF STANDALONE}
|
||||||
FileCreated:=false;
|
FileCreated:=false;
|
||||||
|
{$ENDIF}
|
||||||
seek(f,PE+120);
|
seek(f,PE+120);
|
||||||
blockread(f,ExportRVA,4);
|
blockread(f,ExportRVA,4);
|
||||||
seek(f,PE+6);
|
seek(f,PE+6);
|
||||||
@ -154,17 +434,33 @@ begin
|
|||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
function makedef(const binname,textname:string):longbool;
|
function makedef(const binname,
|
||||||
|
{$IFDEF STANDALONE}
|
||||||
|
textname,
|
||||||
|
{$ENDIF}
|
||||||
|
libname:string):longbool;
|
||||||
var
|
var
|
||||||
OldFileMode:longint;
|
OldFileMode:longint;
|
||||||
begin
|
begin
|
||||||
FileCreated:=false;
|
|
||||||
assign(f,binname);
|
assign(f,binname);
|
||||||
|
{$IFDEF STANDALONE}
|
||||||
|
FileCreated:=false;
|
||||||
assign(t,textname);
|
assign(t,textname);
|
||||||
|
__textname:=textname;
|
||||||
|
{$ENDIF}
|
||||||
|
impname:=libname;
|
||||||
|
lname:=binname;
|
||||||
OldFileMode:=filemode;
|
OldFileMode:=filemode;
|
||||||
filemode:=0;
|
{$I-}
|
||||||
reset(f,1);
|
filemode:=0;
|
||||||
filemode:=OldFileMode;
|
reset(f,1);
|
||||||
|
filemode:=OldFileMode;
|
||||||
|
{$I+}
|
||||||
|
if IOResult<>0 then
|
||||||
|
begin
|
||||||
|
makedef:=false;
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
if not DOSstubOK(PEoffset)then
|
if not DOSstubOK(PEoffset)then
|
||||||
makedef:=false
|
makedef:=false
|
||||||
else if not IsPE(PEoffset)then
|
else if not IsPE(PEoffset)then
|
||||||
@ -172,15 +468,21 @@ begin
|
|||||||
else
|
else
|
||||||
makedef:=GetEdata(PEoffset);
|
makedef:=GetEdata(PEoffset);
|
||||||
close(f);
|
close(f);
|
||||||
|
{$IFDEF STANDALONE}
|
||||||
if FileCreated then
|
if FileCreated then
|
||||||
close(t);
|
if(textname<>'')or(impname='')then
|
||||||
|
close(t);
|
||||||
|
{$ENDIF}
|
||||||
end;
|
end;
|
||||||
|
|
||||||
end.
|
end.
|
||||||
|
|
||||||
{
|
{
|
||||||
$Log$
|
$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
|
* missing end. added
|
||||||
|
|
||||||
Revision 1.3 2000/09/24 15:06:17 peter
|
Revision 1.3 2000/09/24 15:06:17 peter
|
||||||
|
|||||||
@ -828,107 +828,60 @@ const
|
|||||||
Message(scan_e_resourcefiles_not_supported);
|
Message(scan_e_resourcefiles_not_supported);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
{$ifndef PAVEL_LINKLIB}
|
|
||||||
procedure dir_linklib(t:tdirectivetoken);
|
procedure dir_linklib(t:tdirectivetoken);
|
||||||
|
type
|
||||||
|
tLinkMode=(lm_shared,lm_static);
|
||||||
var
|
var
|
||||||
s : string;
|
s : string;
|
||||||
quote : char;
|
quote : char;
|
||||||
|
libname,
|
||||||
|
linkmodestr : string;
|
||||||
|
p : longint;
|
||||||
|
linkMode : tLinkMode;
|
||||||
begin
|
begin
|
||||||
current_scanner^.skipspace;
|
current_scanner^.skipspace;
|
||||||
{ This way spaces are also allowed in library names
|
s:=current_scanner^.readcomment;
|
||||||
if quoted PM }
|
p:=pos(',',s);
|
||||||
if (c='''') or (c='"') then
|
if p=0 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
|
|
||||||
begin
|
begin
|
||||||
delete(libname,1,1);
|
libname:=TrimSpace(s);
|
||||||
delete(libname,length(libname),1);
|
linkmodeStr:='';
|
||||||
end
|
end
|
||||||
else
|
else
|
||||||
begin
|
begin
|
||||||
libname:=target_os.libprefix+libname;
|
libname:=TrimSpace(copy(s,1,p-1));
|
||||||
case mode of
|
linkmodeStr:=Upper(TrimSpace(copy(s,p+1,255)));
|
||||||
lm_static:
|
|
||||||
libname:=AddExtension(FixFileName(libname),target_os.staticlibext);
|
|
||||||
lm_dynamic:
|
|
||||||
libname:=AddExtension(FixFileName(libname),target_os.sharedlibext);
|
|
||||||
end;
|
|
||||||
end;
|
end;
|
||||||
end;
|
if (libname='') or (libname='''''') or (libname='""') then
|
||||||
begin
|
exit;
|
||||||
current_scanner^.skipspace;
|
{ get linkmode, default is shared linking }
|
||||||
s:=current_scanner^.readcomment;
|
if linkModeStr='STATIC' then
|
||||||
p:=pos(',',s);
|
linkmode:=lm_static
|
||||||
if p=0 then
|
else if (LinkModeStr='SHARED') or (LinkModeStr='') then
|
||||||
begin
|
linkmode:=lm_shared
|
||||||
libname:=s;
|
else
|
||||||
linkmodeStr:=''
|
begin
|
||||||
end
|
Comment(V_Error,'Wrong link mode specified: "'+Linkmodestr+'"');
|
||||||
else
|
exit;
|
||||||
begin
|
end;
|
||||||
libname:=copy(s,1,pred(p));
|
{ create library name }
|
||||||
linkmodeStr:=copy(s,succ(p),255);
|
if libname[1] in ['''','"'] then
|
||||||
end;
|
begin
|
||||||
if(libname='')or(libname='''''')then
|
quote:=libname[1];
|
||||||
exit;
|
Delete(libname,1,1);
|
||||||
linkMode:=ExtractLinkMode;
|
p:=pos(quote,libname);
|
||||||
MangleLibName(linkMode);
|
if p>0 then
|
||||||
if linkMode=lm_static then
|
Delete(libname,p,1);
|
||||||
current_module.linkOtherStaticLibs.add(FixFileName(libname),link_allways)
|
end;
|
||||||
else
|
{ add to the list of libraries to link }
|
||||||
current_module.linkOtherSharedLibs.add(FixFileName(libname),link_allways);
|
if linkMode=lm_static then
|
||||||
|
current_module.linkOtherStaticLibs.add(FixFileName(libname),link_allways)
|
||||||
|
else
|
||||||
|
current_module.linkOtherSharedLibs.add(FixFileName(libname),link_allways);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
{$endif PAVEL_LINKLIB}
|
|
||||||
|
|
||||||
|
|
||||||
procedure dir_outputformat(t:tdirectivetoken);
|
procedure dir_outputformat(t:tdirectivetoken);
|
||||||
begin
|
begin
|
||||||
if not current_module.in_global then
|
if not current_module.in_global then
|
||||||
@ -1437,7 +1390,10 @@ const
|
|||||||
|
|
||||||
{
|
{
|
||||||
$Log$
|
$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
|
+ new tlinkedlist class (merge of old tstringqueue,tcontainer and
|
||||||
tlinkedlist objects)
|
tlinkedlist objects)
|
||||||
|
|
||||||
|
|||||||
@ -18,7 +18,6 @@
|
|||||||
You should have received a copy of the GNU General Public License
|
You should have received a copy of the GNU General Public License
|
||||||
along with this program; if not, write to the Free Software
|
along with this program; if not, write to the Free Software
|
||||||
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
|
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
|
||||||
|
|
||||||
****************************************************************************
|
****************************************************************************
|
||||||
}
|
}
|
||||||
unit t_win32;
|
unit t_win32;
|
||||||
@ -66,17 +65,14 @@ interface
|
|||||||
implementation
|
implementation
|
||||||
|
|
||||||
uses
|
uses
|
||||||
{$ifdef PAVEL_LINKLIB}
|
|
||||||
{$ifdef Delphi}
|
{$ifdef Delphi}
|
||||||
dmisc,
|
dmisc,
|
||||||
{$else Delphi}
|
{$else Delphi}
|
||||||
dos,
|
dos,
|
||||||
{$endif Delphi}
|
{$endif Delphi}
|
||||||
impdef,
|
|
||||||
{$endif PAVEL_LINKLIB}
|
|
||||||
cutils,cclasses,
|
cutils,cclasses,
|
||||||
aasm,fmodule,globtype,globals,systems,verbose,
|
aasm,fmodule,globtype,globals,systems,verbose,
|
||||||
script,gendef,
|
script,gendef,impdef,
|
||||||
cpubase,cpuasm
|
cpubase,cpuasm
|
||||||
{$ifdef GDB}
|
{$ifdef GDB}
|
||||||
,gdb
|
,gdb
|
||||||
@ -94,6 +90,34 @@ implementation
|
|||||||
end;
|
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
|
TIMPORTLIBWIN32
|
||||||
*****************************************************************************}
|
*****************************************************************************}
|
||||||
@ -648,17 +672,67 @@ begin
|
|||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
{$ifndef PAVEL_LINKLIB}
|
|
||||||
|
|
||||||
Function TLinkerWin32.WriteResponseFile(isdll:boolean) : Boolean;
|
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
|
Var
|
||||||
linkres : TLinkRes;
|
linkres : TLinkRes;
|
||||||
i : longint;
|
i : longint;
|
||||||
HPath : TStringListItem;
|
HPath : TStringListItem;
|
||||||
s,s2 : string;
|
s,s2 : string;
|
||||||
found,linklibc : boolean;
|
found,
|
||||||
|
linklibc : boolean;
|
||||||
begin
|
begin
|
||||||
WriteResponseFile:=False;
|
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 }
|
{ Open link.res file }
|
||||||
LinkRes.Init(outputexedir+Info.ResName);
|
LinkRes.Init(outputexedir+Info.ResName);
|
||||||
|
|
||||||
@ -750,183 +824,6 @@ begin
|
|||||||
|
|
||||||
WriteResponseFile:=True;
|
WriteResponseFile:=True;
|
||||||
end;
|
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;
|
function TLinkerWin32.MakeExecutable:boolean;
|
||||||
@ -1297,7 +1194,10 @@ end;
|
|||||||
end.
|
end.
|
||||||
{
|
{
|
||||||
$Log$
|
$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
|
* export with the case provided in the exports section
|
||||||
|
|
||||||
Revision 1.7 2000/12/25 00:07:30 peter
|
Revision 1.7 2000/12/25 00:07:30 peter
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user