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

* refactor import library generation

Browse Source 
* support variable imports in internal linker

git-svn-id: trunk@4544 -
This commit is contained in:
peter 2006-09-03 19:22:31 +00:00
parent d79df4c74a
commit bf1c390027
22 changed files with 1173 additions and 1456 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
compiler/cclasses.pas
View File

@ -1146,7 +1146,13 @@ function TFPHashList.NameOfIndex(Index: Integer): String;
begin
If (Index < 0) or (Index >= FCount) then
RaiseIndexError(Index);
Result:=PShortString(@FStrs[FHashList^[Index].StrIndex])^;
with FHashList^[Index] do
begin
if StrIndex>=0 then
Result:=PShortString(@FStrs[StrIndex])^
else
Result:='';
end;
end;
@ -1302,7 +1308,11 @@ procedure TFPHashList.Delete(Index: Integer);
begin
If (Index<0) or (Index>=FCount) then
Error (SListIndexError, Index);
FHashList^[Index].Data:=nil;
with FHashList^[Index] do
begin
Data:=nil;
StrIndex:=-1;
end;
end;
class procedure TFPHashList.Error(const Msg: string; Data: PtrInt);
@ -1345,8 +1355,10 @@ end;
function TFPHashList.IndexOf(Item: Pointer): Integer;
begin
Result := 0;
while(Result < FCount) and (FHashList^[Result].Data <> Item) do Result := Result + 1;
If Result = FCount then Result := -1;
while(Result < FCount) and (FHashList^[Result].Data <> Item) do
inc(Result);
If Result = FCount then
Result := -1;
end;
function TFPHashList.Find(const s:string): Pointer;

82
compiler/fmodule.pas
View File

