paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-07 15:47:53 +02:00
Code Issues Packages Projects Releases Wiki Activity

* fix coff section names to fix resourcestrings with

Browse Source 
the external linker
  * create import libraries for dll imports, this uses
    the new objdata framework to generate the binary
    object files directly without needing an assembler pass
  * store import_dll and import_name in ppu
  * external linker uses import libraries
  * internal linker uses import info from symtables,
    no dlls are needed anymore

git-svn-id: trunk@3255 -
This commit is contained in:
peter 2006-04-17 20:48:22 +00:00
parent 97fcac35f3
commit ce58e15393
14 changed files with 564 additions and 671 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
compiler/finput.pas
View File

@ -146,6 +146,7 @@ interface
objfilename, { fullname of the objectfile }
newfilename, { fullname of the assemblerfile }
ppufilename, { fullname of the ppufile }
importlibfilename, { fullname of the import libraryfile }
staticlibfilename, { fullname of the static libraryfile }
sharedlibfilename, { fullname of the shared libraryfile }
mapfilename, { fullname of the mapfile }
@ -630,6 +631,7 @@ uses
stringdispose(objfilename);
stringdispose(newfilename);
stringdispose(ppufilename);
stringdispose(importlibfilename);
stringdispose(staticlibfilename);
stringdispose(sharedlibfilename);
stringdispose(mapfilename);
@ -677,13 +679,16 @@ uses
if OutputExtension <> '' then extension := OutputExtension;
end;
importlibfilename:=stringdup(p+target_info.staticClibprefix+'imp'+n+target_info.staticlibext);
staticlibfilename:=stringdup(p+target_info.staticlibprefix+n+target_info.staticlibext);
{ output dir of exe can be specified separatly }
if AllowOutput and (OutputExeDir<>'') then
p:=OutputExeDir
else
p:=path^;
sharedlibfilename:=stringdup(p+prefix+n+suffix+extension);
{ don't use extension alone to check, it can be empty !! }
if (OutputFile<>'') or (OutputExtension<>'') then
exefilename:=stringdup(p+n+OutputExtension)
@ -701,6 +706,7 @@ uses
ppufilename:=nil;
objfilename:=nil;
newfilename:=nil;
importlibfilename:=nil;
staticlibfilename:=nil;
sharedlibfilename:=nil;
exefilename:=nil;
@ -731,6 +737,7 @@ uses
stringdispose(objfilename);
stringdispose(newfilename);
stringdispose(ppufilename);
stringdispose(importlibfilename);
stringdispose(staticlibfilename);
stringdispose(sharedlibfilename);
stringdispose(exefilename);

1
compiler/fmodule.pas
View File

@ -519,6 +519,7 @@ implementation
stringdispose(objfilename);
stringdispose(newfilename);
stringdispose(ppufilename);
stringdispose(importlibfilename);
stringdispose(staticlibfilename);
stringdispose(sharedlibfilename);
stringdispose(exefilename);

2
compiler/globals.pas
View File

@ -2251,7 +2251,7 @@ end;
nwcopyright := '';
UseDeffileForExports:=false;
UseDeffileForExportsSetExplicitly:=false;
GenerateImportSection:=true;
GenerateImportSection:=false;
RelocSection:=false;
RelocSectionSetExplicitly:=false;
LinkTypeSetExplicitly:=false;

10
compiler/import.pas
View File

@ -64,15 +64,7 @@ type
end;
TDLLScanner=class
public
f:file;
impname:string;
TheWord:array[0..1]of char;
HeaderOffset:cardinal;
loaded:integer;
function isSuitableFileType(x:cardinal):longbool;virtual;abstract;
function GetEdata(HeaderEntry:cardinal):longbool;virtual;abstract;
function Scan(const binname:string):longbool;virtual;abstract;
function Scan(const binname:string):boolean;virtual;abstract;
end;
TImportLibClass=class of TImportLib;

68
compiler/link.pas
View File

@ -43,18 +43,19 @@ Type
end;
TLinker = class(TAbstractLinker)
private
procedure AddProcdefImports(p:tnamedindexitem;arg:pointer);
public
HasResources,
HasExports : boolean;
ObjectFiles,
DLLFiles,
SharedLibFiles,
StaticLibFiles : TStringList;
Constructor Create;virtual;
Destructor Destroy;override;
procedure AddModuleFiles(hp:tmodule);
procedure AddExternalSymbol(const libname,symname:string);virtual;
Procedure AddObject(const S,unitpath : String;isunit:boolean);
Procedure AddDLL(const S : String);
Procedure AddStaticLibrary(const S : String);
Procedure AddSharedLibrary(S : String);
Procedure AddStaticCLibrary(const S : String);
@ -79,6 +80,8 @@ Type
private
FCExeOutput : TExeOutputClass;
FCObjInput : TObjInputClass;
{ Libraries }
FExternalLibraryList : TFPHashObjectList;
procedure Load_ReadObject(const para:string);
procedure Load_ReadUnitObjects;
procedure ParseScript_Load;
@ -88,12 +91,14 @@ Type
protected
property CObjInput:TObjInputClass read FCObjInput write FCObjInput;
property CExeOutput:TExeOutputClass read FCExeOutput write FCExeOutput;
property ExternalLibraryList:TFPHashObjectList read FExternalLibraryList;
procedure DefaultLinkScript;virtual;abstract;
linkscript : TStringList;
public
Constructor Create;override;
Destructor Destroy;override;
Function MakeExecutable:boolean;override;
procedure AddExternalSymbol(const libname,symname:string);override;
end;
@ -119,6 +124,7 @@ uses
cutils,
script,globals,verbose,comphook,ppu,
aasmbase,aasmtai,aasmdata,aasmcpu,
symbase,symdef,symtype,symconst,
ogmap;
type
@ -281,7 +287,6 @@ Constructor TLinker.Create;
begin
Inherited Create;
ObjectFiles:=TStringList.Create_no_double;
DLLFiles:=TStringList.Create_no_double;
SharedLibFiles:=TStringList.Create_no_double;
StaticLibFiles:=TStringList.Create_no_double;
end;
@ -290,12 +295,21 @@ end;
Destructor TLinker.Destroy;
begin
ObjectFiles.Free;
DLLFiles.Free;
SharedLibFiles.Free;
StaticLibFiles.Free;
end;
procedure TLinker.AddProcdefImports(p:tnamedindexitem;arg:pointer);
begin
if tdef(p).deftype<>procdef then
exit;
if assigned(tprocdef(p).import_dll) and
assigned(tprocdef(p).import_name) then
AddExternalSymbol(tprocdef(p).import_dll^,tprocdef(p).import_name^);
end;
procedure TLinker.AddModuleFiles(hp:tmodule);
var
mask : longint;
@ -378,25 +392,26 @@ begin
AddStaticCLibrary(linkotherstaticlibs.Getusemask(mask));
while not linkothersharedlibs.empty do
AddSharedCLibrary(linkothersharedlibs.Getusemask(mask));
{ (Windows) DLLs }
while not linkdlls.empty do
AddDLL(linkdlls.Getusemask(mask));
{ Known Library/DLL Imports }
if assigned(globalsymtable) then
globalsymtable.defindex.foreach(@AddProcdefImports,nil);
if assigned(localsymtable) then
localsymtable.defindex.foreach(@AddProcdefImports,nil);
end;
end;
procedure TLinker.AddExternalSymbol(const libname,symname:string);
begin
end;
Procedure TLinker.AddObject(const S,unitpath : String;isunit:boolean);
begin
ObjectFiles.Concat(FindObjectFile(s,unitpath,isunit));
end;
Procedure TLinker.AddDLL(const S : String);
begin
DLLFiles.Concat(s);
end;
Procedure TLinker.AddSharedLibrary(S:String);
begin
if s='' then
@ -714,6 +729,7 @@ end;
begin
inherited Create;
linkscript:=TStringList.Create;
FExternalLibraryList:=TFPHashObjectList.Create(true);
exemap:=nil;
exeoutput:=nil;
CObjInput:=TObjInput;
@ -723,6 +739,7 @@ end;
Destructor TInternalLinker.Destroy;
begin
linkscript.free;
ExternalLibraryList.Free;
if assigned(exeoutput) then
begin
exeoutput.free;
@ -737,6 +754,20 @@ end;
end;
procedure TInternalLinker.AddExternalSymbol(const libname,symname:string);
var
ExtLibrary : TExternalLibrary;
ExtSymbol : TFPHashObject;
begin
ExtLibrary:=TExternalLibrary(ExternalLibraryList.Find(libname));
if not assigned(ExtLibrary) then
ExtLibrary:=TExternalLibrary.Create(ExternalLibraryList,libname);
ExtSymbol:=TFPHashObject(ExtLibrary.ExternalSymbolList.Find(symname));
if not assigned(ExtSymbol) then
ExtSymbol:=TFPHashObject.Create(ExtLibrary.ExternalSymbolList,symname);
end;
procedure TInternalLinker.Load_ReadObject(const para:string);
var
objdata : TObjData;
@ -897,15 +928,8 @@ end;
{ Load .o files and resolve symbols }
ParseScript_Load;
exeoutput.ResolveSymbols;
{ DLL Linking }
While not DLLFiles.Empty do
begin
s:=DLLFiles.GetFirst;
if FindDLL(s,s2) then
exeoutput.ResolveExternals(s2)
else
Comment(V_Error,'DLL not found: '+s);
end;
{ Generate symbols and code to do the importing }
exeoutput.GenerateLibraryImports(ExternalLibraryList);
{ Fill external symbols data }
exeoutput.FixupSymbols;
if ErrorCount>0 then

45
compiler/ogbase.pas
View File

@ -314,6 +314,15 @@ interface
end;
TExeSectionClass=class of TExeSection;
TExternalLibrary = class(TFPHashObject)
private
FExternalSymbolList : TFPHashObjectList;
public
constructor create(AList:TFPHashObjectList;const AName:string);virtual;
destructor destroy;override;
property ExternalSymbolList:TFPHashObjectList read FExternalSymbolList;
end;
TExeOutput = class
private
{ ExeSections }
@ -349,8 +358,8 @@ interface
public
constructor create;virtual;
destructor destroy;override;
procedure AddObjData(ObjData:TObjData);
function FindExeSection(const aname:string):TExeSection;
procedure AddObjData(ObjData:TObjData);
procedure Load_Start;virtual;
procedure Load_EntryName(const aname:string);virtual;
procedure Load_Symbol(const aname:string);virtual;
@ -375,7 +384,7 @@ interface
procedure MergeStabs;
procedure RemoveUnreferencedSections;
procedure RemoveEmptySections;
procedure ResolveExternals(const libname:string);virtual;
procedure GenerateLibraryImports(ExternalLibraryList:TFPHashObjectList);virtual;
function writeexefile(const fn:string):boolean;
property Writer:TObjectWriter read FWriter;
property ExeSections:TFPHashObjectList read FExeSectionList;
@ -1200,6 +1209,24 @@ implementation
end;
{****************************************************************************
TExternalLibrary
****************************************************************************}
constructor TExternalLibrary.create(AList:TFPHashObjectList;const AName:string);
begin
inherited create(AList,AName);
FExternalSymbolList:=TFPHashObjectList.Create(false);
end;
destructor TExternalLibrary.destroy;
begin
ExternalSymbolList.Free;
inherited destroy;
end;
{****************************************************************************
TExeOutput
****************************************************************************}
@ -1259,6 +1286,12 @@ implementation
end;
function TExeOutput.FindExeSection(const aname:string):TExeSection;
begin
result:=TExeSection(FExeSectionList.Find(aname));
end;
procedure TExeOutput.AddObjData(ObjData:TObjData);
begin
if ObjData.classtype<>FCObjData then
@ -1267,12 +1300,6 @@ implementation
end;
function TExeOutput.FindExeSection(const aname:string):TExeSection;
begin
result:=TExeSection(FExeSectionList.Find(aname));
end;
procedure TExeOutput.Load_Start;
begin
ObjDataList.Clear;
@ -1665,7 +1692,7 @@ implementation
end;
procedure TExeOutput.ResolveExternals(const libname:string);
procedure TExeOutput.GenerateLibraryImports(ExternalLibraryList:TFPHashObjectList);
begin
end;

317
compiler/ogcoff.pas
View File

@ -184,8 +184,7 @@ interface
idatalabnr : longint;
public
constructor create;override;
function LoadDLL(const dllname:string):boolean;
procedure ResolveExternals(const libname:string);override;
procedure GenerateLibraryImports(ExternalLibraryList:TFPHashObjectList);override;
end;
TObjSymbolrec = record
@ -214,6 +213,11 @@ interface
end;
type
Treaddllproc = procedure(const dllname,funcname:string);
function ReadDLLImports(const dllname:string;readdllproc:Treaddllproc):boolean;
implementation
uses
@ -865,7 +869,7 @@ const win32stub : array[0..131] of byte=(
secname:=coffsecnames[atype];
if use_smartlink_section and
(aname<>'') then
result:=secname+'$'+aname
result:=secname+'.'+aname
else
result:=secname;
end;
@ -1204,6 +1208,8 @@ const win32stub : array[0..131] of byte=(
for i:=0 to ObjSymbolList.Count-1 do
begin
objsym:=TObjSymbol(ObjSymbolList[i]);
if (objsym.typ=AT_LABEL) and (objsym.bind=AB_LOCAL) then
continue;
case objsym.bind of
AB_GLOBAL :
begin
@ -2132,42 +2138,9 @@ const win32stub : array[0..131] of byte=(
CObjData:=TPECoffObjData;
end;
{$ifdef win32}
var
Wow64DisableWow64FsRedirection : function (var OldValue : pointer) : boolean;stdcall;
Wow64RevertWow64FsRedirection : function (OldValue : pointer) : boolean;stdcall;
{$endif win32}
function TPECoffexeoutput.LoadDLL(const dllname:string):boolean;
type
TPECoffExpDir=packed record
flag,
stamp : cardinal;
Major,
Minor : word;
Name,
Base,
NumFuncs,
NumNames,
AddrFuncs,
AddrNames,
AddrOrds : cardinal;
end;
procedure TPECoffexeoutput.GenerateLibraryImports(ExternalLibraryList:TFPHashObjectList);
var
basedllname : string;
DLLReader : TObjectReader;
DosHeader : array[0..$7f] of byte;
PEMagic : array[0..3] of byte;
Header : CoffHeader;
peheader : coffpeoptheader;
NameOfs,
newheaderofs : longint;
expdir : TPECoffExpDir;
i,j : longint;
found : boolean;
sechdr : CoffSecHdr;
FuncName : string;
exesym : TExeSymbol;
textobjsection,
idata2objsection,
idata4objsection,
@ -2175,12 +2148,13 @@ const win32stub : array[0..131] of byte=(
idata6objsection,
idata7objsection : TObjSection;
procedure StartImport;
procedure StartImport(const dllname:string);
var
idata4label,
idata5label,
idata7label : TObjSymbol;
emptyint : longint;
emptyint : longint;
basedllname : string;
begin
if assigned(exemap) then
begin
@ -2188,6 +2162,7 @@ const win32stub : array[0..131] of byte=(
exemap.Add('Importing from DLL '+dllname);
end;
emptyint:=0;
basedllname:=splitfilename(dllname);
textobjsection:=internalobjdata.createsection(sec_code,'');
idata2objsection:=internalobjdata.createsection(sec_idata2,'');
idata4objsection:=internalobjdata.createsection(sec_idata4,'');
@ -2248,8 +2223,6 @@ const win32stub : array[0..131] of byte=(
begin
result:=nil;
emptyint:=0;
if not assigned(idata2objsection) then
StartImport;
if assigned(exemap) then
exemap.Add(' Importing Function '+afuncname);
{ idata6, import data (ordnr+name) }
@ -2279,133 +2252,31 @@ const win32stub : array[0..131] of byte=(
internalobjdata.writebytes(nopopcodes,align(internalobjdata.CurrObjSec.size,sizeof(nopopcodes))-internalobjdata.CurrObjSec.size);
end;
{$ifdef win32}
var
p : pointer;
{$endif win32}
i,j : longint;
ExtLibrary : TExternalLibrary;
ExtSymbol : TFPHashObject;
exesym : TExeSymbol;
begin
result:=false;
basedllname:=splitfilename(dllname);
{$ifdef win32}
if (target_info.system=system_x86_64_win64) and
assigned(Wow64DisableWow64FsRedirection) then
Wow64DisableWow64FsRedirection(p);
{$endif win32}
DLLReader:=TObjectReader.Create;
DLLReader.OpenFile(dllname);
{$ifdef win32}
if (target_info.system=system_x86_64_win64) and
assigned(Wow64RevertWow64FsRedirection) then
Wow64RevertWow64FsRedirection(p);
{$endif win32}
if not DLLReader.Read(DosHeader,sizeof(DosHeader)) or
(DosHeader[0]<>$4d) or (DosHeader[1]<>$5a) then
for i:=0 to ExternalLibraryList.Count-1 do
begin
Comment(V_Error,'Invalid DLL '+dllname+', Dos Header invalid');
exit;
end;
newheaderofs:=longint(DosHeader[$3c]) or (DosHeader[$3d] shl 8) or (DosHeader[$3e] shl 16) or (DosHeader[$3f] shl 24);
DLLReader.Seek(newheaderofs);
if not DLLReader.Read(PEMagic,sizeof(PEMagic)) or
(PEMagic[0]<>$50) or (PEMagic[1]<>$45) or (PEMagic[2]<>$00) or (PEMagic[3]<>$00) then
begin
Comment(V_Error,'Invalid DLL '+dllname+': invalid magic code');
exit;
end;
if not DLLReader.Read(Header,sizeof(CoffHeader)) or
(Header.mach<>COFF_MAGIC) or
(Header.opthdr<>sizeof(coffpeoptheader)) then
begin
Comment(V_Error,'Invalid DLL '+dllname+', invalid header size');
exit;
end;
{ Read optheader }
DLLreader.Read(peheader,sizeof(coffpeoptheader));
{ Section headers }
found:=false;
for i:=1 to header.nsects do
begin
if not DLLreader.read(sechdr,sizeof(sechdr)) then
ExtLibrary:=TExternalLibrary(ExternalLibraryList[i]);
idata2objsection:=nil;
idata4objsection:=nil;
idata5objsection:=nil;
idata6objsection:=nil;
idata7objsection:=nil;
StartImport(ExtLibrary.Name);
for j:=0 to ExtLibrary.ExternalSymbolList.Count-1 do
begin
Comment(V_Error,'Error reading coff file '+DLLName);
exit;
end;
if (sechdr.rvaofs<=peheader.DataDirectory[PE_DATADIR_EDATA].vaddr) and
(peheader.DataDirectory[PE_DATADIR_EDATA].vaddr<sechdr.rvaofs+sechdr.vsize) then
begin
found:=true;
break;
end;
end;
if not found then
begin
Comment(V_Warning,'DLL '+DLLName+' does not contain any exports');
exit;
end;
{ Process edata }
idata2objsection:=nil;
idata4objsection:=nil;
idata5objsection:=nil;
idata6objsection:=nil;
idata7objsection:=nil;
DLLReader.Seek(sechdr.datapos+peheader.DataDirectory[PE_DATADIR_EDATA].vaddr-sechdr.rvaofs);
DLLReader.Read(expdir,sizeof(expdir));
for i:=0 to expdir.NumNames-1 do
begin
DLLReader.Seek(sechdr.datapos+expdir.AddrNames-sechdr.rvaofs+i*4);
DLLReader.Read(NameOfs,4);
Dec(NameOfs,sechdr.rvaofs);
if (NameOfs<0) or
(NameOfs>sechdr.vsize) then
begin
Comment(V_Error,'DLL does contains invalid exports');
break;
end;
{ Read Function name from DLL, prepend _ and terminate with #0 }
DLLReader.Seek(sechdr.datapos+NameOfs);
{ target which requires the _ prepention? }
if target_info.system in [system_i386_win32] then
begin
DLLReader.Read(FuncName[2],sizeof(FuncName)-3);
{ Add underscore to be compatible with ld.exe importing }
FuncName[1]:='_';
FuncName[sizeof(FuncName)-1]:=#0;
end
else
begin
DLLReader.Read(FuncName[1],sizeof(FuncName)-3);
FuncName[sizeof(FuncName)-1]:=#0;
end;
FuncName[0]:=chr(Strlen(@FuncName[1]));
for j:=0 to UnresolvedExeSymbols.Count-1 do
begin
exesym:=TExeSymbol(UnresolvedExeSymbols[j]);
ExtSymbol:=TFPHashObject(ExtLibrary.ExternalSymbolList[j]);
exesym:=TExeSymbol(ExeSymbolList.Find(ExtSymbol.Name));
if assigned(exesym) and
not assigned(exesym.objsymbol) and
(exesym.name=FuncName) then
begin
{ Remove underscore }
if target_info.system in [system_i386_win32] then
Delete(FuncName,1,1);
exesym.objsymbol:=AddProcImport(FuncName);
UnresolvedExeSymbols[j]:=nil;
break;
end;
not assigned(exesym.objsymbol) then
exesym.objsymbol:=AddProcImport(ExtSymbol.Name);
end;
EndImport;
end;
UnresolvedExeSymbols.Pack;
if assigned(idata2objsection) then
EndImport;
DLLReader.Free;
end;
procedure TPECoffexeoutput.ResolveExternals(const libname:string);
begin
LoadDLL(libname);
end;
@ -2505,6 +2376,130 @@ const win32stub : array[0..131] of byte=(
end;
{*****************************************************************************
DLLReader
*****************************************************************************}
{$ifdef win32}
var
Wow64DisableWow64FsRedirection : function (var OldValue : pointer) : boolean;stdcall;
Wow64RevertWow64FsRedirection : function (OldValue : pointer) : boolean;stdcall;
{$endif win32}
function ReadDLLImports(const dllname:string;readdllproc:Treaddllproc):boolean;
type
TPECoffExpDir=packed record
flag,
stamp : cardinal;
Major,
Minor : word;
Name,
Base,
NumFuncs,
NumNames,
AddrFuncs,
AddrNames,
AddrOrds : cardinal;
end;
var
DLLReader : TObjectReader;
DosHeader : array[0..$7f] of byte;
PEMagic : array[0..3] of byte;
Header : CoffHeader;
peheader : coffpeoptheader;
NameOfs,
newheaderofs : longint;
FuncName : string;
expdir : TPECoffExpDir;
i : longint;
found : boolean;
sechdr : CoffSecHdr;
{$ifdef win32}
p : pointer;
{$endif win32}
begin
result:=false;
{$ifdef win32}
if (target_info.system=system_x86_64_win64) and
assigned(Wow64DisableWow64FsRedirection) then
Wow64DisableWow64FsRedirection(p);
{$endif win32}
DLLReader:=TObjectReader.Create;
DLLReader.OpenFile(dllname);
{$ifdef win32}
if (target_info.system=system_x86_64_win64) and
assigned(Wow64RevertWow64FsRedirection) then
Wow64RevertWow64FsRedirection(p);
{$endif win32}
if not DLLReader.Read(DosHeader,sizeof(DosHeader)) or
(DosHeader[0]<>$4d) or (DosHeader[1]<>$5a) then
begin
Comment(V_Error,'Invalid DLL '+dllname+', Dos Header invalid');
exit;
end;
newheaderofs:=longint(DosHeader[$3c]) or (DosHeader[$3d] shl 8) or (DosHeader[$3e] shl 16) or (DosHeader[$3f] shl 24);
DLLReader.Seek(newheaderofs);
if not DLLReader.Read(PEMagic,sizeof(PEMagic)) or
(PEMagic[0]<>$50) or (PEMagic[1]<>$45) or (PEMagic[2]<>$00) or (PEMagic[3]<>$00) then
begin
Comment(V_Error,'Invalid DLL '+dllname+': invalid magic code');
exit;
end;
if not DLLReader.Read(Header,sizeof(CoffHeader)) or
(Header.mach<>COFF_MAGIC) or
(Header.opthdr<>sizeof(coffpeoptheader)) then
begin
Comment(V_Error,'Invalid DLL '+dllname+', invalid header size');
exit;
end;
{ Read optheader }
DLLreader.Read(peheader,sizeof(coffpeoptheader));
{ Section headers }
found:=false;
for i:=1 to header.nsects do
begin
if not DLLreader.read(sechdr,sizeof(sechdr)) then
begin
Comment(V_Error,'Error reading coff file '+DLLName);
exit;
end;
if (sechdr.rvaofs<=peheader.DataDirectory[PE_DATADIR_EDATA].vaddr) and
(peheader.DataDirectory[PE_DATADIR_EDATA].vaddr<sechdr.rvaofs+sechdr.vsize) then
begin
found:=true;
break;
end;
end;
if not found then
begin
Comment(V_Warning,'DLL '+DLLName+' does not contain any exports');
exit;
end;
{ Process edata }
DLLReader.Seek(sechdr.datapos+peheader.DataDirectory[PE_DATADIR_EDATA].vaddr-sechdr.rvaofs);
DLLReader.Read(expdir,sizeof(expdir));
for i:=0 to expdir.NumNames-1 do
begin
DLLReader.Seek(sechdr.datapos+expdir.AddrNames-sechdr.rvaofs+i*4);
DLLReader.Read(NameOfs,4);
Dec(NameOfs,sechdr.rvaofs);
if (NameOfs<0) or
(NameOfs>sechdr.vsize) then
begin
Comment(V_Error,'DLL does contains invalid exports');
break;
end;
{ Read Function name from DLL, prepend _ and terminate with #0 }
DLLReader.Seek(sechdr.datapos+NameOfs);
DLLReader.Read(FuncName[1],sizeof(FuncName)-3);
FuncName[sizeof(FuncName)-1]:=#0;
FuncName[0]:=chr(Strlen(@FuncName[1]));
readdllproc(DLLName,FuncName);
end;
DLLReader.Free;
end;
{*****************************************************************************
Initialize
*****************************************************************************}

10
compiler/pdecsub.pas
View File

@ -1460,10 +1460,12 @@ begin
if not(token=_SEMICOLON) and not(idtoken=_NAME) then
begin
import_dll:=stringdup(get_stringconst);
include(procoptions,po_has_importdll);
if (idtoken=_NAME) then
begin
consume(_NAME);
import_name:=stringdup(get_stringconst);
include(procoptions,po_has_importname);
if import_name^='' then
message(parser_e_empty_import_name);
end;
@ -1483,6 +1485,7 @@ begin
begin
consume(_NAME);
import_name:=stringdup(get_stringconst);
include(procoptions,po_has_importname);
if import_name^='' then
message(parser_e_empty_import_name);
end;
@ -2040,13 +2043,6 @@ const
same DLL function. This is also needed for compatability
with Delphi and TP7 }
case target_info.system of
system_i386_win32 :
begin
{ We need to use the name with a _ prefix if we let ld.exe do
the importing for us }
if not GenerateImportSection then
result:=target_info.Cprefix+pd.import_name^;
end;
system_i386_wdosx,
system_i386_emx,system_i386_os2,
system_arm_wince,system_i386_wince :

2
compiler/ppu.pas
View File

@ -43,7 +43,7 @@ type
{$endif Test_Double_checksum}
const
CurrentPPUVersion=56;
CurrentPPUVersion=57;
{ buffer sizes }
maxentrysize = 1024;

12
compiler/psub.pas
View File

@ -1495,16 +1495,8 @@ implementation
(pd.hasforward) and
not(
assigned(pd.import_dll) and
(
(
GenerateImportSection and
(target_info.system in [system_i386_win32])
) or
(
target_info.system in [system_i386_wdosx,system_i386_emx,system_i386_os2,
system_arm_wince,system_i386_wince]
)
)
(target_info.system in [system_i386_wdosx,system_i386_emx,system_i386_os2,
system_arm_wince,system_i386_wince])
) then
begin
s:=proc_get_importname(pd);

5
compiler/symconst.pas
View File

@ -263,7 +263,10 @@ type
{ Procedure can be inlined }
po_inline,
{ Procedure is used for internal compiler calls }
po_compilerproc
po_compilerproc,
{ importing }
po_has_importdll,
po_has_importname
);
tprocoptions=set of tprocoption;

18
compiler/symdef.pas
View File

@ -3175,9 +3175,15 @@ implementation
ppufile.getderef(libsymderef);
{$endif powerpc}
{ import stuff }
import_dll:=nil;
import_name:=nil;
import_nr:=0;
if po_has_importdll in procoptions then
import_dll:=stringdup(ppufile.getstring)
else
import_dll:=nil;
if po_has_importname in procoptions then
import_name:=stringdup(ppufile.getstring)
else
import_name:=nil;
import_nr:=ppufile.getword;
{ inline stuff }
if (po_has_inlininginfo in procoptions) then
begin
@ -3303,6 +3309,12 @@ implementation
{ library symbol for AmigaOS/MorphOS }
ppufile.putderef(libsymderef);
{$endif powerpc}
{ import }
if po_has_importdll in procoptions then
ppufile.putstring(import_dll^);
if po_has_importname in procoptions then
ppufile.putstring(import_name^);
ppufile.putword(import_nr);
{ inline stuff }
oldintfcrc:=ppufile.do_crc;
ppufile.do_crc:=false;

719
compiler/systems/t_win.pas
View File

@ -31,7 +31,7 @@ interface
symconst,symdef,symsym,
script,gendef,
cpubase,
import,export,link,cgobj,i_win,ogcoff;
import,export,link,cgobj,i_win;
const
@ -50,13 +50,13 @@ interface
procedure win32importproc(aprocdef:tprocdef;const func,module : string;index : longint;const name : string);
procedure importvariable_str(const s:string;const name,module:string);
procedure importprocedure_str(const func,module:string;index:longint;const name:string);
procedure generateimportlib;
procedure generateidatasection;
public
procedure preparelib(const s:string);override;
procedure importprocedure(aprocdef:tprocdef;const module:string;index:longint;const name:string);override;
procedure importvariable(vs:tglobalvarsym;const name,module:string);override;
procedure generatelib;override;
procedure generatenasmlib;virtual;
procedure generatesmartlib;override;
end;
texportlibwin32=class(texportlib)
@ -83,20 +83,15 @@ interface
end;
tDLLScannerWin32=class(tDLLScanner)
private
cstring : array[0..127]of char;
function DOSstubOK(var x:cardinal):boolean;
function ExtractDllName(Const Name : string) : string;
public
function isSuitableFileType(x:cardinal):longbool;override;
function GetEdata(HeaderEntry:cardinal):longbool;override;
function Scan(const binname:string):longbool;override;
function Scan(const binname:string):boolean;override;
end;
implementation
uses
cpuinfo,cgutils,dbgbase;
cpuinfo,cgutils,dbgbase,
owar,ogbase,ogcoff;
const
@ -131,15 +126,6 @@ implementation
hp2 : twin32imported_item;
hs : string;
begin
{ If we don't generate imports then we need to only the dll for
the linker }
if not GenerateImportSection then
begin
hs:=AddExtension(module,target_info.sharedlibext);
current_module.linkdlls.add(hs,link_always);
exit;
end;
{ procdef or funcname must be give, not both }
if assigned(aprocdef) and (func<>'') then
internalerror(200411161);
@ -213,15 +199,6 @@ implementation
hp2 : twin32imported_item;
hs : string;
begin
{ If we don't generate imports then we need to only the dll for
the linker }
if not GenerateImportSection then
begin
hs:=AddExtension(module,target_info.sharedlibext);
current_module.linkdlls.add(hs,link_always);
exit;
end;
hs:=AddExtension(module,target_info.sharedlibext);
{ search for the module }
hp1:=timportlist(current_module.imports.first);
@ -243,193 +220,219 @@ implementation
end;
procedure timportlibwin32.generatenasmlib;
procedure timportlibwin32.generateimportlib;
var
ObjWriter : tarobjectwriter;
ObjOutput : TPECoffObjOutput;
basedllname : string;
AsmPrefix : string;
idatalabnr,
SmartFilesCount,
SmartHeaderCount : longint;
function CreateObjData(place:tcutplace):TObjData;
var
s : string;
begin
s:='';
case place of
cut_begin :
begin
inc(SmartHeaderCount);
s:=asmprefix+tostr(SmartHeaderCount)+'h';
end;
cut_normal :
s:=asmprefix+tostr(SmartHeaderCount)+'s';
cut_end :
s:=asmprefix+tostr(SmartHeaderCount)+'t';
end;
inc(SmartFilesCount);
result:=ObjOutput.NewObjData(FixFileName(s+tostr(SmartFilesCount)+target_info.objext));
ObjOutput.startobjectfile(Result.Name);
end;
procedure WriteObjData(objdata:TObjData);
begin
ObjOutput.writeobjectfile(ObjData);
end;
procedure StartImport(const dllname:string);
var
headlabel,
idata4label,
idata5label,
idata7label : TObjSymbol;
emptyint : longint;
objdata : TObjData;
idata2objsection,
idata4objsection,
idata5objsection : TObjSection;
begin
objdata:=CreateObjData(cut_begin);
idata2objsection:=objdata.createsection(sec_idata2,'');
idata4objsection:=objdata.createsection(sec_idata4,'');
idata5objsection:=objdata.createsection(sec_idata5,'');
emptyint:=0;
basedllname:=splitfilename(dllname);
{ idata4 }
objdata.SetSection(idata4objsection);
idata4label:=objdata.SymbolDefine(asmprefix+'_names_'+basedllname,AB_GLOBAL,AT_DATA);
{ idata5 }
objdata.SetSection(idata5objsection);
idata5label:=objdata.SymbolDefine(asmprefix+'_fixup_'+basedllname,AB_GLOBAL,AT_DATA);
{ idata2 }
objdata.SetSection(idata2objsection);
headlabel:=objdata.SymbolDefine(asmprefix+'_head_'+basedllname,AB_GLOBAL,AT_DATA);
ObjOutput.exportsymbol(headlabel);
objdata.writereloc(0,sizeof(longint),idata4label,RELOC_RVA);
objdata.writebytes(emptyint,sizeof(emptyint));
objdata.writebytes(emptyint,sizeof(emptyint));
idata7label:=objdata.SymbolRef(asmprefix+'_dll_'+basedllname);
objdata.writereloc(0,sizeof(longint),idata7label,RELOC_RVA);
objdata.writereloc(0,sizeof(longint),idata5label,RELOC_RVA);
WriteObjData(objdata);
objdata.free;
end;
procedure EndImport;
var
idata7label : TObjSymbol;
emptyint : longint;
objdata : TObjData;
idata4objsection,
idata5objsection,
idata7objsection : TObjSection;
begin
objdata:=CreateObjData(cut_end);
idata4objsection:=objdata.createsection(sec_idata4,'');
idata5objsection:=objdata.createsection(sec_idata5,'');
idata7objsection:=objdata.createsection(sec_idata7,'');
emptyint:=0;
{ idata4 }
objdata.SetSection(idata4objsection);
objdata.writebytes(emptyint,sizeof(emptyint));
if target_info.system=system_x86_64_win64 then
objdata.writebytes(emptyint,sizeof(emptyint));
{ idata5 }
objdata.SetSection(idata5objsection);
objdata.writebytes(emptyint,sizeof(emptyint));
if target_info.system=system_x86_64_win64 then
objdata.writebytes(emptyint,sizeof(emptyint));
{ idata7 }
objdata.SetSection(idata7objsection);
idata7label:=objdata.SymbolDefine(asmprefix+'_dll_'+basedllname,AB_GLOBAL,AT_DATA);
objoutput.exportsymbol(idata7label);
objdata.writebytes(basedllname[1],length(basedllname));
objdata.writebytes(emptyint,1);
WriteObjData(objdata);
objdata.free;
end;
procedure AddImport(const afuncname:string;ordnr:word;isvar:boolean);
const
{$ifdef x86_64}
jmpopcode : array[0..2] of byte = (
$ff,$24,$25
);
{$else x86_64}
jmpopcode : array[0..1] of byte = (
$ff,$25
);
{$endif x86_64}
nopopcodes : array[0..1] of byte = (
$90,$90
);
var
implabel,
idata2label,
idata5label,
idata6label : TObjSymbol;
emptyint : longint;
objdata : TObjData;
textobjsection,
idata4objsection,
idata5objsection,
idata6objsection,
idata7objsection : TObjSection;
begin
objdata:=CreateObjData(cut_normal);
if not isvar then
textobjsection:=objdata.createsection(sec_code,'');
idata4objsection:=objdata.createsection(sec_idata4,'');
idata5objsection:=objdata.createsection(sec_idata5,'');
idata6objsection:=objdata.createsection(sec_idata6,'');
idata7objsection:=objdata.createsection(sec_idata7,'');
emptyint:=0;
{ idata7, link to head }
objdata.SetSection(idata7objsection);
idata2label:=objdata.SymbolRef(asmprefix+'_head_'+basedllname);
objdata.writereloc(0,sizeof(longint),idata2label,RELOC_RVA);
{ idata6, import data (ordnr+name) }
objdata.SetSection(idata6objsection);
inc(idatalabnr);
idata6label:=objdata.SymbolDefine(asmprefix+'_'+tostr(idatalabnr),AB_LOCAL,AT_DATA);
objdata.writebytes(ordnr,2);
objdata.writebytes(afuncname[1],length(afuncname));
objdata.writebytes(emptyint,1);
objdata.writebytes(emptyint,align(objdata.CurrObjSec.size,2)-objdata.CurrObjSec.size);
{ idata4, import lookup table }
objdata.SetSection(idata4objsection);
objdata.writereloc(0,sizeof(longint),idata6label,RELOC_RVA);
if target_info.system=system_x86_64_win64 then
objdata.writebytes(emptyint,sizeof(emptyint));
{ idata5, import address table }
objdata.SetSection(idata5objsection);
if isvar then
implabel:=objdata.SymbolDefine(afuncname,AB_GLOBAL,AT_DATA)
else
idata5label:=objdata.SymbolDefine(asmprefix+'_'+afuncname,AB_LOCAL,AT_DATA);
objdata.writereloc(0,sizeof(longint),idata6label,RELOC_RVA);
if target_info.system=system_x86_64_win64 then
objdata.writebytes(emptyint,sizeof(emptyint));
{ text, jmp }
if not isvar then
begin
objdata.SetSection(textobjsection);
implabel:=objdata.SymbolDefine(afuncname,AB_GLOBAL,AT_FUNCTION);
objdata.writebytes(jmpopcode,sizeof(jmpopcode));
objdata.writereloc(0,sizeof(longint),idata5label,RELOC_ABSOLUTE32);
objdata.writebytes(nopopcodes,align(objdata.CurrObjSec.size,sizeof(nopopcodes))-objdata.CurrObjSec.size);
end;
ObjOutput.exportsymbol(implabel);
WriteObjData(objdata);
objdata.free;
end;
var
hp1 : timportList;
hp2 : twin32imported_item;
begin
new_section(current_asmdata.asmlists[al_imports],sec_code,'',0);
hp1:=timportlist(current_module.imports.first);
while assigned(hp1) do
begin
hp2:=twin32imported_item(hp1.imported_items.first);
while assigned(hp2) do
begin
current_asmdata.asmlists[al_imports].concat(tai_directive.create(asd_extern,hp2.func^));
current_asmdata.asmlists[al_imports].concat(tai_directive.create(asd_nasm_import,hp2.func^+' '+hp1.dllname^+' '+hp2.name^));
hp2:=twin32imported_item(hp2.next);
end;
hp1:=timportlist(hp1.next);
end;
AsmPrefix:='imp'+Lower(current_module.modulename^);
idatalabnr:=0;
SmartFilesCount:=0;
SmartHeaderCount:=0;
current_module.linkotherstaticlibs.add(current_module.importlibfilename^,link_always);
ObjWriter:=TARObjectWriter.create(current_module.importlibfilename^);
ObjOutput:=TPECoffObjOutput.Create(ObjWriter);
hp1:=timportlist(current_module.imports.first);
while assigned(hp1) do
begin
StartImport(hp1.dllname^);
hp2:=twin32imported_item(hp1.imported_items.first);
while assigned(hp2) do
begin
AddImport(hp2.name^,hp2.ordnr,hp2.is_var);
hp2:=twin32imported_item(hp2.next);
end;
EndImport;
hp1:=timportlist(hp1.next);
end;
ObjOutput.Free;
ObjWriter.Free;
end;
procedure timportlibwin32.generatesmartlib;
var
hp1 : timportList;
mangledstring : string;
importname : string;
suffix : integer;
hp2 : twin32imported_item;
lhead,lname,lcode, {$ifdef ARM} lpcode, {$endif ARM}
lidata4,lidata5 : tasmlabel;
href : treference;
begin
if (target_asm.id in [as_i386_masm,as_i386_tasm,as_i386_nasmwin32]) then
begin
generatenasmlib;
exit;
end;
hp1:=timportlist(current_module.imports.first);
while assigned(hp1) do
begin
{ Get labels for the sections }
current_asmdata.getdatalabel(lhead);
current_asmdata.getdatalabel(lname);
current_asmdata.getaddrlabel(lidata4);
current_asmdata.getaddrlabel(lidata5);
{ create header for this importmodule }
current_asmdata.asmlists[al_imports].concat(Tai_cutobject.Create_begin);
new_section(current_asmdata.asmlists[al_imports],sec_idata2,'',0);
current_asmdata.asmlists[al_imports].concat(Tai_label.Create(lhead));
{ pointer to procedure names }
current_asmdata.asmlists[al_imports].concat(Tai_const.Create_rva_sym(lidata4));
{ two empty entries follow }
current_asmdata.asmlists[al_imports].concat(Tai_const.Create_32bit(0));
current_asmdata.asmlists[al_imports].concat(Tai_const.Create_32bit(0));
{ pointer to dll name }
current_asmdata.asmlists[al_imports].concat(Tai_const.Create_rva_sym(lname));
{ pointer to fixups }
current_asmdata.asmlists[al_imports].concat(Tai_const.Create_rva_sym(lidata5));
{ first write the name references }
new_section(current_asmdata.asmlists[al_imports],sec_idata4,'',0);
current_asmdata.asmlists[al_imports].concat(Tai_const.Create_32bit(0));
current_asmdata.asmlists[al_imports].concat(Tai_label.Create(lidata4));
{ then the addresses and create also the indirect jump }
new_section(current_asmdata.asmlists[al_imports],sec_idata5,'',0);
current_asmdata.asmlists[al_imports].concat(Tai_const.Create_32bit(0));
current_asmdata.asmlists[al_imports].concat(Tai_label.Create(lidata5));
{ create procedures }
hp2:=twin32imported_item(hp1.imported_items.first);
while assigned(hp2) do
begin
{ insert cuts }
current_asmdata.asmlists[al_imports].concat(Tai_cutobject.Create);
{ create indirect jump }
if not hp2.is_var then
begin
current_asmdata.getjumplabel(lcode);
{$ifdef ARM}
current_asmdata.getjumplabel(lpcode);
{$endif ARM}
{ place jump in al_procedures, insert a code section in the
al_imports to reduce the amount of .s files (PFV) }
new_section(current_asmdata.asmlists[al_imports],sec_code,'',0);
if assigned(hp2.procdef) then
mangledstring:=hp2.procdef.mangledname
else
mangledstring:=hp2.func^;
current_asmdata.asmlists[al_imports].concat(Tai_symbol.Createname_global(mangledstring,AT_FUNCTION,0));
current_asmdata.asmlists[al_imports].concat(Tai_function_name.Create(''));
{$ifdef ARM}
reference_reset_symbol(href,lpcode,0);
current_asmdata.asmlists[al_imports].concat(Taicpu.op_reg_ref(A_LDR,NR_R12,href));
reference_reset_base(href,NR_R12,0);
current_asmdata.asmlists[al_imports].concat(Taicpu.op_reg_ref(A_LDR,NR_R15,href));
current_asmdata.asmlists[al_imports].concat(Tai_label.Create(lpcode));
reference_reset_symbol(href,lcode,0);
current_asmdata.asmlists[al_imports].concat(tai_const.create_sym_offset(href.symbol,href.offset));
{$else ARM}
reference_reset_symbol(href,lcode,0);
current_asmdata.asmlists[al_imports].concat(Taicpu.Op_ref(A_JMP,S_NO,href));
current_asmdata.asmlists[al_imports].concat(Tai_align.Create_op(4,$90));
{$endif ARM}
end;
{ create head link }
new_section(current_asmdata.asmlists[al_imports],sec_idata7,'',0);
current_asmdata.asmlists[al_imports].concat(Tai_const.Create_rva_sym(lhead));
{ fixup }
current_asmdata.getjumplabel(tasmlabel(hp2.lab));
new_section(current_asmdata.asmlists[al_imports],sec_idata4,'',0);
current_asmdata.asmlists[al_imports].concat(Tai_const.Create_rva_sym(hp2.lab));
if target_info.system=system_x86_64_win64 then
current_asmdata.asmlists[al_imports].concat(Tai_const.Create_32bit(0));
{ add jump field to al_imports }
new_section(current_asmdata.asmlists[al_imports],sec_idata5,'',0);
if hp2.is_var then
current_asmdata.asmlists[al_imports].concat(Tai_symbol.Createname_global(hp2.func^,AT_FUNCTION,0))
else
current_asmdata.asmlists[al_imports].concat(Tai_label.Create(lcode));
if (cs_debuginfo in aktmoduleswitches) then
begin
if assigned(hp2.name) then
begin
importname:='__imp_'+hp2.name^;
suffix:=0;
while assigned(current_asmdata.getasmsymbol(importname)) do
begin
inc(suffix);
importname:='__imp_'+hp2.name^+'_'+tostr(suffix);
end;
current_asmdata.asmlists[al_imports].concat(tai_symbol.createname(importname,AT_FUNCTION,4));
end
else
begin
importname:='__imp_by_ordinal'+tostr(hp2.ordnr);
suffix:=0;
while assigned(current_asmdata.getasmsymbol(importname)) do
begin
inc(suffix);
importname:='__imp_by_ordinal'+tostr(hp2.ordnr)+'_'+tostr(suffix);
end;
current_asmdata.asmlists[al_imports].concat(tai_symbol.createname(importname,AT_FUNCTION,4));
end;
end;
if hp2.name^<>'' then
begin
current_asmdata.asmlists[al_imports].concat(Tai_const.Create_rva_sym(hp2.lab));
if target_info.system=system_x86_64_win64 then
current_asmdata.asmlists[al_imports].concat(Tai_const.Create_32bit(0));
end
else
begin
if target_info.system=system_x86_64_win64 then
current_asmdata.asmlists[al_imports].concat(Tai_const.Create_64bit(int64($8000000000000000) or int64(hp2.ordnr)))
else
current_asmdata.asmlists[al_imports].concat(Tai_const.Create_32bit(longint($80000000) or longint(hp2.ordnr)));
end;
{ finally the import information }
new_section(current_asmdata.asmlists[al_imports],sec_idata6,'',0);
current_asmdata.asmlists[al_imports].concat(Tai_label.Create(hp2.lab));
current_asmdata.asmlists[al_imports].concat(Tai_const.Create_16bit(hp2.ordnr));
current_asmdata.asmlists[al_imports].concat(Tai_string.Create(hp2.name^+#0));
current_asmdata.asmlists[al_imports].concat(Tai_align.Create_op(2,0));
hp2:=twin32imported_item(hp2.next);
end;
{ write final section }
current_asmdata.asmlists[al_imports].concat(Tai_cutobject.Create_end);
{ end of name references }
new_section(current_asmdata.asmlists[al_imports],sec_idata4,'',0);
current_asmdata.asmlists[al_imports].concat(Tai_const.Create_32bit(0));
if target_info.system=system_x86_64_win64 then
current_asmdata.asmlists[al_imports].concat(Tai_const.Create_32bit(0));
{ end if addresses }
new_section(current_asmdata.asmlists[al_imports],sec_idata5,'',0);
current_asmdata.asmlists[al_imports].concat(Tai_const.Create_32bit(0));
{ dllname }
new_section(current_asmdata.asmlists[al_imports],sec_idata7,'',0);
current_asmdata.asmlists[al_imports].concat(Tai_label.Create(lname));
current_asmdata.asmlists[al_imports].concat(Tai_string.Create(hp1.dllname^+#0));
hp1:=timportlist(hp1.next);
end;
end;
procedure timportlibwin32.generatelib;
procedure timportlibwin32.generateidatasection;
var
hp1 : timportList;
hp2 : twin32imported_item;
@ -440,10 +443,23 @@ implementation
href : treference;
begin
if (target_asm.id in [as_i386_masm,as_i386_tasm,as_i386_nasmwin32]) then
begin
generatenasmlib;
exit;
end;
begin
new_section(current_asmdata.asmlists[al_imports],sec_code,'',0);
hp1:=timportlist(current_module.imports.first);
while assigned(hp1) do
begin
hp2:=twin32imported_item(hp1.imported_items.first);
while assigned(hp2) do
begin
current_asmdata.asmlists[al_imports].concat(tai_directive.create(asd_extern,hp2.func^));
current_asmdata.asmlists[al_imports].concat(tai_directive.create(asd_nasm_import,hp2.func^+' '+hp1.dllname^+' '+hp2.name^));
hp2:=twin32imported_item(hp2.next);
end;
hp1:=timportlist(hp1.next);
end;
exit;
end;
hp1:=timportlist(current_module.imports.first);
while assigned(hp1) do
begin
@ -595,6 +611,15 @@ implementation
end;
procedure timportlibwin32.generatelib;
begin
if GenerateImportSection then
generateidatasection
else
generateimportlib;
end;
{*****************************************************************************
TEXPORTLIBWIN32
*****************************************************************************}
@ -876,6 +901,7 @@ implementation
temtexport.free;
end;
procedure texportlibwin32.generatenasmlib;
var
hp : texported_item;
@ -1032,20 +1058,6 @@ begin
Add(')');
end;
{ Write DLLs (=direct DLL linking) }
if not DLLFiles.Empty then
begin
Add('INPUT(') ;
While not DLLFiles.Empty do
begin
s:=DLLFiles.GetFirst;
if FindDLL(s,s2) then
Add(MaybeQuoted(s2))
else
Add('-l'+s);
end;
Add(')');
end;
Add('SEARCH_DIR("/usr/i686-pc-cygwin/lib"); SEARCH_DIR("/usr/lib"); SEARCH_DIR("/usr/lib/w32api");');
Add('OUTPUT_FORMAT(pei-i386)');
Add('ENTRY(_mainCRTStartup)');
@ -1591,226 +1603,49 @@ end;
TDLLScannerWin32
****************************************************************************}
function tDLLScannerWin32.DOSstubOK(var x:cardinal):boolean;
procedure CheckDLLFunc(const dllname,funcname:string);
var
hp : tExternalsItem;
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(longint(x)>filesize(f))then
DOSstubOK:=false;
end;
end;
function tDLLScannerWin32.ExtractDllName(Const Name : string) : string;
var n : string;
begin
n:=Upper(SplitExtension(Name));
if (n='.DLL') or (n='.DRV') or (n='.EXE') then
ExtractDllName:=Name
else
ExtractDllName:=Name+target_info.sharedlibext;
hp:=tExternalsItem(current_module.Externals.first);
while assigned(hp)do
begin
if (not hp.found) and
assigned(hp.data) and
(hp.data^=funcname) then
begin
hp.found:=true;
if not(current_module.uses_imports) then
begin
current_module.uses_imports:=true;
importlib.preparelib(current_module.modulename^);
end;
// if IsData then
// timportlibwin32(importlib).importvariable_str(funcname,dllname,funcname)
// else
timportlibwin32(importlib).importprocedure_str(funcname,dllname,0,funcname);
exit;
end;
hp:=tExternalsItem(hp.next);
end;
end;
function tDLLScannerWin32.isSuitableFileType(x:cardinal):longbool;
begin
seek(f,x);
blockread(f,TheWord,2,loaded);
isSuitableFileType:=(loaded=2)and(TheWord='PE');
end;
function tDLLScannerWin32.GetEdata(HeaderEntry: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;
const
IMAGE_SCN_CNT_CODE=$00000020;
var
_d:dirstr;
_n:namestr;
_e:extstr;
function isUsedFunction(name:pchar):longbool;
var
hp:tExternalsItem;
begin
isUsedFunction:=false;
hp:=tExternalsItem(current_module.Externals.first);
while assigned(hp)do
begin
if(assigned(hp.data))and(not hp.found)then
if hp.data^=StrPas(name)then
begin
isUsedFunction:=true;
hp.found:=true;
exit;
end;
hp:=tExternalsItem(hp.next);
end;
end;
procedure Store(index:cardinal;name:pchar;isData:longbool);
begin
if not isUsedFunction(name)then
exit;
if not(current_module.uses_imports) then
begin
current_module.uses_imports:=true;
importlib.preparelib(current_module.modulename^);
end;
if IsData then
timportlibwin32(importlib).importvariable_str(name,_n,name)
else
timportlibwin32(importlib).importprocedure_str(name,_n,index,name);
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+HeaderOffset+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,Fl:cardinal;
ulongval,procEntry:cardinal;
Ordinal:word;
isData:longbool;
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));
fsplit(impname,_d,_n,_e);
for j:=0 to pred(ExpDir.NumNames)do
function tDLLScannerWin32.scan(const binname:string):boolean;
var
hs,
dllname : string;
begin
{ Don't know why but this gives serious problems with overflow checking on }
{$IFOPT Q+}
{$DEFINE OVERFLOW_CHECK_WAS_ON}
{$ENDIF}
{$Q-}
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));
isData:=GetSectionName(procentry,Fl)='';
{$IFDEF OVERFLOW_CHECK_WAS_ON}
{$Q+}
{$ENDIF}
if not isData then
isData:=Fl and IMAGE_SCN_CNT_CODE<>IMAGE_SCN_CNT_CODE;
Store(succ(Ordinal),cstring,isData);
result:=true;
{ is there already an import library the we will use that one }
if FindLibraryFile(binname,target_info.staticClibprefix,target_info.staticClibext,hs) then
exit;
{ check if we can find the dll }
hs:=AddExtension(binname,target_info.sharedlibext);
if not FindDll(hs,dllname) then
exit;
ReadDLLImports(dllname,@CheckDLLFunc);
end;
end;
end;
begin
GetEdata:=false;
seek(f,HeaderEntry+120);
blockread(f,ExportRVA,4);
seek(f,HeaderEntry+6);
blockread(f,APE_Obj,2);
seek(f,HeaderEntry+20);
blockread(f,APE_OptSize,2);
ObjOfs:=APE_OptSize+HeaderOffset+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(ExportRva<VirtAddr+VirtSize)then
begin
delta:=ExportRva-VirtAddr;
ProcessEdata;
GetEdata:=true;
end;
end;
end;
function tDLLScannerWin32.scan(const binname:string):longbool;
var
OldFileMode:byte;
hs,
foundimp : string;
begin
Scan:=false;
{ is there already an import library the we will use that one }
if FindLibraryFile(binname,target_info.staticClibprefix,target_info.staticClibext,foundimp) then
exit;
{ check if we can find the dll }
hs:=AddExtension(binname,target_info.sharedlibext);
if not FindDll(hs,impname) then
exit;
{ read the dll file }
assign(f,impname);
OldFileMode:=filemode;
filemode:=0;
reset(f,1);
filemode:=OldFileMode;
if not DOSstubOK(HeaderOffset)then
scan:=false
else if not isSuitableFileType(HeaderOffset)then
scan:=false
else
scan:=GetEdata(HeaderOffset);
close(f);
end;
{*****************************************************************************

19
compiler/utils/ppudump.pp
View File

@ -921,7 +921,10 @@ type
{ Procedure can be inlined }
po_inline,
{ Procedure is used for internal compiler calls }
po_compilerproc
po_compilerproc,
{ importing }
po_has_importdll,
po_has_importname
);
tprocoptions=set of tprocoption;
procedure read_abstract_proc_def(var proccalloption:tproccalloption;var procoptions:tprocoptions);
@ -964,7 +967,7 @@ const
(mask:potype_function; str:'Function'),
(mask:potype_procedure; str:'Procedure')
);
procopts=35;
procopts=37;
procopt : array[1..procopts] of tprocopt=(
(mask:po_classmethod; str:'ClassMethod'),
(mask:po_virtualmethod; str:'VirtualMethod'),
@ -1000,7 +1003,9 @@ const
(mask:po_syscall_r12base; str:'SyscallR12Base'),
(mask:po_local; str:'Local'),
(mask:po_inline; str:'Inline'),
(mask:po_compilerproc; str:'CompilerProc')
(mask:po_compilerproc; str:'CompilerProc'),
(mask:po_has_importdll; str:'HasImportDLL'),
(mask:po_has_importname; str:'HasImportName')
);
var
proctypeoption : tproctypeoption;
@ -1689,11 +1694,15 @@ begin
write (space,' SymOptions : ');
readsymoptions;
if tsystemcpu(ppufile.header.cpu)=cpu_powerpc then
begin
begin
{ library symbol for AmigaOS/MorphOS }
write (space,' Library symbol : ');
readderef;
end;
end;
if (po_has_importdll in procoptions) then
writeln(space,' Import DLL : ',getstring);
if (po_has_importname in procoptions) then
writeln(space,' Import Name : ',getstring);
if (po_inline in procoptions) then
begin
write (space,' FuncretSym : ');