@ -43,23 +43,18 @@ interface
uses
cutils,cclasses,
globals,finput,
globals,finput,ogbase,
symbase,symsym,aasmbase,aasmtai,aasmdata;
const
UNSPECIFIED_LIBRARY_NAME = '<none>';
type
trecompile_reason = (rr_unknown,
rr_noppu,rr_sourcenewer,rr_build,rr_crcchanged
);
TExternalsItem=class(TLinkedListItem)
public
found : longbool;
data : pstring;
constructor Create(const s:string);
Destructor Destroy;override;
end;
tlinkcontaineritem=class(tlinkedlistitem)
public
data : pstring;
@ -95,6 +90,9 @@ interface
pderefmap = ^tderefmaprec;
tmodule = class(tmodulebase)
private
FImportLibraryList : TFPHashObjectList;
public
do_reload, { force reloading of the unit }
do_compile, { need to compile the sources }
sources_avail, { if all sources are reachable }
@ -134,15 +132,12 @@ interface
asmdata : TObject; { Assembler data }
asmprefix : pstring; { prefix for the smartlink asmfiles }
loaded_from : tmodule;
uses_imports : boolean; { Set if the module imports from DLL's.}
imports : tlinkedlist;
_exports : tlinkedlist;
externals : tlinkedlist; {Only for DLL scanners by using Unix-style $LINKLIB }
dllscannerinputlist : TFPHashList;
resourcefiles : tstringlist;
linkunitofiles,
linkunitstaticlibs,
linkunitsharedlibs,
linkdlls,
linkotherofiles, { objects,libs loaded from the source }
linkothersharedlibs, { using $L or $LINKLIB or import lib (for linux) }
linkotherstaticlibs : tlinkcontainer;
@ -170,6 +165,8 @@ interface
function resolve_unit(id:longint):tmodule;
procedure allunitsused;
procedure setmodulename(const s:string);
procedure AddExternalImport(const libname,symname:string;OrdNr: longint;isvar:boolean);
property ImportLibraryList : TFPHashObjectList read FImportLibraryList;
end;
tused_unit = class(tlinkedlistitem)
@ -324,25 +321,6 @@ implementation
end;
{****************************************************************************
TExternalsItem
****************************************************************************}
constructor tExternalsItem.Create(const s:string);
begin
inherited Create;
found:=false;
data:=stringdup(s);
end;
destructor tExternalsItem.Destroy;
begin
stringdispose(data);
inherited;
end;
{****************************************************************************
TUSED_UNIT
****************************************************************************}
@ -419,7 +397,7 @@ implementation
linkotherofiles:=TLinkContainer.Create;
linkotherstaticlibs:=TLinkContainer.Create;
linkothersharedlibs:=TLinkContainer.Create;
linkdlls:=TLinkContainer.Create;
FImportLibraryList:=TFPHashObjectList.Create(true);
crc:=0;
interface_crc:=0;
flags:=0;
@ -450,10 +428,8 @@ implementation
is_dbginfo_written:=false;
is_reset:=false;
mode_switch_allowed:= true;
uses_imports:=false;
imports:=TLinkedList.Create;
_exports:=TLinkedList.Create;
externals:=TLinkedList.Create;
dllscannerinputlist:=TFPHashList.Create;
asmdata:=TAsmData.create(realmodulename^);
end;
@ -474,12 +450,10 @@ implementation
stringdispose(derefmap[i].modulename);
freemem(derefmap);
end;
if assigned(imports) then
imports.free;
if assigned(_exports) then
_exports.free;
if assigned(externals) then
externals.free;
if assigned(dllscannerinputlist) then
dllscannerinputlist.free;
if assigned(scanner) then
begin
{ also update current_scanner if it was pointing
@ -515,7 +489,7 @@ implementation
linkotherofiles.Free;
linkotherstaticlibs.Free;
linkothersharedlibs.Free;
linkdlls.Free;
FImportLibraryList.Free;
stringdispose(objfilename);
stringdispose(newfilename);
stringdispose(ppufilename);
@ -626,12 +600,10 @@ implementation
sourcefiles.free;
sourcefiles:=tinputfilemanager.create;
asmdata:=TAsmData.create(realmodulename^);
imports.free;
imports:=tlinkedlist.create;
_exports.free;
_exports:=tlinkedlist.create;
externals.free;
externals:=tlinkedlist.create;
dllscannerinputlist.free;
dllscannerinputlist:=TFPHashList.create;
used_units.free;
used_units:=TLinkedList.Create;
dependent_units.free;
@ -650,9 +622,8 @@ implementation
linkotherstaticlibs:=TLinkContainer.Create;
linkothersharedlibs.Free;
linkothersharedlibs:=TLinkContainer.Create;
linkdlls.Free;
linkdlls:=TLinkContainer.Create;
uses_imports:=false;
FImportLibraryList.Free;
FImportLibraryList:=TFPHashObjectList.Create;
do_compile:=false;
do_reload:=false;
interface_compiled:=false;
@ -845,4 +816,19 @@ implementation
current_asmdata.realname:=realmodulename^;
end;
procedure TModule.AddExternalImport(const libname,symname:string;OrdNr: longint;isvar:boolean);
var
ImportLibrary : TImportLibrary;
ImportSymbol : TFPHashObject;
begin
ImportLibrary:=TImportLibrary(ImportLibraryList.Find(libname));
if not assigned(ImportLibrary) then
ImportLibrary:=TImportLibrary.Create(ImportLibraryList,libname);
ImportSymbol:=TFPHashObject(ImportLibrary.ImportSymbolList.Find(symname));
if not assigned(ImportSymbol) then
ImportSymbol:=TImportSymbol.Create(ImportLibrary.ImportSymbolList,symname,OrdNr,isvar);
end;
end.

58
compiler/fppu.pas
View File

@ -68,11 +68,13 @@ interface
procedure writelinkcontainer(var p:tlinkcontainer;id:byte;strippath:boolean);
procedure writederefmap;
procedure writederefdata;
procedure writeImportSymbols;
procedure readsourcefiles;
procedure readloadunit;
procedure readlinkcontainer(var p:tlinkcontainer);
procedure readderefmap;
procedure readderefdata;
procedure readImportSymbols;
{$IFDEF MACRO_DIFF_HINT}
procedure writeusedmacro(p:TNamedIndexItem;arg:pointer);
procedure writeusedmacros;
@ -90,7 +92,7 @@ uses
verbose,systems,version,
symtable, symsym,
scanner,
aasmbase,
aasmbase,ogbase,
parser;
{****************************************************************************
@ -568,6 +570,30 @@ uses
ppufile.writeentry(ibderefdata);
end;
procedure tppumodule.writeImportSymbols;
var
i,j : longint;
ImportLibrary : TImportLibrary;
ImportSymbol : TImportSymbol;
begin
for i:=0 to ImportLibraryList.Count-1 do
begin
ImportLibrary:=TImportLibrary(ImportLibraryList[i]);
ppufile.putstring(ImportLibrary.Name);
ppufile.putlongint(ImportLibrary.ImportSymbolList.Count);
for j:=0 to ImportLibrary.ImportSymbolList.Count-1 do
begin
ImportSymbol:=TImportSymbol(ImportLibrary.ImportSymbolList[j]);
ppufile.putstring(ImportSymbol.Name);
ppufile.putlongint(ImportSymbol.OrdNr);
ppufile.putbyte(byte(ImportSymbol.IsVar));
end;
end;
ppufile.writeentry(ibImportSymbols);
end;
{$IFDEF MACRO_DIFF_HINT}
{
@ -800,6 +826,30 @@ uses
end;
procedure tppumodule.readImportSymbols;
var
j,
extsymcnt : longint;
ImportLibrary : TImportLibrary;
extsymname : string;
extsymordnr : longint;
extsymisvar : boolean;
begin
while not ppufile.endofentry do
begin
ImportLibrary:=TImportLibrary.Create(ImportLibraryList,ppufile.getstring);
extsymcnt:=ppufile.getlongint;
for j:=0 to extsymcnt-1 do
begin
extsymname:=ppufile.getstring;
extsymordnr:=ppufile.getlongint;
extsymisvar:=(ppufile.getbyte<>0);
TImportSymbol.Create(ImportLibrary.ImportSymbolList,extsymname,extsymordnr,extsymisvar);
end;
end;
end;
procedure tppumodule.load_interface;
var
b : byte;
@ -840,8 +890,8 @@ uses
readlinkcontainer(LinkotherStaticLibs);
iblinkothersharedlibs :
readlinkcontainer(LinkotherSharedLibs);
iblinkdlls :
readlinkcontainer(LinkDlls);
ibImportSymbols :
readImportSymbols;
ibderefmap :
readderefmap;
ibderefdata :
@ -951,7 +1001,7 @@ uses
writelinkcontainer(linkotherofiles,iblinkotherofiles,false);
writelinkcontainer(linkotherstaticlibs,iblinkotherstaticlibs,true);
writelinkcontainer(linkothersharedlibs,iblinkothersharedlibs,true);
writelinkcontainer(linkdlls,iblinkdlls,true);
writeImportSymbols;
ppufile.do_crc:=true;
{ generate implementation deref data, the interface deref data is

92
compiler/import.pas
View File

@ -31,24 +31,6 @@ uses
symdef,symsym;
type
timported_item = class(TLinkedListItem)
ordnr : longint;
name,
func : pstring;
lab : tasmlabel;
is_var : boolean;
constructor Create(const n,s : string;o : longint);
constructor Create_var(const n,s : string);
destructor Destroy;override;
end;
timportlist = class(TLinkedListItem)
dllname : pstring;
imported_items : tlinkedlist;
constructor Create(const n : string);
destructor Destroy;Override;
end;
timportlib=class
private
notsupmsg : boolean;
@ -56,9 +38,6 @@ type
public
constructor Create;virtual;
destructor Destroy;override;
procedure preparelib(const s:string);virtual;
procedure importprocedure(aprocdef:tprocdef;const module:string;index:longint;const name:string);virtual;
procedure importvariable(vs:tglobalvarsym;const name,module:string);virtual;
procedure generatelib;virtual;
end;
@ -85,59 +64,6 @@ implementation
uses
verbose,globals;
{****************************************************************************
Timported_item
****************************************************************************}
constructor timported_item.Create(const n,s : string;o : longint);
begin
inherited Create;
func:=stringdup(n);
name:=stringdup(s);
ordnr:=o;
lab:=nil;
is_var:=false;
end;
constructor timported_item.create_var(const n,s : string);
begin
inherited Create;
func:=stringdup(n);
name:=stringdup(s);
ordnr:=0;
lab:=nil;
is_var:=true;
end;
destructor timported_item.destroy;
begin
stringdispose(name);
stringdispose(func);
inherited destroy;
end;
{****************************************************************************
TImportlist
****************************************************************************}
constructor timportlist.Create(const n : string);
begin
inherited Create;
dllname:=stringdup(n);
imported_items:=Tlinkedlist.Create;
end;
destructor timportlist.destroy;
begin
imported_items.free;
stringdispose(dllname);
end;
{****************************************************************************
TImportLib
****************************************************************************}
@ -164,24 +90,6 @@ begin
end;
procedure timportlib.preparelib(const s:string);
begin
NotSupported;
end;
procedure timportlib.importprocedure(aprocdef:tprocdef;const module:string;index:longint;const name:string);
begin
NotSupported;
end;
procedure timportlib.importvariable(vs:tglobalvarsym;const name,module:string);
begin
NotSupported;
end;
procedure timportlib.generatelib;
begin
NotSupported;

1305
compiler/link.pas
View File

File diff suppressed because it is too large Load Diff

45
compiler/ogbase.pas
View File

@ -342,21 +342,23 @@ interface
property ObjInputClass:TObjInputClass read FObjInputClass;
end;
TExternalLibrary = class(TFPHashObject)
TImportLibrary = class(TFPHashObject)
private
FExternalSymbolList : TFPHashObjectList;
FImportSymbolList : TFPHashObjectList;
public
constructor create(AList:TFPHashObjectList;const AName:string);
destructor destroy;override;
property ExternalSymbolList:TFPHashObjectList read FExternalSymbolList;
property ImportSymbolList:TFPHashObjectList read FImportSymbolList;
end;
TExternalSymbol = class(TFPHashObject)
TImportSymbol = class(TFPHashObject)
private
FOrdNumber: longint;
FOrdNr : longint;
FIsVar : boolean;
public
constructor create(AList: TFPHashObjectList; const AName: string; AOrdNumber: longint);
property OrdNumber: longint read FOrdNumber;
constructor create(AList:TFPHashObjectList;const AName:string;AOrdNr:longint;AIsVar:boolean);
property OrdNr: longint read FOrdNr;
property IsVar: boolean read FIsVar;
end;
TExeOutput = class
@ -424,7 +426,7 @@ interface
procedure MergeStabs;
procedure RemoveUnreferencedSections;
procedure RemoveEmptySections;
procedure GenerateLibraryImports(ExternalLibraryList:TFPHashObjectList);virtual;
procedure GenerateLibraryImports(ImportLibraryList:TFPHashObjectList);virtual;
function writeexefile(const fn:string):boolean;
property Writer:TObjectWriter read FWriter;
property ExeSections:TFPHashObjectList read FExeSectionList;
@ -1289,32 +1291,33 @@ implementation
{****************************************************************************
TExternalLibrary
TImportLibrary
****************************************************************************}
constructor TExternalLibrary.create(AList:TFPHashObjectList;const AName:string);
constructor TImportLibrary.create(AList:TFPHashObjectList;const AName:string);
begin
inherited create(AList,AName);
FExternalSymbolList:=TFPHashObjectList.Create(false);
FImportSymbolList:=TFPHashObjectList.Create(false);
end;
destructor TExternalLibrary.destroy;
destructor TImportLibrary.destroy;
begin
ExternalSymbolList.Free;
ImportSymbolList.Free;
inherited destroy;
end;
{****************************************************************************
TExternalSymbol
TImportSymbol
****************************************************************************}
constructor TExternalSymbol.create(AList: TFPHashObjectList; const AName: string; AOrdNumber: longint);
begin
inherited Create(AList, AName);
FOrdNumber:=AOrdNumber;
end;
constructor TImportSymbol.create(AList:TFPHashObjectList;const AName:string;AOrdNr:longint;AIsVar:boolean);
begin
inherited Create(AList, AName);
FOrdNr:=AOrdNr;
FIsVar:=AIsVar;
end;
{****************************************************************************
@ -1907,7 +1910,7 @@ end;
end;
procedure TExeOutput.GenerateLibraryImports(ExternalLibraryList:TFPHashObjectList);
procedure TExeOutput.GenerateLibraryImports(ImportLibraryList:TFPHashObjectList);
begin
end;

66
compiler/ogcoff.pas
View File

@ -248,7 +248,7 @@ interface
procedure GenerateRelocs;
public
constructor create;override;
procedure GenerateLibraryImports(ExternalLibraryList:TFPHashObjectList);override;
procedure GenerateLibraryImports(ImportLibraryList:TFPHashObjectList);override;
procedure Order_End;override;
procedure CalcPos_ExeSection(const aname:string);override;
end;
@ -428,7 +428,7 @@ implementation
R_DIR32 = 6;
R_IMAGEBASE = 7;
R_PCRLONG = 20;
{ .reloc section fixup types }
IMAGE_REL_BASED_HIGHLOW = 3; { Applies the delta to the 32-bit field at Offset. }
IMAGE_REL_BASED_DIR64 = 10; { Applies the delta to the 64-bit field at Offset. }
@ -2277,7 +2277,7 @@ const pemagic : array[0..3] of byte = (
end;
procedure TPECoffexeoutput.GenerateLibraryImports(ExternalLibraryList:TFPHashObjectList);
procedure TPECoffexeoutput.GenerateLibraryImports(ImportLibraryList:TFPHashObjectList);
var
textobjsection,
idata2objsection,
@ -2348,7 +2348,7 @@ const pemagic : array[0..3] of byte = (
internalobjdata.writebytes(emptyint,sizeof(emptyint));
end;
function AddProcImport(const afuncname:string; ordnumber:longint):TObjSymbol;
function AddImport(const afuncname:string; AOrdNr:longint;isvar:boolean):TObjSymbol;
const
{$ifdef x86_64}
jmpopcode : array[0..2] of byte = (
@ -2376,7 +2376,7 @@ const pemagic : array[0..3] of byte = (
emptyint : longint;
secname,
num : string;
ordnr: word;
absordnr: word;
begin
result:=nil;
emptyint:=0;
@ -2397,16 +2397,16 @@ const pemagic : array[0..3] of byte = (
inc(idatalabnr);
num:=tostr(idatalabnr);
idata6label:=internalobjdata.SymbolDefine('__imp_'+num,AB_LOCAL,AT_DATA);
ordnr:=Abs(ordnumber);
internalobjdata.writebytes(ordnr,2);
if ordnumber <= 0 then
absordnr:=Abs(AOrdNr);
internalobjdata.writebytes(absordnr,2);
if AOrdNr <= 0 then
internalobjdata.writebytes(afuncname[1],length(afuncname));
internalobjdata.writebytes(emptyint,1);
internalobjdata.writebytes(emptyint,align(internalobjdata.CurrObjSec.size,2)-internalobjdata.CurrObjSec.size);
{ idata4, import lookup table }
internalobjdata.SetSection(idata4objsection);
idata4label:=internalobjdata.SymbolDefine('__imp_lookup_'+num,AB_LOCAL,AT_DATA);
if ordnumber <= 0 then
if AOrdNr <= 0 then
begin
internalobjdata.writereloc(0,sizeof(longint),idata6label,RELOC_RVA);
if target_info.system=system_x86_64_win64 then
@ -2414,7 +2414,7 @@ const pemagic : array[0..3] of byte = (
end
else
begin
emptyint:=ordnumber;
emptyint:=AOrdNr;
if target_info.system=system_x86_64_win64 then
begin
internalobjdata.writebytes(emptyint,sizeof(emptyint));
@ -2434,42 +2434,48 @@ const pemagic : array[0..3] of byte = (
internalobjdata.writereloc(0,0,idata4label,RELOC_NONE);
internalobjdata.writereloc(0,0,idata2label,RELOC_NONE);
{ section data }
idata5label:=internalobjdata.SymbolDefine('__imp_'+afuncname,AB_LOCAL,AT_DATA);
if isvar then
result:=internalobjdata.SymbolDefine(afuncname,AB_GLOBAL,AT_DATA)
else
idata5label:=internalobjdata.SymbolDefine('__imp_'+afuncname,AB_LOCAL,AT_DATA);
internalobjdata.writereloc(0,sizeof(longint),idata6label,RELOC_RVA);
if target_info.system=system_x86_64_win64 then
internalobjdata.writebytes(emptyint,sizeof(emptyint));
{ text, jmp }
internalobjdata.SetSection(textobjsection);
result:=internalobjdata.SymbolDefine('_'+afuncname,AB_GLOBAL,AT_FUNCTION);
internalobjdata.writebytes(jmpopcode,sizeof(jmpopcode));
internalobjdata.writereloc(0,sizeof(longint),idata5label,RELOC_ABSOLUTE32);
internalobjdata.writebytes(nopopcodes,align(internalobjdata.CurrObjSec.size,sizeof(nopopcodes))-internalobjdata.CurrObjSec.size);
if not isvar then
begin
internalobjdata.SetSection(textobjsection);
result:=internalobjdata.SymbolDefine('_'+afuncname,AB_GLOBAL,AT_FUNCTION);
internalobjdata.writebytes(jmpopcode,sizeof(jmpopcode));
internalobjdata.writereloc(0,sizeof(longint),idata5label,RELOC_ABSOLUTE32);
internalobjdata.writebytes(nopopcodes,align(internalobjdata.CurrObjSec.size,sizeof(nopopcodes))-internalobjdata.CurrObjSec.size);
end;
end;
var
i,j : longint;
ExtLibrary : TExternalLibrary;
ExtSymbol : TExternalSymbol;
ImportLibrary : TImportLibrary;
ImportSymbol : TImportSymbol;
exesym : TExeSymbol;
begin
for i:=0 to ExternalLibraryList.Count-1 do
for i:=0 to ImportLibraryList.Count-1 do
begin
ExtLibrary:=TExternalLibrary(ExternalLibraryList[i]);
ImportLibrary:=TImportLibrary(ImportLibraryList[i]);
idata2objsection:=nil;
idata4objsection:=nil;
idata5objsection:=nil;
idata6objsection:=nil;
idata7objsection:=nil;
for j:=0 to ExtLibrary.ExternalSymbolList.Count-1 do
for j:=0 to ImportLibrary.ImportSymbolList.Count-1 do
begin
ExtSymbol:=TExternalSymbol(ExtLibrary.ExternalSymbolList[j]);
exesym:=TExeSymbol(ExeSymbolList.Find(ExtSymbol.Name));
ImportSymbol:=TImportSymbol(ImportLibrary.ImportSymbolList[j]);
exesym:=TExeSymbol(ExeSymbolList.Find(ImportSymbol.Name));
if assigned(exesym) and
(exesym.State<>symstate_defined) then
begin
if not assigned(idata2objsection) then
StartImport(ExtLibrary.Name);
exesym.objsymbol:=AddProcImport(ExtSymbol.Name, ExtSymbol.OrdNumber);
StartImport(ImportLibrary.Name);
exesym.objsymbol:=AddImport(ImportSymbol.Name,ImportSymbol.OrdNr,ImportSymbol.IsVar);
exesym.State:=symstate_defined;
end;
end;
@ -2483,7 +2489,7 @@ const pemagic : array[0..3] of byte = (
procedure TPECoffexeoutput.GenerateRelocs;
var
pgaddr, hdrpos : longint;
procedure FinishBlock;
var
p,len : longint;
@ -2499,7 +2505,7 @@ const pemagic : array[0..3] of byte = (
internalObjData.CurrObjSec.Data.seek(p);
hdrpos:=-1;
end;
var
exesec : TExeSection;
objsec : TObjSection;
@ -2544,7 +2550,7 @@ const pemagic : array[0..3] of byte = (
end;
FinishBlock;
end;
procedure TPECoffexeoutput.Order_End;
var
@ -2558,8 +2564,8 @@ const pemagic : array[0..3] of byte = (
exit;
exesec.SecOptions:=exesec.SecOptions + [oso_Data,oso_keep];
end;
procedure TPECoffexeoutput.CalcPos_ExeSection(const aname:string);
begin
if aname='.reloc' then

23
compiler/pdecvar.pas
View File

@ -997,7 +997,7 @@ implementation
if (extern_var) and (idtoken<>_NAME) then
begin
is_dll:=true;
dll_name:=get_stringconst;
dll_name:=AddExtension(get_stringconst,target_info.sharedlibext);
end;
if try_to_consume(_NAME) then
C_name:=get_stringconst
@ -1010,9 +1010,13 @@ implementation
{ set some vars options }
if is_dll then
include(vs.varoptions,vo_is_dll_var)
begin
{ Windows uses an indirect reference using import tables }
if target_info.system in system_all_windows then
include(vs.varoptions,vo_is_dll_var);
end
else
include(vs.varoptions,vo_is_C_var);
include(vs.varoptions,vo_is_C_var);
if (is_dll) and
(target_info.system in [system_powerpc_darwin,system_i386_darwin]) then
@ -1039,17 +1043,10 @@ implementation
begin
vs.varregable := vr_none;
if is_dll then
begin
if not(current_module.uses_imports) then
begin
current_module.uses_imports:=true;
importlib.preparelib(current_module.realmodulename^);
end;
importlib.importvariable(tglobalvarsym(vs),C_name,dll_name);
end
current_module.AddExternalImport(dll_name,C_Name,0,true)
else
if tf_has_dllscanner in target_info.flags then
current_module.Externals.insert(tExternalsItem.create(vs.mangledname));
if tf_has_dllscanner in target_info.flags then
current_module.dllscannerinputlist.Add(vs.mangledname,vs);
end;
end
else

4
compiler/pmodules.pas
View File

@ -1112,7 +1112,7 @@ implementation
GenerateResourceStrings;
{ generate imports }
if current_module.uses_imports then
if current_module.ImportLibraryList.Count>0 then
importlib.generatelib;
{ insert own objectfile, or say that it's in a library
@ -1412,7 +1412,7 @@ implementation
gen_pic_helpers(current_asmdata.asmlists[al_procedures]);
{ generate imports }
if current_module.uses_imports then
if current_module.ImportLibraryList.Count>0 then
importlib.generatelib;
if islibrary or (target_info.system in system_unit_program_exports) then

4
compiler/ppu.pas
View File

@ -43,7 +43,7 @@ type
{$endif Test_Double_checksum}
const
CurrentPPUVersion=61;
CurrentPPUVersion=62;
{ buffer sizes }
maxentrysize = 1024;
@ -73,7 +73,7 @@ const
iblinkotherofiles = 8;
iblinkotherstaticlibs = 9;
iblinkothersharedlibs = 10;
iblinkdlls = 11;
ibImportSymbols = 11;
ibsymref = 12;
ibdefref = 13;
ibendsymtablebrowser = 14;

16
compiler/psub.pas
View File

@ -1510,24 +1510,12 @@ implementation
{ Import DLL specified? }
if assigned(pd.import_dll) then
begin
{ create importlib if not already done }
if not(current_module.uses_imports) then
begin
current_module.uses_imports:=true;
importlib.preparelib(current_module.realmodulename^);
end;
if assigned(pd.import_name) then
importlib.importprocedure(pd,pd.import_dll^,pd.import_nr,proc_get_importname(pd))
else
importlib.importprocedure(pd,pd.import_dll^,pd.import_nr,'');
end
current_module.AddExternalImport(pd.import_dll^,proc_get_importname(pd),pd.import_nr,false)
else
begin
{ add import name to external list for DLL scanning }
if tf_has_dllscanner in target_info.flags then
current_module.externals.insert(tExternalsItem.create(proc_get_importname(pd)));
current_module.dllscannerinputlist.Add(proc_get_importname(pd),pd);
end;
end;
end;

41
compiler/systems/t_beos.pas
View File

@ -32,9 +32,6 @@ interface
type
timportlibbeos=class(timportlib)
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;
end;
@ -63,37 +60,23 @@ implementation
cutils,cclasses,
verbose,systems,globtype,globals,
symconst,script,
fmodule,aasmbase,aasmtai,aasmdata,aasmcpu,cpubase,i_beos;
fmodule,aasmbase,aasmtai,aasmdata,aasmcpu,cpubase,i_beos,ogbase;
{*****************************************************************************
TIMPORTLIBBEOS
*****************************************************************************}
procedure timportlibbeos.preparelib(const s : string);
begin
end;
procedure timportlibbeos.importprocedure(aprocdef:tprocdef;const module:string;index:longint;const name:string);
begin
{ insert sharedlibrary }
current_module.linkothersharedlibs.add(SplitName(module),link_always);
end;
procedure timportlibbeos.importvariable(vs:tglobalvarsym;const name,module:string);
begin
{ insert sharedlibrary }
current_module.linkothersharedlibs.add(SplitName(module),link_always);
{ reset the mangledname and turn off the dll_var option }
vs.set_mangledname(name);
exclude(vs.varoptions,vo_is_dll_var);
end;
procedure timportlibbeos.generatelib;
begin
end;
procedure timportlibbeos.generatelib;
var
i : longint;
ImportLibrary : TImportLibrary;
begin
for i:=0 to current_module.ImportLibraryList.Count-1 do
begin
ImportLibrary:=TImportLibrary(current_module.ImportLibraryList[i]);
current_module.linkothersharedlibs.add(ImportLibrary.Name,link_always);
end;
end;
{*****************************************************************************

71
compiler/systems/t_bsd.pas
View File

@ -41,24 +41,14 @@ implementation
symconst,script,
fmodule,aasmbase,aasmtai,aasmdata,aasmcpu,cpubase,symsym,symdef,
import,export,link,i_bsd,
cgutils,cgbase,cgobj,cpuinfo;
cgutils,cgbase,cgobj,cpuinfo,ogbase;
type
tdarwinimported_item = class(timported_item)
procdef : tprocdef;
end;
timportlibdarwin=class(timportlib)
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;
end;
timportlibbsd=class(timportlib)
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;
end;
@ -88,29 +78,6 @@ implementation
TIMPORTLIBDARWIN
*****************************************************************************}
procedure timportlibdarwin.preparelib(const s : string);
begin
if current_asmdata.asmlists[al_imports]=nil then
current_asmdata.asmlists[al_imports]:=TAsmList.create;
end;
procedure timportlibdarwin.importprocedure(aprocdef:tprocdef;const module : string;index : longint;const name : string);
begin
{ insert sharedlibrary }
{ current_module.linkothersharedlibs.add(SplitName(module),link_always); }
end;
procedure timportlibdarwin.importvariable(vs:tglobalvarsym;const name,module:string);
begin
{ insert sharedlibrary }
{ current_module.linkothersharedlibs.add(SplitName(module),link_always); }
{ the rest is handled in the nppcld.pas tppcloadnode }
vs.set_mangledname(name);
end;
procedure timportlibdarwin.generatelib;
begin
end;
@ -120,31 +87,17 @@ implementation
TIMPORTLIBBSD
*****************************************************************************}
procedure timportlibbsd.preparelib(const s : string);
begin
end;
procedure timportlibbsd.importprocedure(aprocdef:tprocdef;const module:string;index:longint;const name:string);
begin
{ insert sharedlibrary }
current_module.linkothersharedlibs.add(SplitName(module),link_always);
end;
procedure timportlibbsd.importvariable(vs:tglobalvarsym;const name,module:string);
begin
{ insert sharedlibrary }
current_module.linkothersharedlibs.add(SplitName(module),link_always);
{ reset the mangledname and turn off the dll_var option }
vs.set_mangledname(name);
exclude(vs.varoptions,vo_is_dll_var);
end;
procedure timportlibbsd.generatelib;
begin
end;
procedure timportlibbsd.generatelib;
var
i : longint;
ImportLibrary : TImportLibrary;
begin
for i:=0 to current_module.ImportLibraryList.Count-1 do
begin
ImportLibrary:=TImportLibrary(current_module.ImportLibraryList[i]);
current_module.linkothersharedlibs.add(ImportLibrary.Name,link_always);
end;
end;
{*****************************************************************************

58
compiler/systems/t_emx.pas
View File

@ -41,13 +41,12 @@ implementation
dos,
cutils,cclasses,
globtype,comphook,systems,symconst,symsym,symdef,
globals,verbose,fmodule,script,
globals,verbose,fmodule,script,ogbase,
import,link,i_emx,ppu;
type
TImportLibEMX=class(timportlib)
procedure preparelib(const s:string);override;
procedure importprocedure(aprocdef:tprocdef;const module:string;index:longint;const name:string);override;
procedure generatelib;override;
end;
@ -262,24 +261,8 @@ begin
blockwrite(out_file,aout_str_tab,aout_str_size);
end;
procedure TImportLibEMX.preparelib(const s:string);
{This code triggers a lot of bugs in the compiler.
const armag='!<arch>'#10;
ar_magic:array[1..length(armag)] of char=armag;}
const ar_magic:array[1..8] of char='!<arch>'#10;
var
libname : string;
begin
LibName:=FixFileName(S + Target_Info.StaticCLibExt);
seq_no:=1;
current_module.linkotherstaticlibs.add(libname,link_always);
assign(out_file,current_module.outputpath^+libname);
rewrite(out_file,1);
blockwrite(out_file,ar_magic,sizeof(ar_magic));
end;
procedure TImportLibEMX.importprocedure(aprocdef:tprocdef;const module:string;index:longint;const name:string);
procedure AddImport(const module:string;index:longint;const name:string);
{func = Name of function to import.
module = Name of DLL to import from.
index = Index of function in DLL. Use 0 to import by name.
@ -289,10 +272,6 @@ var tmp1,tmp2,tmp3:string;
fixup_mcount,fixup_import:longint;
func : string;
begin
{ force the current mangledname }
include(aprocdef.procoptions,po_has_mangledname);
func:=aprocdef.mangledname;
aout_init;
tmp2:=func;
if profile_flag and not (copy(func,1,4)='_16_') then
@ -335,11 +314,32 @@ begin
inc(seq_no);
end;
procedure TImportLibEMX.GenerateLib;
begin
close(out_file);
end;
procedure TImportLibEMX.GenerateLib;
const
ar_magic:array[1..8] of char='!<arch>'#10;
var
libname : string;
i,j : longint;
ImportLibrary : TImportLibrary;
ImportSymbol : TImportSymbol;
begin
for i:=0 to current_module.ImportLibraryList.Count-1 do
begin
ImportLibrary:=TImportLibrary(current_module.ImportLibraryList[i]);
LibName:=FixFileName(ImportLibrary.Name + Target_Info.StaticCLibExt);
seq_no:=1;
current_module.linkotherstaticlibs.add(libname,link_always);
assign(out_file,current_module.outputpath^+libname);
rewrite(out_file,1);
blockwrite(out_file,ar_magic,sizeof(ar_magic));
for j:=0 to ImportLibrary.ImportSymbolList.Count-1 do
begin
ImportSymbol:=TImportSymbol(ImportLibrary.ImportSymbolList[j]);
AddImport(ImportLibrary.Name,ImportSymbol.OrdNr,ImportSymbol.Name);
end;
close(out_file);
end;
end;
{****************************************************************************

41
compiler/systems/t_linux.pas
View File

@ -32,9 +32,6 @@ interface
type
timportliblinux=class(timportlib)
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;
end;
@ -67,7 +64,7 @@ implementation
symconst,script,
fmodule,dos,
aasmbase,aasmtai,aasmdata,aasmcpu,cpubase,
cgbase,cgobj,cgutils,
cgbase,cgobj,cgutils,ogbase,
i_linux
;
@ -75,31 +72,17 @@ implementation
TIMPORTLIBLINUX
*****************************************************************************}
procedure timportliblinux.preparelib(const s : string);
begin
end;
procedure timportliblinux.importprocedure(aprocdef:tprocdef;const module:string;index:longint;const name:string);
begin
{ insert sharedlibrary }
current_module.linkothersharedlibs.add(SplitName(module),link_always);
end;
procedure timportliblinux.importvariable(vs:tglobalvarsym;const name,module:string);
begin
{ insert sharedlibrary }
current_module.linkothersharedlibs.add(SplitName(module),link_always);
{ reset the mangledname and turn off the dll_var option }
vs.set_mangledname(name);
exclude(vs.varoptions,vo_is_dll_var);
end;
procedure timportliblinux.generatelib;
begin
end;
procedure timportliblinux.generatelib;
var
i : longint;
ImportLibrary : TImportLibrary;
begin
for i:=0 to current_module.ImportLibraryList.Count-1 do
begin
ImportLibrary:=TImportLibrary(current_module.ImportLibraryList[i]);
current_module.linkothersharedlibs.add(ImportLibrary.Name,link_always);
end;
end;
{*****************************************************************************

39
compiler/systems/t_macos.pas
View File

@ -30,9 +30,6 @@ interface
type
timportlibmacos=class(timportlib)
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;
end;
@ -56,31 +53,17 @@ implementation
TIMPORTLIBMACOS
*****************************************************************************}
procedure timportlibmacos.preparelib(const s : string);
begin
end;
procedure timportlibmacos.importprocedure(aprocdef:tprocdef;const module:string;index:longint;const name:string);
begin
{ insert sharedlibrary }
current_module.linkothersharedlibs.add(SplitName(module),link_always);
end;
procedure timportlibmacos.importvariable(vs:tglobalvarsym;const name,module:string);
begin
{ insert sharedlibrary }
current_module.linkothersharedlibs.add(SplitName(module),link_always);
{ reset the mangledname and turn off the dll_var option }
vs.set_mangledname(name);
exclude(vs.varoptions,vo_is_dll_var);
end;
procedure timportlibmacos.generatelib;
begin
end;
procedure timportlibmacos.generatelib;
var
i : longint;
ImportLibrary : TImportLibrary;
begin
for i:=0 to current_module.ImportLibraryList.Count-1 do
begin
ImportLibrary:=TImportLibrary(current_module.ImportLibraryList[i]);
current_module.linkothersharedlibs.add(ImportLibrary.Name,link_always);
end;
end;
{*****************************************************************************
TLINKERMPW

41
compiler/systems/t_nwl.pas
View File

@ -102,15 +102,12 @@ implementation
verbose,systems,globtype,globals,
symconst,script,
fmodule,aasmbase,aasmtai,aasmdata,aasmcpu,cpubase,symsym,symdef,
import,export,link,i_nwl
import,export,link,i_nwl,ogbase
{$ifdef netware} ,dos {$endif}
;
type
timportlibnetwlibc=class(timportlib)
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;
end;
@ -140,31 +137,17 @@ Const tmpLinkFileName = '~link~tmp.o';
TIMPORTLIBNETWARE
*****************************************************************************}
procedure timportlibnetwlibc.preparelib(const s : string);
begin
end;
procedure timportlibnetwlibc.importprocedure(aprocdef:tprocdef;const module:string;index:longint;const name:string);
begin
{ insert sharedlibrary }
current_module.linkothersharedlibs.add(SplitName(module),link_always);
end;
procedure timportlibnetwlibc.importvariable(vs:tglobalvarsym;const name,module:string);
begin
{ insert sharedlibrary }
current_module.linkothersharedlibs.add(SplitName(module),link_always);
{ reset the mangledname and turn off the dll_var option }
vs.set_mangledname(name);
exclude(vs.varoptions,vo_is_dll_var);
end;
procedure timportlibnetwlibc.generatelib;
begin
end;
procedure timportlibnetwlibc.generatelib;
var
i : longint;
ImportLibrary : TImportLibrary;
begin
for i:=0 to current_module.ImportLibraryList.Count-1 do
begin
ImportLibrary:=TImportLibrary(current_module.ImportLibraryList[i]);
current_module.linkothersharedlibs.add(ImportLibrary.Name,link_always);
end;
end;
{*****************************************************************************

41
compiler/systems/t_nwm.pas
View File

@ -96,15 +96,12 @@ implementation
verbose,systems,globtype,globals,
symconst,script,
fmodule,aasmbase,aasmtai,aasmdata,aasmcpu,cpubase,symsym,symdef,
import,export,link,i_nwm
import,export,link,i_nwm,ogbase
{$ifdef netware} ,dos {$endif}
;
type
timportlibnetware=class(timportlib)
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;
end;
@ -132,31 +129,17 @@ Const tmpLinkFileName = 'link~tmp._o_';
TIMPORTLIBNETWARE
*****************************************************************************}
procedure timportlibnetware.preparelib(const s : string);
begin
end;
procedure timportlibnetware.importprocedure(aprocdef:tprocdef;const module:string;index:longint;const name:string);
begin
{ insert sharedlibrary }
current_module.linkothersharedlibs.add(SplitName(module),link_always);
end;
procedure timportlibnetware.importvariable(vs:tglobalvarsym;const name,module:string);
begin
{ insert sharedlibrary }
current_module.linkothersharedlibs.add(SplitName(module),link_always);
{ reset the mangledname and turn off the dll_var option }
vs.set_mangledname(name);
exclude(vs.varoptions,vo_is_dll_var);
end;
procedure timportlibnetware.generatelib;
begin
end;
procedure timportlibnetware.generatelib;
var
i : longint;
ImportLibrary : TImportLibrary;
begin
for i:=0 to current_module.ImportLibraryList.Count-1 do
begin
ImportLibrary:=TImportLibrary(current_module.ImportLibraryList[i]);
current_module.linkothersharedlibs.add(ImportLibrary.Name,link_always);
end;
end;
{*****************************************************************************

57
compiler/systems/t_os2.pas
View File

@ -42,12 +42,10 @@ implementation
cutils,cclasses,
globtype,systems,symconst,symdef,
globals,verbose,fmodule,script,
import,link,i_os2;
import,link,i_os2,ogbase;
type
timportlibos2=class(timportlib)
procedure preparelib(const s:string);override;
procedure importprocedure(aprocdef:tprocdef;const module:string;index:longint;const name:string);override;
procedure generatelib;override;
end;
@ -262,24 +260,8 @@ begin
blockwrite(out_file,aout_str_tab,aout_str_size);
end;
procedure timportlibos2.preparelib(const s:string);
{This code triggers a lot of bugs in the compiler.
const armag='!<arch>'#10;
ar_magic:array[1..length(armag)] of char=armag;}
const ar_magic:array[1..8] of char='!<arch>'#10;
var
libname : string;
begin
libname:=FixFileName(S + Target_Info.StaticCLibExt);
seq_no:=1;
current_module.linkotherstaticlibs.add(libname,link_always);
assign(out_file,current_module.outputpath^+libname);
rewrite(out_file,1);
blockwrite(out_file,ar_magic,sizeof(ar_magic));
end;
procedure timportlibos2.importprocedure(aprocdef:tprocdef;const module:string;index:longint;const name:string);
procedure AddImport(const module:string;index:longint;const name:string);
{func = Name of function to import.
module = Name of DLL to import from.
index = Index of function in DLL. Use 0 to import by name.
@ -289,10 +271,6 @@ var tmp1,tmp2,tmp3:string;
fixup_mcount,fixup_import:longint;
func : string;
begin
{ force the current mangledname }
include(aprocdef.procoptions,po_has_mangledname);
func:=aprocdef.mangledname;
aout_init;
tmp2:=func;
if profile_flag and not (copy(func,1,4)='_16_') then
@ -335,11 +313,32 @@ begin
inc(seq_no);
end;
procedure timportlibos2.generatelib;
begin
close(out_file);
end;
procedure timportlibos2.generatelib;
const
ar_magic:array[1..8] of char='!<arch>'#10;
var
libname : string;
i,j : longint;
ImportLibrary : TImportLibrary;
ImportSymbol : TImportSymbol;
begin
for i:=0 to current_module.ImportLibraryList.Count-1 do
begin
ImportLibrary:=TImportLibrary(current_module.ImportLibraryList[i]);
LibName:=FixFileName(ImportLibrary.Name + Target_Info.StaticCLibExt);
seq_no:=1;
current_module.linkotherstaticlibs.add(libname,link_always);
assign(out_file,current_module.outputpath^+libname);
rewrite(out_file,1);
blockwrite(out_file,ar_magic,sizeof(ar_magic));
for j:=0 to ImportLibrary.ImportSymbolList.Count-1 do
begin
ImportSymbol:=TImportSymbol(ImportLibrary.ImportSymbolList[j]);
AddImport(ImportLibrary.Name,ImportSymbol.OrdNr,ImportSymbol.Name);
end;
close(out_file);
end;
end;
{****************************************************************************

47
compiler/systems/t_sunos.pas
View File

@ -39,13 +39,10 @@ implementation
symconst,script,
fmodule,aasmbase,aasmtai,aasmdata,aasmcpu,cpubase,symsym,symdef,
cgobj,
import,export,link,i_sunos;
import,export,link,i_sunos,ogbase;
type
timportlibsolaris=class(timportlib)
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;
end;
@ -73,37 +70,17 @@ implementation
TIMPORTLIBsolaris
*****************************************************************************}
procedure timportlibsolaris.preparelib(const s : string);
begin
{$ifDef LinkTest}
WriteLN('Prepare import: ',s);
{$EndIf}
end;
procedure timportlibsolaris.importprocedure(aprocdef:tprocdef;const module:string;index:longint;const name:string);
begin
{ insert sharedlibrary }
{$ifDef LinkTest}
WriteLN('Import: f:',func,' m:',module,' n:',name);
{$EndIf}
current_module.linkothersharedlibs.add(SplitName(module),link_always);
end;
procedure timportlibsolaris.importvariable(vs:tglobalvarsym;const name,module:string);
begin
{ insert sharedlibrary }
current_module.linkothersharedlibs.add(SplitName(module),link_always);
{ reset the mangledname and turn off the dll_var option }
vs.set_mangledname(name);
exclude(vs.varoptions,vo_is_dll_var);
end;
procedure timportlibsolaris.generatelib;
begin
end;
procedure timportlibsolaris.generatelib;
var
i : longint;
ImportLibrary : TImportLibrary;
begin
for i:=0 to current_module.ImportLibraryList.Count-1 do
begin
ImportLibrary:=TImportLibrary(current_module.ImportLibraryList[i]);
current_module.linkothersharedlibs.add(ImportLibrary.Name,link_always);
end;
end;
{*****************************************************************************

449
compiler/systems/t_win.pas
View File

@ -41,20 +41,11 @@ interface
tStr4=array[1..MAX_DEFAULT_EXTENSIONS] of string[4];
pStr4=^tStr4;
twin32imported_item = class(timported_item)
end;
TImportLibWin=class(timportlib)
private
procedure win32importproc(const module : string;index : longint;const name : string);
procedure importvariable_str(const s:string;const name,module:string);
procedure importprocedure_str(const 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;
end;
@ -121,95 +112,6 @@ implementation
TImportLibWin
*****************************************************************************}
procedure TImportLibWin.preparelib(const s : string);
begin
if current_asmdata.asmlists[al_imports]=nil then
current_asmdata.asmlists[al_imports]:=TAsmList.create;
end;
procedure TImportLibWin.win32importproc(const module : string;index : longint;const name : string);
var
hp1 : timportList;
hp2 : twin32imported_item;
hs : string;
begin
{ append extension if required }
hs:=AddExtension(module,target_info.sharedlibext);
{ search for the module }
hp1:=timportlist(current_module.imports.first);
while assigned(hp1) do
begin
if hs=hp1.dllname^ then
break;
hp1:=timportlist(hp1.next);
end;
{ generate a new item ? }
if not(assigned(hp1)) then
begin
hp1:=timportlist.create(hs);
current_module.imports.concat(hp1);
end;
{ search for reuse of old import item }
hp2:=twin32imported_item(hp1.imported_items.first);
while assigned(hp2) do
begin
if (hp2.name^=name) and (hp2.ordnr=index) then
break;
hp2:=twin32imported_item(hp2.next);
end;
if not assigned(hp2) then
begin
hp2:=twin32imported_item.create(name,name,index);
hp1.imported_items.concat(hp2);
end;
end;
procedure TImportLibWin.importprocedure(aprocdef:tprocdef;const module : string;index : longint;const name : string);
begin
win32importproc(module,index,name);
end;
procedure TImportLibWin.importprocedure_str(const module : string;index : longint;const name : string);
begin
win32importproc(module,index,name);
end;
procedure TImportLibWin.importvariable(vs:tglobalvarsym;const name,module:string);
begin
importvariable_str(vs.mangledname,name,module);
end;
procedure TImportLibWin.importvariable_str(const s:string;const name,module:string);
var
hp1 : timportList;
hp2 : twin32imported_item;
hs : string;
begin
hs:=AddExtension(module,target_info.sharedlibext);
{ search for the module }
hp1:=timportlist(current_module.imports.first);
while assigned(hp1) do
begin
if hs=hp1.dllname^ then
break;
hp1:=timportlist(hp1.next);
end;
{ generate a new item ? }
if not(assigned(hp1)) then
begin
hp1:=timportlist.create(hs);
current_module.imports.concat(hp1);
end;
hp2:=twin32imported_item.create_var(s,name);
hp1.imported_items.concat(hp2);
end;
procedure TImportLibWin.generateimportlib;
var
ObjWriter : tarobjectwriter;
@ -318,7 +220,7 @@ implementation
objdata.free;
end;
procedure AddImport(const afuncname:string;ordnr:word;isvar:boolean);
procedure AddImport(const afuncname:string;ordnr:longint;isvar:boolean);
const
{$ifdef x86_64}
jmpopcode : array[0..2] of byte = (
@ -423,8 +325,9 @@ implementation
end;
var
hp1 : timportList;
hp2 : twin32imported_item;
i,j : longint;
ImportLibrary : TImportLibrary;
ImportSymbol : TImportSymbol;
begin
AsmPrefix:='imp'+Lower(current_module.modulename^);
idatalabnr:=0;
@ -433,18 +336,16 @@ implementation
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
for i:=0 to current_module.ImportLibraryList.Count-1 do
begin
StartImport(hp1.dllname^);
hp2:=twin32imported_item(hp1.imported_items.first);
while assigned(hp2) do
ImportLibrary:=TImportLibrary(current_module.ImportLibraryList[i]);
StartImport(ImportLibrary.Name);
for j:=0 to ImportLibrary.ImportSymbolList.Count-1 do
begin
AddImport(hp2.name^,hp2.ordnr,hp2.is_var);
hp2:=twin32imported_item(hp2.next);
ImportSymbol:=TImportSymbol(ImportLibrary.ImportSymbolList[j]);
AddImport(ImportSymbol.Name,ImportSymbol.OrdNr,ImportSymbol.IsVar);
end;
EndImport;
hp1:=timportlist(hp1.next);
end;
ObjOutput.Free;
ObjWriter.Free;
@ -453,178 +354,181 @@ implementation
procedure TImportLibWin.generateidatasection;
var
hp1 : timportList;
hp2 : twin32imported_item;
templab,
l1,l2,l3,l4 {$ifdef ARM} ,l5 {$endif ARM} : tasmlabel;
importname : string;
suffix : integer;
href : treference;
i,j : longint;
ImportLibrary : TImportLibrary;
ImportSymbol : TImportSymbol;
ImportLabels : TFPList;
begin
if (target_asm.id in [as_i386_masm,as_i386_tasm,as_i386_nasmwin32]) then
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;
if current_asmdata.asmlists[al_imports]=nil then
current_asmdata.asmlists[al_imports]:=TAsmList.create;
hp1:=timportlist(current_module.imports.first);
while assigned(hp1) do
begin
{ align al_procedures for the jumps }
new_section(current_asmdata.asmlists[al_imports],sec_code,'',sizeof(aint));
{ Get labels for the sections }
current_asmdata.getjumplabel(l1);
current_asmdata.getjumplabel(l2);
current_asmdata.getjumplabel(l3);
new_section(current_asmdata.asmlists[al_imports],sec_idata2,'',0);
{ pointer to procedure names }
current_asmdata.asmlists[al_imports].concat(Tai_const.Create_rva_sym(l2));
{ two empty entries follow }
if (target_asm.id in [as_i386_masm,as_i386_tasm,as_i386_nasmwin32]) then
begin
new_section(current_asmdata.asmlists[al_imports],sec_code,'',0);
for i:=0 to current_module.ImportLibraryList.Count-1 do
begin
ImportLibrary:=TImportLibrary(current_module.ImportLibraryList[i]);
for j:=0 to ImportLibrary.ImportSymbolList.Count-1 do
begin
ImportSymbol:=TImportSymbol(ImportLibrary.ImportSymbolList[j]);
current_asmdata.asmlists[al_imports].concat(tai_directive.create(asd_extern,ImportSymbol.Name));
current_asmdata.asmlists[al_imports].concat(tai_directive.create(asd_nasm_import,ImportSymbol.Name+' '+ImportLibrary.Name+' '+ImportSymbol.Name));
end;
end;
exit;
end;
for i:=0 to current_module.ImportLibraryList.Count-1 do
begin
ImportLibrary:=TImportLibrary(current_module.ImportLibraryList[i]);
{ align al_procedures for the jumps }
new_section(current_asmdata.asmlists[al_imports],sec_code,'',sizeof(aint));
{ Get labels for the sections }
current_asmdata.getjumplabel(l1);
current_asmdata.getjumplabel(l2);
current_asmdata.getjumplabel(l3);
new_section(current_asmdata.asmlists[al_imports],sec_idata2,'',0);
{ pointer to procedure names }
current_asmdata.asmlists[al_imports].concat(Tai_const.Create_rva_sym(l2));
{ 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(l1));
{ pointer to fixups }
current_asmdata.asmlists[al_imports].concat(Tai_const.Create_rva_sym(l3));
{ only create one section for each else it will
create a lot of idata* }
{ first write the name references }
new_section(current_asmdata.asmlists[al_imports],sec_idata4,'',0);
current_asmdata.asmlists[al_imports].concat(Tai_label.Create(l2));
ImportLabels:=TFPList.Create;
ImportLabels.Count:=ImportLibrary.ImportSymbolList.Count;
for j:=0 to ImportLibrary.ImportSymbolList.Count-1 do
begin
ImportSymbol:=TImportSymbol(ImportLibrary.ImportSymbolList[j]);
current_asmdata.getjumplabel(templab);
ImportLabels[j]:=templab;
if ImportSymbol.Name<>'' then
begin
current_asmdata.asmlists[al_imports].concat(Tai_const.Create_rva_sym(TAsmLabel(ImportLabels[j])));
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 ImportSymbol.ordnr))
else
current_asmdata.asmlists[al_imports].concat(Tai_const.Create_32bit(longint($80000000) or ImportSymbol.ordnr));
end;
end;
{ finalize the names ... }
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));
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(l1));
{ pointer to fixups }
current_asmdata.asmlists[al_imports].concat(Tai_const.Create_rva_sym(l3));
{ only create one section for each else it will
create a lot of idata* }
{ 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_label.Create(l3));
{ first write the name references }
new_section(current_asmdata.asmlists[al_imports],sec_idata4,'',0);
current_asmdata.asmlists[al_imports].concat(Tai_label.Create(l2));
hp2:=twin32imported_item(hp1.imported_items.first);
while assigned(hp2) do
begin
current_asmdata.getjumplabel(tasmlabel(hp2.lab));
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 hp2.ordnr))
else
current_asmdata.asmlists[al_imports].concat(Tai_const.Create_32bit(longint($80000000) or hp2.ordnr));
end;
hp2:=twin32imported_item(hp2.next);
end;
{ finalize the names ... }
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));
{ 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_label.Create(l3));
hp2:=twin32imported_item(hp1.imported_items.first);
while assigned(hp2) do
begin
if not hp2.is_var then
begin
current_asmdata.getjumplabel(l4);
{$ifdef ARM}
current_asmdata.getjumplabel(l5);
{$endif ARM}
{ create indirect jump and }
{ place jump in al_procedures }
new_section(current_asmdata.asmlists[al_imports],sec_code,'',0);
if hp2.name^ <> '' then
current_asmdata.asmlists[al_imports].concat(Tai_symbol.Createname_global(hp2.name^,AT_FUNCTION,0))
else
current_asmdata.asmlists[al_imports].concat(Tai_symbol.Createname_global(splitfilename(hp1.dllname^)+'_index_'+tostr(hp2.ordnr),AT_FUNCTION,0));
current_asmdata.asmlists[al_imports].concat(tai_function_name.create(''));
{$ifdef ARM}
reference_reset_symbol(href,l5,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(l5));
reference_reset_symbol(href,l4,0);
current_asmdata.asmlists[al_imports].concat(tai_const.create_sym_offset(href.symbol,href.offset));
{$else ARM}
reference_reset_symbol(href,l4,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}
{ add jump field to al_imports }
new_section(current_asmdata.asmlists[al_imports],sec_idata5,'',0);
if (cs_debuginfo in aktmoduleswitches) then
begin
if assigned(hp2.name) then
for j:=0 to ImportLibrary.ImportSymbolList.Count-1 do
begin
ImportSymbol:=TImportSymbol(ImportLibrary.ImportSymbolList[j]);
if not ImportSymbol.IsVar then
begin
current_asmdata.getjumplabel(l4);
{$ifdef ARM}
current_asmdata.getjumplabel(l5);
{$endif ARM}
{ create indirect jump and }
{ place jump in al_procedures }
new_section(current_asmdata.asmlists[al_imports],sec_code,'',0);
if ImportSymbol.Name <> '' then
current_asmdata.asmlists[al_imports].concat(Tai_symbol.Createname_global(ImportSymbol.Name,AT_FUNCTION,0))
else
current_asmdata.asmlists[al_imports].concat(Tai_symbol.Createname_global(splitfilename(ImportLibrary.Name)+'_index_'+tostr(ImportSymbol.ordnr),AT_FUNCTION,0));
current_asmdata.asmlists[al_imports].concat(tai_function_name.create(''));
{$ifdef ARM}
reference_reset_symbol(href,l5,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(l5));
reference_reset_symbol(href,l4,0);
current_asmdata.asmlists[al_imports].concat(tai_const.create_sym_offset(href.symbol,href.offset));
{$else ARM}
reference_reset_symbol(href,l4,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}
{ add jump field to al_imports }
new_section(current_asmdata.asmlists[al_imports],sec_idata5,'',0);
if (cs_debuginfo in aktmoduleswitches) then
begin
if ImportSymbol.Name<>'' then
begin
importname:='__imp_'+hp2.name^;
importname:='__imp_'+ImportSymbol.Name;
suffix:=0;
while assigned(current_asmdata.getasmsymbol(importname)) do
begin
inc(suffix);
importname:='__imp_'+hp2.name^+'_'+tostr(suffix);
end;
begin
inc(suffix);
importname:='__imp_'+ImportSymbol.Name+'_'+tostr(suffix);
end;
current_asmdata.asmlists[al_imports].concat(tai_symbol.createname(importname,AT_FUNCTION,4));
end
else
else
begin
importname:='__imp_by_ordinal'+tostr(hp2.ordnr);
importname:='__imp_by_ordinal'+tostr(ImportSymbol.ordnr);
suffix:=0;
while assigned(current_asmdata.getasmsymbol(importname)) do
begin
inc(suffix);
importname:='__imp_by_ordinal'+tostr(hp2.ordnr)+'_'+tostr(suffix);
end;
begin
inc(suffix);
importname:='__imp_by_ordinal'+tostr(ImportSymbol.ordnr)+'_'+tostr(suffix);
end;
current_asmdata.asmlists[al_imports].concat(tai_symbol.createname(importname,AT_FUNCTION,4));
end;
end;
current_asmdata.asmlists[al_imports].concat(Tai_label.Create(l4));
end
else
begin
current_asmdata.asmlists[al_imports].concat(Tai_symbol.Createname_global(hp2.func^,AT_DATA,0));
end;
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));
hp2:=twin32imported_item(hp2.next);
end;
{ finalize the addresses }
end;
current_asmdata.asmlists[al_imports].concat(Tai_label.Create(l4));
end
else
current_asmdata.asmlists[al_imports].concat(Tai_symbol.Createname_global(ImportSymbol.Name,AT_DATA,0));
current_asmdata.asmlists[al_imports].concat(Tai_const.Create_rva_sym(TAsmLabel(Importlabels[j])));
if target_info.system=system_x86_64_win64 then
current_asmdata.asmlists[al_imports].concat(Tai_const.Create_32bit(0));
end;
{ finalize the addresses }
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));
if target_info.system=system_x86_64_win64 then
current_asmdata.asmlists[al_imports].concat(Tai_const.Create_32bit(0));
{ finally the import information }
new_section(current_asmdata.asmlists[al_imports],sec_idata6,'',0);
hp2:=twin32imported_item(hp1.imported_items.first);
while assigned(hp2) do
begin
current_asmdata.asmlists[al_imports].concat(Tai_label.Create(hp2.lab));
{ the ordinal number }
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;
{ create import dll name }
new_section(current_asmdata.asmlists[al_imports],sec_idata7,'',0);
current_asmdata.asmlists[al_imports].concat(Tai_label.Create(l1));
current_asmdata.asmlists[al_imports].concat(Tai_string.Create(hp1.dllname^+#0));
hp1:=timportlist(hp1.next);
end;
{ finally the import information }
new_section(current_asmdata.asmlists[al_imports],sec_idata6,'',0);
for j:=0 to ImportLibrary.ImportSymbolList.Count-1 do
begin
ImportSymbol:=TImportSymbol(ImportLibrary.ImportSymbolList[j]);
current_asmdata.asmlists[al_imports].concat(Tai_label.Create(TAsmLabel(ImportLabels[j])));
{ the ordinal number }
current_asmdata.asmlists[al_imports].concat(Tai_const.Create_16bit(ImportSymbol.ordnr));
current_asmdata.asmlists[al_imports].concat(Tai_string.Create(ImportSymbol.Name+#0));
current_asmdata.asmlists[al_imports].concat(Tai_align.Create_op(2,0));
end;
{ create import dll name }
new_section(current_asmdata.asmlists[al_imports],sec_idata7,'',0);
current_asmdata.asmlists[al_imports].concat(Tai_label.Create(l1));
current_asmdata.asmlists[al_imports].concat(Tai_string.Create(ImportLibrary.Name+#0));
ImportLabels.Free;
ImportLabels:=nil;
end;
end;
@ -938,7 +842,7 @@ implementation
else
s:='';
end;
p:=strpnew(#9+'export '+s+' '+hp.name^+' '+tostr(hp.index));
p:=strpnew(#9+'export '+s+' '+hp.Name^+' '+tostr(hp.index));
{current_asmdata.asmlists[al_exports].concat(tai_direct.create(p));}
hp:=texported_item(hp.next);
end;
@ -1719,26 +1623,19 @@ implementation
procedure TDLLScannerWin.CheckDLLFunc(const dllname,funcname:string);
var
hp : tExternalsItem;
i : longint;
ExtName : string;
begin
hp:=tExternalsItem(current_module.Externals.first);
while assigned(hp)do
for i:=0 to current_module.dllscannerinputlist.count-1 do
begin
if (not hp.found) and
assigned(hp.data) and
(hp.data^=funcname) then
ExtName:=current_module.dllscannerinputlist.NameOfIndex(i);
if (ExtName=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;
TImportLibWin(importlib).importprocedure_str(dllname,0,funcname);
current_module.AddExternalImport(dllname,funcname,0,false);
importfound:=true;
current_module.dllscannerinputlist.Delete(i);
exit;
end;
hp:=tExternalsItem(hp.next);
end;
end;
@ -1758,6 +1655,8 @@ implementation
exit;
importfound:=false;
ReadDLLImports(dllname,@CheckDLLFunc);
if importfound then
current_module.dllscannerinputlist.Pack;
result:=importfound;
end;

29
compiler/utils/ppudump.pp
View File

@ -425,6 +425,31 @@ begin
end;
Procedure ReadImportSymbols;
var
extlibname : string;
j,
extsymcnt : longint;
extsymname : string;
extsymordnr : longint;
extsymisvar : boolean;
begin
while not ppufile.endofentry do
begin
extlibname:=ppufile.getstring;
extsymcnt:=ppufile.getlongint;
writeln('External Library: ',extlibname,' (',extsymcnt,' imports)');
for j:=0 to extsymcnt-1 do
begin
extsymname:=ppufile.getstring;
extsymordnr:=ppufile.getlongint;
extsymisvar:=ppufile.getbyte<>0;
writeln(' ',extsymname,' (OrdNr: ',extsymordnr,' IsVar: ',extsymisvar,')');
end;
end;
end;
Procedure ReadDerefdata;
begin
derefdatalen:=ppufile.entrysize;
@ -1994,8 +2019,8 @@ begin
iblinkothersharedlibs :
ReadLinkContainer('Link other shared lib: ');
iblinkdlls :
ReadLinkContainer('Link DLLs: ');
ibImportSymbols :
ReadImportSymbols;
ibderefdata :
ReadDerefData;