From bf1c390027c44c049eff10daf70799a5a8f254af Mon Sep 17 00:00:00 2001
From: peter <peter@freepascal.org>
Date: Sun, 3 Sep 2006 19:22:31 +0000
Subject: [PATCH] * refactor import library generation * support variable
imports in internal linker
git-svn-id: trunk@4544 -
---
compiler/cclasses.pas | 20 +-
compiler/fmodule.pas | 82 +--
compiler/fppu.pas | 58 +-
compiler/import.pas | 92 ---
compiler/link.pas | 1305 +++++++++++++++++-----------------
compiler/ogbase.pas | 45 +-
compiler/ogcoff.pas | 66 +-
compiler/pdecvar.pas | 23 +-
compiler/pmodules.pas | 4 +-
compiler/ppu.pas | 4 +-
compiler/psub.pas | 16 +-
compiler/systems/t_beos.pas | 41 +-
compiler/systems/t_bsd.pas | 71 +-
compiler/systems/t_emx.pas | 58 +-
compiler/systems/t_linux.pas | 41 +-
compiler/systems/t_macos.pas | 39 +-
compiler/systems/t_nwl.pas | 41 +-
compiler/systems/t_nwm.pas | 41 +-
compiler/systems/t_os2.pas | 57 +-
compiler/systems/t_sunos.pas | 47 +-
compiler/systems/t_win.pas | 449 +++++-------
compiler/utils/ppudump.pp | 29 +-
22 files changed, 1173 insertions(+), 1456 deletions(-)
diff --git a/compiler/cclasses.pas b/compiler/cclasses.pas
index 30421f41ae..95d785f057 100644
--- a/compiler/cclasses.pas
+++ b/compiler/cclasses.pas
@@ -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;
diff --git a/compiler/fmodule.pas b/compiler/fmodule.pas
index 9fe6fb9f21..203f4ff03a 100644
--- a/compiler/fmodule.pas
+++ b/compiler/fmodule.pas
@@ -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.
diff --git a/compiler/fppu.pas b/compiler/fppu.pas
index 05ee870172..6c137554b5 100644
--- a/compiler/fppu.pas
+++ b/compiler/fppu.pas
@@ -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
diff --git a/compiler/import.pas b/compiler/import.pas
index 829981ac12..c8bc844c50 100644
--- a/compiler/import.pas
+++ b/compiler/import.pas
@@ -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;
diff --git a/compiler/link.pas b/compiler/link.pas
index 540195ec30..76b1205003 100644
--- a/compiler/link.pas
+++ b/compiler/link.pas
@@ -25,188 +25,186 @@ unit link;
{$i fpcdefs.inc}
interface
-uses
- cclasses,
- systems,
- fmodule,
- globtype,
- ogbase;
-Type
- TLinkerInfo=record
- ExeCmd,
- DllCmd : array[1..3] of string;
- ResName : string[100];
- ScriptName : string[100];
- ExtraOptions : string;
- DynamicLinker : string[100];
- end;
+ uses
+ cclasses,
+ systems,
+ fmodule,
+ globtype,
+ ogbase;
- TLinker = class(TAbstractLinker)
- private
- procedure AddProcdefImports(p:tnamedindexitem;arg:pointer);
- public
- HasResources,
- HasExports : boolean;
- ObjectFiles,
- SharedLibFiles,
- StaticLibFiles : TStringList;
- Constructor Create;virtual;
- Destructor Destroy;override;
- procedure AddModuleFiles(hp:tmodule);
- procedure AddExternalSymbol(const libname,symname:string;ordnumber: longint);virtual;
- Procedure AddObject(const S,unitpath : String;isunit:boolean);
- Procedure AddStaticLibrary(const S : String);
- Procedure AddSharedLibrary(S : String);
- Procedure AddStaticCLibrary(const S : String);
- Procedure AddSharedCLibrary(S : String);
- Function MakeExecutable:boolean;virtual;
- Function MakeSharedLibrary:boolean;virtual;
- Function MakeStaticLibrary:boolean;virtual;
- procedure ExpandAndApplyOrder(var Src:TStringList);
- procedure LoadPredefinedLibraryOrder;virtual;
- function ReOrderEntries : boolean;
- end;
+ Type
+ TLinkerInfo=record
+ ExeCmd,
+ DllCmd : array[1..3] of string;
+ ResName : string[100];
+ ScriptName : string[100];
+ ExtraOptions : string;
+ DynamicLinker : string[100];
+ end;
- TExternalLinker = class(TLinker)
- public
- Info : TLinkerInfo;
- Constructor Create;override;
- Destructor Destroy;override;
- Function FindUtil(const s:string):String;
- Function DoExec(const command:string; para:TCmdStr;showinfo,useshell:boolean):boolean;
- procedure SetDefaultInfo;virtual;
- Function MakeStaticLibrary:boolean;override;
- end;
+ TLinker = class(TAbstractLinker)
+ public
+ HasResources,
+ HasExports : boolean;
+ ObjectFiles,
+ SharedLibFiles,
+ StaticLibFiles : TStringList;
+ Constructor Create;virtual;
+ Destructor Destroy;override;
+ procedure AddModuleFiles(hp:tmodule);
+ Procedure AddObject(const S,unitpath : String;isunit:boolean);
+ Procedure AddStaticLibrary(const S : String);
+ Procedure AddSharedLibrary(S : String);
+ Procedure AddStaticCLibrary(const S : String);
+ Procedure AddSharedCLibrary(S : String);
+ procedure AddImportSymbol(const libname,symname:string;OrdNr: longint;isvar:boolean);virtual;
+ Function MakeExecutable:boolean;virtual;
+ Function MakeSharedLibrary:boolean;virtual;
+ Function MakeStaticLibrary:boolean;virtual;
+ procedure ExpandAndApplyOrder(var Src:TStringList);
+ procedure LoadPredefinedLibraryOrder;virtual;
+ function ReOrderEntries : boolean;
+ end;
- TInternalLinker = class(TLinker)
- private
- FCExeOutput : TExeOutputClass;
- FCObjInput : TObjInputClass;
- { Libraries }
- FStaticLibraryList : TFPHashObjectList;
- FExternalLibraryList : TFPHashObjectList;
- procedure Load_ReadObject(const para:string);
- procedure Load_ReadStaticLibrary(const para:string);
- procedure ParseScript_Load;
- procedure ParseScript_Order;
- procedure ParseScript_CalcPos;
- procedure PrintLinkerScript;
- function RunLinkScript(const outputname:string):boolean;
- protected
- property CObjInput:TObjInputClass read FCObjInput write FCObjInput;
- property CExeOutput:TExeOutputClass read FCExeOutput write FCExeOutput;
- property StaticLibraryList:TFPHashObjectList read FStaticLibraryList;
- property ExternalLibraryList:TFPHashObjectList read FExternalLibraryList;
- procedure DefaultLinkScript;virtual;abstract;
- linkscript : TStringList;
- public
- IsSharedLibrary : boolean;
- Constructor Create;override;
- Destructor Destroy;override;
- Function MakeExecutable:boolean;override;
- Function MakeSharedLibrary:boolean;override;
- procedure AddExternalSymbol(const libname,symname:string;ordnumber: longint);override;
- end;
+ TExternalLinker = class(TLinker)
+ public
+ Info : TLinkerInfo;
+ Constructor Create;override;
+ Destructor Destroy;override;
+ Function FindUtil(const s:string):String;
+ Function DoExec(const command:string; para:TCmdStr;showinfo,useshell:boolean):boolean;
+ procedure SetDefaultInfo;virtual;
+ Function MakeStaticLibrary:boolean;override;
+ end;
+ TInternalLinker = class(TLinker)
+ private
+ FCExeOutput : TExeOutputClass;
+ FCObjInput : TObjInputClass;
+ { Libraries }
+ FStaticLibraryList : TFPHashObjectList;
+ FImportLibraryList : TFPHashObjectList;
+ procedure Load_ReadObject(const para:string);
+ procedure Load_ReadStaticLibrary(const para:string);
+ procedure ParseScript_Load;
+ procedure ParseScript_Order;
+ procedure ParseScript_CalcPos;
+ procedure PrintLinkerScript;
+ function RunLinkScript(const outputname:string):boolean;
+ protected
+ property CObjInput:TObjInputClass read FCObjInput write FCObjInput;
+ property CExeOutput:TExeOutputClass read FCExeOutput write FCExeOutput;
+ property StaticLibraryList:TFPHashObjectList read FStaticLibraryList;
+ property ImportLibraryList:TFPHashObjectList read FImportLibraryList;
+ procedure DefaultLinkScript;virtual;abstract;
+ linkscript : TStringList;
+ public
+ IsSharedLibrary : boolean;
+ Constructor Create;override;
+ Destructor Destroy;override;
+ Function MakeExecutable:boolean;override;
+ Function MakeSharedLibrary:boolean;override;
+ procedure AddImportSymbol(const libname,symname:string;OrdNr: longint;isvar:boolean);override;
+ end;
-var
- Linker : TLinker;
+ var
+ Linker : TLinker;
-function FindObjectFile(s : string;const unitpath:string;isunit:boolean) : string;
-function FindLibraryFile(s:string;const prefix,ext:string;var foundfile : string) : boolean;
-function FindDLL(const s:string;var founddll:string):boolean;
+ function FindObjectFile(s : string;const unitpath:string;isunit:boolean) : string;
+ function FindLibraryFile(s:string;const prefix,ext:string;var foundfile : string) : boolean;
+ function FindDLL(const s:string;var founddll:string):boolean;
-procedure InitLinker;
-procedure DoneLinker;
+ procedure InitLinker;
+ procedure DoneLinker;
Implementation
-uses
-{$IFDEF USE_SYSUTILS}
- SysUtils,
-{$ELSE USE_SYSUTILS}
- dos,
-{$ENDIF USE_SYSUTILS}
- cutils,
- script,globals,verbose,comphook,ppu,
- aasmbase,aasmtai,aasmdata,aasmcpu,
- symbase,symdef,symtype,symconst,
- owbase,owar,ogmap;
+ uses
+ {$IFDEF USE_SYSUTILS}
+ SysUtils,
+ {$ELSE USE_SYSUTILS}
+ dos,
+ {$ENDIF USE_SYSUTILS}
+ cutils,
+ script,globals,verbose,comphook,ppu,
+ aasmbase,aasmtai,aasmdata,aasmcpu,
+// symbase,symdef,symtype,symconst,
+ owbase,owar,ogmap;
-type
- TLinkerClass = class of Tlinker;
+ type
+ TLinkerClass = class of Tlinker;
{*****************************************************************************
Helpers
*****************************************************************************}
-{ searches an object file }
-function FindObjectFile(s:string;const unitpath:string;isunit:boolean) : string;
-var
- found : boolean;
- foundfile : string;
-begin
- findobjectfile:='';
- if s='' then
- exit;
-
- {When linking on target, the units has not been assembled yet,
- so there is no object files to look for at
- the host. Look for the corresponding assembler file instead,
- because it will be assembled to object file on the target.}
- if isunit and (cs_link_on_target in aktglobalswitches) then
- s:= ForceExtension(s,target_info.asmext);
-
- { when it does not belong to the unit then check if
- the specified file exists without searching any paths }
- if not isunit then
- begin
- if FileExists(FixFileName(s)) then
+ { searches an object file }
+ function FindObjectFile(s:string;const unitpath:string;isunit:boolean) : string;
+ var
+ found : boolean;
+ foundfile : string;
begin
- foundfile:=ScriptFixFileName(s);
- found:=true;
+ findobjectfile:='';
+ if s='' then
+ exit;
+
+ {When linking on target, the units has not been assembled yet,
+ so there is no object files to look for at
+ the host. Look for the corresponding assembler file instead,
+ because it will be assembled to object file on the target.}
+ if isunit and (cs_link_on_target in aktglobalswitches) then
+ s:= ForceExtension(s,target_info.asmext);
+
+ { when it does not belong to the unit then check if
+ the specified file exists without searching any paths }
+ if not isunit then
+ begin
+ if FileExists(FixFileName(s)) then
+ begin
+ foundfile:=ScriptFixFileName(s);
+ found:=true;
+ end;
+ end;
+ if pos('.',s)=0 then
+ s:=s+target_info.objext;
+ { find object file
+ 1. output unit path
+ 2. output exe path
+ 3. specified unit path (if specified)
+ 4. cwd
+ 5. unit search path
+ 6. local object path
+ 7. global object path
+ 8. exepath (not when linking on target) }
+ found:=false;
+ if isunit and (OutputUnitDir<>'') then
+ found:=FindFile(s,OutPutUnitDir,foundfile)
+ else
+ if OutputExeDir<>'' then
+ found:=FindFile(s,OutPutExeDir,foundfile);
+ if (not found) and (unitpath<>'') then
+ found:=FindFile(s,unitpath,foundfile);
+ if (not found) then
+ found:=FindFile(s, CurDirRelPath(source_info), foundfile);
+ if (not found) then
+ found:=UnitSearchPath.FindFile(s,foundfile);
+ if (not found) then
+ found:=current_module.localobjectsearchpath.FindFile(s,foundfile);
+ if (not found) then
+ found:=objectsearchpath.FindFile(s,foundfile);
+ if not(cs_link_on_target in aktglobalswitches) and (not found) then
+ found:=FindFile(s,exepath,foundfile);
+ if not(cs_link_nolink in aktglobalswitches) and (not found) then
+ Message1(exec_w_objfile_not_found,s);
+
+ {Restore file extension}
+ if isunit and (cs_link_on_target in aktglobalswitches) then
+ foundfile:= ForceExtension(foundfile,target_info.objext);
+
+ findobjectfile:=ScriptFixFileName(foundfile);
end;
- end;
- if pos('.',s)=0 then
- s:=s+target_info.objext;
- { find object file
- 1. output unit path
- 2. output exe path
- 3. specified unit path (if specified)
- 4. cwd
- 5. unit search path
- 6. local object path
- 7. global object path
- 8. exepath (not when linking on target) }
- found:=false;
- if isunit and (OutputUnitDir<>'') then
- found:=FindFile(s,OutPutUnitDir,foundfile)
- else
- if OutputExeDir<>'' then
- found:=FindFile(s,OutPutExeDir,foundfile);
- if (not found) and (unitpath<>'') then
- found:=FindFile(s,unitpath,foundfile);
- if (not found) then
- found:=FindFile(s, CurDirRelPath(source_info), foundfile);
- if (not found) then
- found:=UnitSearchPath.FindFile(s,foundfile);
- if (not found) then
- found:=current_module.localobjectsearchpath.FindFile(s,foundfile);
- if (not found) then
- found:=objectsearchpath.FindFile(s,foundfile);
- if not(cs_link_on_target in aktglobalswitches) and (not found) then
- found:=FindFile(s,exepath,foundfile);
- if not(cs_link_nolink in aktglobalswitches) and (not found) then
- Message1(exec_w_objfile_not_found,s);
-
- {Restore file extension}
- if isunit and (cs_link_on_target in aktglobalswitches) then
- foundfile:= ForceExtension(foundfile,target_info.objext);
-
- findobjectfile:=ScriptFixFileName(foundfile);
-end;
{ searches a (windows) DLL file }
@@ -241,534 +239,535 @@ end;
end;
-{ searches an library file }
-function FindLibraryFile(s:string;const prefix,ext:string;var foundfile : string) : boolean;
-var
- found : boolean;
- paths : string;
-begin
- findlibraryfile:=false;
- foundfile:=s;
- if s='' then
- exit;
- { split path from filename }
- paths:=SplitPath(s);
- s:=SplitFileName(s);
- { add prefix 'lib' }
- if (prefix<>'') and (Copy(s,1,length(prefix))<>prefix) then
- s:=prefix+s;
- { add extension }
- if (ext<>'') and (Copy(s,length(s)-length(ext)+1,length(ext))<>ext) then
- s:=s+ext;
- { readd the split path }
- s:=paths+s;
- if FileExists(s) then
- begin
- foundfile:=ScriptFixFileName(s);
- FindLibraryFile:=true;
- exit;
- end;
- { find libary
- 1. cwd
- 2. local libary dir
- 3. global libary dir
- 4. exe path of the compiler (not when linking on target) }
- found:=FindFile(s, CurDirRelPath(source_info), foundfile);
- if (not found) and (current_module.outputpath^<>'') then
- found:=FindFile(s,current_module.outputpath^,foundfile);
- if (not found) then
- found:=current_module.locallibrarysearchpath.FindFile(s,foundfile);
- if (not found) then
- found:=librarysearchpath.FindFile(s,foundfile);
- if not(cs_link_on_target in aktglobalswitches) and (not found) then
- found:=FindFile(s,exepath,foundfile);
- foundfile:=ScriptFixFileName(foundfile);
- findlibraryfile:=found;
-end;
+ { searches an library file }
+ function FindLibraryFile(s:string;const prefix,ext:string;var foundfile : string) : boolean;
+ var
+ found : boolean;
+ paths : string;
+ begin
+ findlibraryfile:=false;
+ foundfile:=s;
+ if s='' then
+ exit;
+ { split path from filename }
+ paths:=SplitPath(s);
+ s:=SplitFileName(s);
+ { add prefix 'lib' }
+ if (prefix<>'') and (Copy(s,1,length(prefix))<>prefix) then
+ s:=prefix+s;
+ { add extension }
+ if (ext<>'') and (Copy(s,length(s)-length(ext)+1,length(ext))<>ext) then
+ s:=s+ext;
+ { readd the split path }
+ s:=paths+s;
+ if FileExists(s) then
+ begin
+ foundfile:=ScriptFixFileName(s);
+ FindLibraryFile:=true;
+ exit;
+ end;
+ { find libary
+ 1. cwd
+ 2. local libary dir
+ 3. global libary dir
+ 4. exe path of the compiler (not when linking on target) }
+ found:=FindFile(s, CurDirRelPath(source_info), foundfile);
+ if (not found) and (current_module.outputpath^<>'') then
+ found:=FindFile(s,current_module.outputpath^,foundfile);
+ if (not found) then
+ found:=current_module.locallibrarysearchpath.FindFile(s,foundfile);
+ if (not found) then
+ found:=librarysearchpath.FindFile(s,foundfile);
+ if not(cs_link_on_target in aktglobalswitches) and (not found) then
+ found:=FindFile(s,exepath,foundfile);
+ foundfile:=ScriptFixFileName(foundfile);
+ findlibraryfile:=found;
+ end;
{*****************************************************************************
TLINKER
*****************************************************************************}
-Constructor TLinker.Create;
-begin
- Inherited Create;
- ObjectFiles:=TStringList.Create_no_double;
- SharedLibFiles:=TStringList.Create_no_double;
- StaticLibFiles:=TStringList.Create_no_double;
-end;
-
-
-Destructor TLinker.Destroy;
-begin
- ObjectFiles.Free;
- SharedLibFiles.Free;
- StaticLibFiles.Free;
-end;
-
-
-procedure TLinker.AddProcdefImports(p:tnamedindexitem;arg:pointer);
-begin
- if tdef(p).deftype<>procdef then
- exit;
- with tprocdef(p) do
- if assigned(import_dll) then
- if assigned(import_name) then
- AddExternalSymbol(import_dll^,import_name^,-import_nr)
- else
- if import_nr<>0 then
- AddExternalSymbol(import_dll^,import_dll^+'_index_'+tostr(import_nr),import_nr);
-end;
-
-
-procedure TLinker.AddModuleFiles(hp:tmodule);
-var
- mask : longint;
-begin
- with hp do
- begin
- if (flags and uf_has_resourcefiles)<>0 then
- HasResources:=true;
- if (flags and uf_has_exports)<>0 then
- HasExports:=true;
- { link unit files }
- if (flags and uf_no_link)=0 then
+ Constructor TLinker.Create;
begin
- { create mask which unit files need linking }
- mask:=link_always;
- { static linking ? }
- if (cs_link_static in aktglobalswitches) then
- begin
- if (flags and uf_static_linked)=0 then
- begin
- { if smart not avail then try static linking }
- if (flags and uf_smart_linked)<>0 then
- begin
- Message1(exec_t_unit_not_static_linkable_switch_to_smart,modulename^);
- mask:=mask or link_smart;
- end
- else
- Message1(exec_e_unit_not_smart_or_static_linkable,modulename^);
- end
- else
- mask:=mask or link_static;
- end;
- { smart linking ? }
- if (cs_link_smart in aktglobalswitches) then
- begin
- if (flags and uf_smart_linked)=0 then
- begin
- { if smart not avail then try static linking }
- if (flags and uf_static_linked)<>0 then
- begin
- Message1(exec_t_unit_not_smart_linkable_switch_to_static,modulename^);
- mask:=mask or link_static;
- end
- else
- Message1(exec_e_unit_not_smart_or_static_linkable,modulename^);
- end
- else
- mask:=mask or link_smart;
- end;
- { shared linking }
- if (cs_link_shared in aktglobalswitches) then
- begin
- if (flags and uf_shared_linked)=0 then
- begin
- { if shared not avail then try static linking }
- if (flags and uf_static_linked)<>0 then
- begin
- Message1(exec_t_unit_not_shared_linkable_switch_to_static,modulename^);
- mask:=mask or link_static;
- end
- else
- Message1(exec_e_unit_not_shared_or_static_linkable,modulename^);
- end
- else
- mask:=mask or link_shared;
- end;
- { unit files }
- while not linkunitofiles.empty do
- AddObject(linkunitofiles.getusemask(mask),path^,true);
- while not linkunitstaticlibs.empty do
- AddStaticLibrary(linkunitstaticlibs.getusemask(mask));
- while not linkunitsharedlibs.empty do
- AddSharedLibrary(linkunitsharedlibs.getusemask(mask));
+ Inherited Create;
+ ObjectFiles:=TStringList.Create_no_double;
+ SharedLibFiles:=TStringList.Create_no_double;
+ StaticLibFiles:=TStringList.Create_no_double;
end;
- { Other needed .o and libs, specified using $L,$LINKLIB,external }
- mask:=link_always;
- while not linkotherofiles.empty do
- AddObject(linkotherofiles.Getusemask(mask),path^,false);
- while not linkotherstaticlibs.empty do
- AddStaticCLibrary(linkotherstaticlibs.Getusemask(mask));
- while not linkothersharedlibs.empty do
- AddSharedCLibrary(linkothersharedlibs.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;ordnumber: longint);
+ Destructor TLinker.Destroy;
+ begin
+ ObjectFiles.Free;
+ SharedLibFiles.Free;
+ StaticLibFiles.Free;
+ end;
+
+
+ procedure TLinker.AddModuleFiles(hp:tmodule);
+ var
+ mask : longint;
+ i,j : longint;
+ ImportLibrary : TImportLibrary;
+ ImportSymbol : TImportSymbol;
+ begin
+ with hp do
+ begin
+ if (flags and uf_has_resourcefiles)<>0 then
+ HasResources:=true;
+ if (flags and uf_has_exports)<>0 then
+ HasExports:=true;
+ { link unit files }
+ if (flags and uf_no_link)=0 then
+ begin
+ { create mask which unit files need linking }
+ mask:=link_always;
+ { static linking ? }
+ if (cs_link_static in aktglobalswitches) then
+ begin
+ if (flags and uf_static_linked)=0 then
+ begin
+ { if smart not avail then try static linking }
+ if (flags and uf_smart_linked)<>0 then
+ begin
+ Message1(exec_t_unit_not_static_linkable_switch_to_smart,modulename^);
+ mask:=mask or link_smart;
+ end
+ else
+ Message1(exec_e_unit_not_smart_or_static_linkable,modulename^);
+ end
+ else
+ mask:=mask or link_static;
+ end;
+ { smart linking ? }
+ if (cs_link_smart in aktglobalswitches) then
+ begin
+ if (flags and uf_smart_linked)=0 then
+ begin
+ { if smart not avail then try static linking }
+ if (flags and uf_static_linked)<>0 then
+ begin
+ Message1(exec_t_unit_not_smart_linkable_switch_to_static,modulename^);
+ mask:=mask or link_static;
+ end
+ else
+ Message1(exec_e_unit_not_smart_or_static_linkable,modulename^);
+ end
+ else
+ mask:=mask or link_smart;
+ end;
+ { shared linking }
+ if (cs_link_shared in aktglobalswitches) then
+ begin
+ if (flags and uf_shared_linked)=0 then
+ begin
+ { if shared not avail then try static linking }
+ if (flags and uf_static_linked)<>0 then
+ begin
+ Message1(exec_t_unit_not_shared_linkable_switch_to_static,modulename^);
+ mask:=mask or link_static;
+ end
+ else
+ Message1(exec_e_unit_not_shared_or_static_linkable,modulename^);
+ end
+ else
+ mask:=mask or link_shared;
+ end;
+ { unit files }
+ while not linkunitofiles.empty do
+ AddObject(linkunitofiles.getusemask(mask),path^,true);
+ while not linkunitstaticlibs.empty do
+ AddStaticLibrary(linkunitstaticlibs.getusemask(mask));
+ while not linkunitsharedlibs.empty do
+ AddSharedLibrary(linkunitsharedlibs.getusemask(mask));
+ end;
+ { Other needed .o and libs, specified using $L,$LINKLIB,external }
+ mask:=link_always;
+ while not linkotherofiles.empty do
+ AddObject(linkotherofiles.Getusemask(mask),path^,false);
+ while not linkotherstaticlibs.empty do
+ AddStaticCLibrary(linkotherstaticlibs.Getusemask(mask));
+ while not linkothersharedlibs.empty do
+ AddSharedCLibrary(linkothersharedlibs.Getusemask(mask));
+ { Known Library/DLL Imports }
+ for i:=0 to ImportLibraryList.Count-1 do
+ begin
+ ImportLibrary:=TImportLibrary(ImportLibraryList[i]);
+ for j:=0 to ImportLibrary.ImportSymbolList.Count-1 do
+ begin
+ ImportSymbol:=TImportSymbol(ImportLibrary.ImportSymbolList[j]);
+ AddImportSymbol(ImportLibrary.Name,ImportSymbol.Name,ImportSymbol.OrdNr,ImportSymbol.IsVar);
+ end;
+ end;
+ end;
+ end;
+
+
+ procedure TLinker.AddImportSymbol(const libname,symname:string;OrdNr: longint;isvar:boolean);
begin
end;
-Procedure TLinker.AddObject(const S,unitpath : String;isunit:boolean);
-begin
- ObjectFiles.Concat(FindObjectFile(s,unitpath,isunit));
-end;
+ Procedure TLinker.AddObject(const S,unitpath : String;isunit:boolean);
+ begin
+ ObjectFiles.Concat(FindObjectFile(s,unitpath,isunit));
+ end;
-Procedure TLinker.AddSharedLibrary(S:String);
-begin
- if s='' then
- exit;
-{ remove prefix 'lib' }
- if Copy(s,1,length(target_info.sharedlibprefix))=target_info.sharedlibprefix then
- Delete(s,1,length(target_info.sharedlibprefix));
-{ remove extension if any }
- if Copy(s,length(s)-length(target_info.sharedlibext)+1,length(target_info.sharedlibext))=target_info.sharedlibext then
- Delete(s,length(s)-length(target_info.sharedlibext)+1,length(target_info.sharedlibext)+1);
-{ ready to be added }
- SharedLibFiles.Concat(S);
-end;
+ Procedure TLinker.AddSharedLibrary(S:String);
+ begin
+ if s='' then
+ exit;
+ { remove prefix 'lib' }
+ if Copy(s,1,length(target_info.sharedlibprefix))=target_info.sharedlibprefix then
+ Delete(s,1,length(target_info.sharedlibprefix));
+ { remove extension if any }
+ if Copy(s,length(s)-length(target_info.sharedlibext)+1,length(target_info.sharedlibext))=target_info.sharedlibext then
+ Delete(s,length(s)-length(target_info.sharedlibext)+1,length(target_info.sharedlibext)+1);
+ { ready to be added }
+ SharedLibFiles.Concat(S);
+ end;
-Procedure TLinker.AddStaticLibrary(const S:String);
-var
- ns : string;
- found : boolean;
-begin
- if s='' then
- exit;
- found:=FindLibraryFile(s,target_info.staticlibprefix,target_info.staticlibext,ns);
- if not(cs_link_nolink in aktglobalswitches) and (not found) then
- Message1(exec_w_libfile_not_found,s);
- StaticLibFiles.Concat(ns);
-end;
+ Procedure TLinker.AddStaticLibrary(const S:String);
+ var
+ ns : string;
+ found : boolean;
+ begin
+ if s='' then
+ exit;
+ found:=FindLibraryFile(s,target_info.staticlibprefix,target_info.staticlibext,ns);
+ if not(cs_link_nolink in aktglobalswitches) and (not found) then
+ Message1(exec_w_libfile_not_found,s);
+ StaticLibFiles.Concat(ns);
+ end;
-Procedure TLinker.AddSharedCLibrary(S:String);
-begin
- if s='' then
- exit;
-{ remove prefix 'lib' }
- if Copy(s,1,length(target_info.sharedclibprefix))=target_info.sharedclibprefix then
- Delete(s,1,length(target_info.sharedclibprefix));
-{ remove extension if any }
- if Copy(s,length(s)-length(target_info.sharedclibext)+1,length(target_info.sharedclibext))=target_info.sharedclibext then
- Delete(s,length(s)-length(target_info.sharedclibext)+1,length(target_info.sharedclibext)+1);
-{ ready to be added }
- SharedLibFiles.Concat(S);
-end;
+ Procedure TLinker.AddSharedCLibrary(S:String);
+ begin
+ if s='' then
+ exit;
+ { remove prefix 'lib' }
+ if Copy(s,1,length(target_info.sharedclibprefix))=target_info.sharedclibprefix then
+ Delete(s,1,length(target_info.sharedclibprefix));
+ { remove extension if any }
+ if Copy(s,length(s)-length(target_info.sharedclibext)+1,length(target_info.sharedclibext))=target_info.sharedclibext then
+ Delete(s,length(s)-length(target_info.sharedclibext)+1,length(target_info.sharedclibext)+1);
+ { ready to be added }
+ SharedLibFiles.Concat(S);
+ end;
-Procedure TLinker.AddStaticCLibrary(const S:String);
-var
- ns : string;
- found : boolean;
-begin
- if s='' then
- exit;
- found:=FindLibraryFile(s,target_info.staticclibprefix,target_info.staticclibext,ns);
- if not(cs_link_nolink in aktglobalswitches) and (not found) then
- Message1(exec_w_libfile_not_found,s);
- StaticLibFiles.Concat(ns);
-end;
+ Procedure TLinker.AddStaticCLibrary(const S:String);
+ var
+ ns : string;
+ found : boolean;
+ begin
+ if s='' then
+ exit;
+ found:=FindLibraryFile(s,target_info.staticclibprefix,target_info.staticclibext,ns);
+ if not(cs_link_nolink in aktglobalswitches) and (not found) then
+ Message1(exec_w_libfile_not_found,s);
+ StaticLibFiles.Concat(ns);
+ end;
-function TLinker.MakeExecutable:boolean;
-begin
- MakeExecutable:=false;
- Message(exec_e_exe_not_supported);
-end;
+ procedure AddImportSymbol(const libname,symname:string;OrdNr: longint;isvar:boolean);
+ begin
+ end;
-Function TLinker.MakeSharedLibrary:boolean;
-begin
- MakeSharedLibrary:=false;
- Message(exec_e_dll_not_supported);
-end;
+ function TLinker.MakeExecutable:boolean;
+ begin
+ MakeExecutable:=false;
+ Message(exec_e_exe_not_supported);
+ end;
-Function TLinker.MakeStaticLibrary:boolean;
-begin
- MakeStaticLibrary:=false;
- Message(exec_e_dll_not_supported);
-end;
+ Function TLinker.MakeSharedLibrary:boolean;
+ begin
+ MakeSharedLibrary:=false;
+ Message(exec_e_dll_not_supported);
+ end;
-Procedure TLinker.ExpandAndApplyOrder(var Src:TStringList);
-var p : TLinkStrMap;
- i : Integer;
-begin
- // call Virtual TLinker method to initialize
- LoadPredefinedLibraryOrder;
+ Function TLinker.MakeStaticLibrary:boolean;
+ begin
+ MakeStaticLibrary:=false;
+ Message(exec_e_dll_not_supported);
+ end;
- // something to do?
- if (LinkLibraryAliases.count=0) and (LinkLibraryOrder.Count=0) Then
- exit;
- p:=TLinkStrMap.Create;
- // expand libaliases, clears src
- LinkLibraryAliases.expand(src,p);
+ Procedure TLinker.ExpandAndApplyOrder(var Src:TStringList);
+ var
+ p : TLinkStrMap;
+ i : longint;
+ begin
+ // call Virtual TLinker method to initialize
+ LoadPredefinedLibraryOrder;
- // writeln(src.count,' ',p.count,' ',linklibraryorder.count,' ',linklibraryaliases.count);
- // apply order
- p.UpdateWeights(LinkLibraryOrder);
- p.SortOnWeight;
+ // something to do?
+ if (LinkLibraryAliases.count=0) and (LinkLibraryOrder.Count=0) Then
+ exit;
+ p:=TLinkStrMap.Create;
- // put back in src
- for i:=0 to p.count-1 do
- src.insert(p[i].Key);
- p.free;
-end;
+ // expand libaliases, clears src
+ LinkLibraryAliases.expand(src,p);
-procedure TLinker.LoadPredefinedLibraryOrder;
+ // writeln(src.count,' ',p.count,' ',linklibraryorder.count,' ',linklibraryaliases.count);
+ // apply order
+ p.UpdateWeights(LinkLibraryOrder);
+ p.SortOnWeight;
-begin
-end;
+ // put back in src
+ for i:=0 to p.count-1 do
+ src.insert(p[i].Key);
+ p.free;
+ end;
-function TLinker.ReOrderEntries : boolean;
-begin
- result:=(LinkLibraryOrder.count>0) or (LinkLibraryAliases.count>0);
-end;
+ procedure TLinker.LoadPredefinedLibraryOrder;
+ begin
+ end;
+
+
+ function TLinker.ReOrderEntries : boolean;
+ begin
+ result:=(LinkLibraryOrder.count>0) or (LinkLibraryAliases.count>0);
+ end;
+
{*****************************************************************************
TEXTERNALLINKER
*****************************************************************************}
-Constructor TExternalLinker.Create;
-begin
- inherited Create;
- { set generic defaults }
- FillChar(Info,sizeof(Info),0);
- if cs_link_on_target in aktglobalswitches then
- begin
- Info.ResName:=outputexedir+inputfile+'_link.res';
- Info.ScriptName:=outputexedir+inputfile+'_script.res';
- end
- else
- begin
- Info.ResName:='link.res';
- Info.ScriptName:='script.res';
- end;
- { set the linker specific defaults }
- SetDefaultInfo;
- { Allow Parameter overrides for linker info }
- with Info do
- begin
- if ParaLinkOptions<>'' then
- ExtraOptions:=ParaLinkOptions;
- if ParaDynamicLinker<>'' then
- DynamicLinker:=ParaDynamicLinker;
- end;
-end;
-
-
-Destructor TExternalLinker.Destroy;
-begin
- inherited destroy;
-end;
-
-
-Procedure TExternalLinker.SetDefaultInfo;
-begin
-end;
-
-
-Function TExternalLinker.FindUtil(const s:string):string;
-var
- Found : boolean;
- FoundBin : string;
- UtilExe : string;
-begin
- if cs_link_on_target in aktglobalswitches then
- begin
- { If linking on target, don't add any path PM }
- FindUtil:=AddExtension(s,target_info.exeext);
- exit;
- end;
- UtilExe:=AddExtension(s,source_info.exeext);
- FoundBin:='';
- Found:=false;
- if utilsdirectory<>'' then
- Found:=FindFile(utilexe,utilsdirectory,Foundbin);
- if (not Found) then
- Found:=FindExe(utilexe,Foundbin);
- if (not Found) and not(cs_link_nolink in aktglobalswitches) then
- begin
- Message1(exec_e_util_not_found,utilexe);
- aktglobalswitches:=aktglobalswitches+[cs_link_nolink];
- end;
- if (FoundBin<>'') then
- Message1(exec_t_using_util,FoundBin);
- FindUtil:=FoundBin;
-end;
-
-
-Function TExternalLinker.DoExec(const command:string; para:TCmdStr;showinfo,useshell:boolean):boolean;
-var
- exitcode: longint;
-begin
- DoExec:=true;
- if not(cs_link_nolink in aktglobalswitches) then
- begin
- FlushOutput;
- if useshell then
- exitcode := shell(maybequoted(command)+' '+para)
- else
-{$IFDEF USE_SYSUTILS}
- try
- if ExecuteProcess(command,para) <> 0
- then begin
- Message(exec_e_error_while_linking);
- aktglobalswitches:=aktglobalswitches+[cs_link_nolink];
- DoExec:=false;
- end;
- except on E:EOSError do
- begin
- Message(exec_e_cant_call_linker);
- aktglobalswitches:=aktglobalswitches+[cs_link_nolink];
- DoExec:=false;
- end;
- end
- end;
-{$ELSE USE_SYSUTILS}
- begin
- swapvectors;
- exec(command,para);
- swapvectors;
- exitcode := dosexitcode;
- end;
- if (doserror<>0) then
+ Constructor TExternalLinker.Create;
begin
- Message(exec_e_cant_call_linker);
- aktglobalswitches:=aktglobalswitches+[cs_link_nolink];
- DoExec:=false;
- end
- else
- if (exitcode<>0) then
- begin
- Message(exec_e_error_while_linking);
- aktglobalswitches:=aktglobalswitches+[cs_link_nolink];
- DoExec:=false;
- end;
- end;
-{$ENDIF USE_SYSUTILS}
-{ Update asmres when externmode is set }
- if cs_link_nolink in aktglobalswitches then
- begin
- if showinfo then
- begin
- if DLLsource then
- AsmRes.AddLinkCommand(Command,Para,current_module.sharedlibfilename^)
- else
- AsmRes.AddLinkCommand(Command,Para,current_module.exefilename^);
- end
- else
- AsmRes.AddLinkCommand(Command,Para,'');
- end;
-end;
-
-
-Function TExternalLinker.MakeStaticLibrary:boolean;
-
- function GetNextFiles(const maxCmdLength : AInt; var item : TStringListItem) : string;
- begin
- result := '';
- while (assigned(item) and ((length(result) + length(item.str) + 1) < maxCmdLength)) do begin
- result := result + ' ' + item.str;
- item := TStringListItem(item.next);
- end;
- end;
-
-var
- binstr, scriptfile : string;
- success : boolean;
- cmdstr, nextcmd, smartpath : TCmdStr;
- current : TStringListItem;
- script: Text;
- scripted_ar : boolean;
-begin
- MakeStaticLibrary:=false;
-{ remove the library, to be sure that it is rewritten }
- RemoveFile(current_module.staticlibfilename^);
-{ Call AR }
- smartpath:=current_module.outputpath^+FixPath(current_module.newfilename^+target_info.smartext,false);
- SplitBinCmd(target_ar.arcmd,binstr,cmdstr);
- binstr := FindUtil(utilsprefix + binstr);
-
-
- scripted_ar:=target_ar.id=ar_gnu_ar_scripted;
-
- if scripted_ar then
- begin
- scriptfile := FixFileName(smartpath+'arscript.txt');
- Replace(cmdstr,'$SCRIPT',maybequoted(scriptfile));
- Assign(script, scriptfile);
- Rewrite(script);
- try
- writeln(script, 'CREATE ' + current_module.staticlibfilename^);
- current := TStringListItem(SmartLinkOFiles.First);
- while current <> nil do
+ inherited Create;
+ { set generic defaults }
+ FillChar(Info,sizeof(Info),0);
+ if cs_link_on_target in aktglobalswitches then
begin
- writeln(script, 'ADDMOD ' + current.str);
- current := TStringListItem(current.next);
+ Info.ResName:=outputexedir+inputfile+'_link.res';
+ Info.ScriptName:=outputexedir+inputfile+'_script.res';
+ end
+ else
+ begin
+ Info.ResName:='link.res';
+ Info.ScriptName:='script.res';
end;
- writeln(script, 'SAVE');
- writeln(script, 'END');
- finally
- Close(script);
+ { set the linker specific defaults }
+ SetDefaultInfo;
+ { Allow Parameter overrides for linker info }
+ with Info do
+ begin
+ if ParaLinkOptions<>'' then
+ ExtraOptions:=ParaLinkOptions;
+ if ParaDynamicLinker<>'' then
+ DynamicLinker:=ParaDynamicLinker;
+ end;
end;
- success:=DoExec(binstr,cmdstr,false,true);
- end
- else
- begin
- Replace(cmdstr,'$LIB',maybequoted(current_module.staticlibfilename^));
- { create AR commands }
- success := true;
- nextcmd := cmdstr;
- current := TStringListItem(SmartLinkOFiles.First);
- repeat
- Replace(nextcmd,'$FILES',GetNextFiles(240 - length(nextcmd) + 6 - length(binstr) - 1, current));
- success:=DoExec(binstr,nextcmd,false,true);
- nextcmd := cmdstr;
- until (not assigned(current)) or (not success);
- end;
- if (target_ar.arfinishcmd <> '') then
- begin
- SplitBinCmd(target_ar.arfinishcmd,binstr,cmdstr);
- Replace(cmdstr,'$LIB',maybequoted(current_module.staticlibfilename^));
- success:=DoExec(binstr,cmdstr,false,true);
- end;
- { Clean up }
- if not(cs_asm_leave in aktglobalswitches) then
- if not(cs_link_nolink in aktglobalswitches) then
- begin
- while not SmartLinkOFiles.Empty do
- RemoveFile(SmartLinkOFiles.GetFirst);
- if scripted_ar then
- RemoveFile(scriptfile);
- RemoveDir(smartpath);
- end
- else
- begin
- AsmRes.AddDeleteCommand(FixFileName(smartpath+current_module.asmprefix^+'*'+target_info.objext));
- if scripted_ar then
- AsmRes.AddDeleteCommand(scriptfile);
- AsmRes.AddDeleteDirCommand(smartpath);
- end;
- MakeStaticLibrary:=success;
-end;
+ Destructor TExternalLinker.Destroy;
+ begin
+ inherited destroy;
+ end;
+
+
+ Procedure TExternalLinker.SetDefaultInfo;
+ begin
+ end;
+
+
+ Function TExternalLinker.FindUtil(const s:string):string;
+ var
+ Found : boolean;
+ FoundBin : string;
+ UtilExe : string;
+ begin
+ if cs_link_on_target in aktglobalswitches then
+ begin
+ { If linking on target, don't add any path PM }
+ FindUtil:=AddExtension(s,target_info.exeext);
+ exit;
+ end;
+ UtilExe:=AddExtension(s,source_info.exeext);
+ FoundBin:='';
+ Found:=false;
+ if utilsdirectory<>'' then
+ Found:=FindFile(utilexe,utilsdirectory,Foundbin);
+ if (not Found) then
+ Found:=FindExe(utilexe,Foundbin);
+ if (not Found) and not(cs_link_nolink in aktglobalswitches) then
+ begin
+ Message1(exec_e_util_not_found,utilexe);
+ aktglobalswitches:=aktglobalswitches+[cs_link_nolink];
+ end;
+ if (FoundBin<>'') then
+ Message1(exec_t_using_util,FoundBin);
+ FindUtil:=FoundBin;
+ end;
+
+
+ Function TExternalLinker.DoExec(const command:string; para:TCmdStr;showinfo,useshell:boolean):boolean;
+ var
+ exitcode: longint;
+ begin
+ DoExec:=true;
+ if not(cs_link_nolink in aktglobalswitches) then
+ begin
+ FlushOutput;
+ if useshell then
+ exitcode := shell(maybequoted(command)+' '+para)
+ else
+ {$IFDEF USE_SYSUTILS}
+ try
+ if ExecuteProcess(command,para) <> 0
+ then begin
+ Message(exec_e_error_while_linking);
+ aktglobalswitches:=aktglobalswitches+[cs_link_nolink];
+ DoExec:=false;
+ end;
+ except on E:EOSError do
+ begin
+ Message(exec_e_cant_call_linker);
+ aktglobalswitches:=aktglobalswitches+[cs_link_nolink];
+ DoExec:=false;
+ end;
+ end
+ end;
+ {$ELSE USE_SYSUTILS}
+ begin
+ swapvectors;
+ exec(command,para);
+ swapvectors;
+ exitcode := dosexitcode;
+ end;
+ if (doserror<>0) then
+ begin
+ Message(exec_e_cant_call_linker);
+ aktglobalswitches:=aktglobalswitches+[cs_link_nolink];
+ DoExec:=false;
+ end
+ else
+ if (exitcode<>0) then
+ begin
+ Message(exec_e_error_while_linking);
+ aktglobalswitches:=aktglobalswitches+[cs_link_nolink];
+ DoExec:=false;
+ end;
+ end;
+ {$ENDIF USE_SYSUTILS}
+ { Update asmres when externmode is set }
+ if cs_link_nolink in aktglobalswitches then
+ begin
+ if showinfo then
+ begin
+ if DLLsource then
+ AsmRes.AddLinkCommand(Command,Para,current_module.sharedlibfilename^)
+ else
+ AsmRes.AddLinkCommand(Command,Para,current_module.exefilename^);
+ end
+ else
+ AsmRes.AddLinkCommand(Command,Para,'');
+ end;
+ end;
+
+
+ Function TExternalLinker.MakeStaticLibrary:boolean;
+
+ function GetNextFiles(const maxCmdLength : AInt; var item : TStringListItem) : string;
+ begin
+ result := '';
+ while (assigned(item) and ((length(result) + length(item.str) + 1) < maxCmdLength)) do begin
+ result := result + ' ' + item.str;
+ item := TStringListItem(item.next);
+ end;
+ end;
+
+ var
+ binstr, scriptfile : string;
+ success : boolean;
+ cmdstr, nextcmd, smartpath : TCmdStr;
+ current : TStringListItem;
+ script: Text;
+ scripted_ar : boolean;
+ begin
+ MakeStaticLibrary:=false;
+ { remove the library, to be sure that it is rewritten }
+ RemoveFile(current_module.staticlibfilename^);
+ { Call AR }
+ smartpath:=current_module.outputpath^+FixPath(current_module.newfilename^+target_info.smartext,false);
+ SplitBinCmd(target_ar.arcmd,binstr,cmdstr);
+ binstr := FindUtil(utilsprefix + binstr);
+
+
+ scripted_ar:=target_ar.id=ar_gnu_ar_scripted;
+
+ if scripted_ar then
+ begin
+ scriptfile := FixFileName(smartpath+'arscript.txt');
+ Replace(cmdstr,'$SCRIPT',maybequoted(scriptfile));
+ Assign(script, scriptfile);
+ Rewrite(script);
+ try
+ writeln(script, 'CREATE ' + current_module.staticlibfilename^);
+ current := TStringListItem(SmartLinkOFiles.First);
+ while current <> nil do
+ begin
+ writeln(script, 'ADDMOD ' + current.str);
+ current := TStringListItem(current.next);
+ end;
+ writeln(script, 'SAVE');
+ writeln(script, 'END');
+ finally
+ Close(script);
+ end;
+ success:=DoExec(binstr,cmdstr,false,true);
+ end
+ else
+ begin
+ Replace(cmdstr,'$LIB',maybequoted(current_module.staticlibfilename^));
+ { create AR commands }
+ success := true;
+ nextcmd := cmdstr;
+ current := TStringListItem(SmartLinkOFiles.First);
+ repeat
+ Replace(nextcmd,'$FILES',GetNextFiles(240 - length(nextcmd) + 6 - length(binstr) - 1, current));
+ success:=DoExec(binstr,nextcmd,false,true);
+ nextcmd := cmdstr;
+ until (not assigned(current)) or (not success);
+ end;
+
+ if (target_ar.arfinishcmd <> '') then
+ begin
+ SplitBinCmd(target_ar.arfinishcmd,binstr,cmdstr);
+ Replace(cmdstr,'$LIB',maybequoted(current_module.staticlibfilename^));
+ success:=DoExec(binstr,cmdstr,false,true);
+ end;
+
+ { Clean up }
+ if not(cs_asm_leave in aktglobalswitches) then
+ if not(cs_link_nolink in aktglobalswitches) then
+ begin
+ while not SmartLinkOFiles.Empty do
+ RemoveFile(SmartLinkOFiles.GetFirst);
+ if scripted_ar then
+ RemoveFile(scriptfile);
+ RemoveDir(smartpath);
+ end
+ else
+ begin
+ AsmRes.AddDeleteCommand(FixFileName(smartpath+current_module.asmprefix^+'*'+target_info.objext));
+ if scripted_ar then
+ AsmRes.AddDeleteCommand(scriptfile);
+ AsmRes.AddDeleteDirCommand(smartpath);
+ end;
+ MakeStaticLibrary:=success;
+ end;
{*****************************************************************************
@@ -780,7 +779,7 @@ end;
inherited Create;
linkscript:=TStringList.Create;
FStaticLibraryList:=TFPHashObjectList.Create(true);
- FExternalLibraryList:=TFPHashObjectList.Create(true);
+ FImportLibraryList:=TFPHashObjectList.Create(true);
exemap:=nil;
exeoutput:=nil;
CObjInput:=TObjInput;
@@ -791,7 +790,7 @@ end;
begin
linkscript.free;
StaticLibraryList.Free;
- ExternalLibraryList.Free;
+ ImportLibraryList.Free;
if assigned(exeoutput) then
begin
exeoutput.free;
@@ -806,17 +805,17 @@ end;
end;
- procedure TInternalLinker.AddExternalSymbol(const libname,symname:string;ordnumber: longint);
+ procedure TInternalLinker.AddImportSymbol(const libname,symname:string;OrdNr: longint;isvar:boolean);
var
- ExtLibrary : TExternalLibrary;
- ExtSymbol : TFPHashObject;
+ ImportLibrary : TImportLibrary;
+ ImportSymbol : 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:=TExternalSymbol.Create(ExtLibrary.ExternalSymbolList,symname,ordnumber);
+ 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;
@@ -992,7 +991,7 @@ end;
ParseScript_Load;
exeoutput.ResolveSymbols(StaticLibraryList);
{ Generate symbols and code to do the importing }
- exeoutput.GenerateLibraryImports(ExternalLibraryList);
+ exeoutput.GenerateLibraryImports(ImportLibraryList);
{ Fill external symbols data }
exeoutput.FixupSymbols;
if ErrorCount>0 then
diff --git a/compiler/ogbase.pas b/compiler/ogbase.pas
index b8deb1cb37..077be7ba20 100644
--- a/compiler/ogbase.pas
+++ b/compiler/ogbase.pas
@@ -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;
diff --git a/compiler/ogcoff.pas b/compiler/ogcoff.pas
index f436487835..a82ccff5eb 100644
--- a/compiler/ogcoff.pas
+++ b/compiler/ogcoff.pas
@@ -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
diff --git a/compiler/pdecvar.pas b/compiler/pdecvar.pas
index 41bb5c35d2..ff24ed5d93 100644
--- a/compiler/pdecvar.pas
+++ b/compiler/pdecvar.pas
@@ -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
diff --git a/compiler/pmodules.pas b/compiler/pmodules.pas
index d20623c286..5f6910eeaa 100644
--- a/compiler/pmodules.pas
+++ b/compiler/pmodules.pas
@@ -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
diff --git a/compiler/ppu.pas b/compiler/ppu.pas
index 187e5f4577..329a1da214 100644
--- a/compiler/ppu.pas
+++ b/compiler/ppu.pas
@@ -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;
diff --git a/compiler/psub.pas b/compiler/psub.pas
index a122d11512..418e5e127b 100644
--- a/compiler/psub.pas
+++ b/compiler/psub.pas
@@ -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;
diff --git a/compiler/systems/t_beos.pas b/compiler/systems/t_beos.pas
index 227695ad55..793f03452c 100644
--- a/compiler/systems/t_beos.pas
+++ b/compiler/systems/t_beos.pas
@@ -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;
{*****************************************************************************
diff --git a/compiler/systems/t_bsd.pas b/compiler/systems/t_bsd.pas
index 1d7dcdd8ab..df784b580f 100644
--- a/compiler/systems/t_bsd.pas
+++ b/compiler/systems/t_bsd.pas
@@ -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;
{*****************************************************************************
diff --git a/compiler/systems/t_emx.pas b/compiler/systems/t_emx.pas
index 172a2b7853..0a50809bbb 100644
--- a/compiler/systems/t_emx.pas
+++ b/compiler/systems/t_emx.pas
@@ -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;
{****************************************************************************
diff --git a/compiler/systems/t_linux.pas b/compiler/systems/t_linux.pas
index 8bd7f9af73..62ba503434 100644
--- a/compiler/systems/t_linux.pas
+++ b/compiler/systems/t_linux.pas
@@ -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;
{*****************************************************************************
diff --git a/compiler/systems/t_macos.pas b/compiler/systems/t_macos.pas
index 879e7c8340..ddcc072d07 100644
--- a/compiler/systems/t_macos.pas
+++ b/compiler/systems/t_macos.pas
@@ -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
diff --git a/compiler/systems/t_nwl.pas b/compiler/systems/t_nwl.pas
index 1034e958ed..bdd036507a 100644
--- a/compiler/systems/t_nwl.pas
+++ b/compiler/systems/t_nwl.pas
@@ -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;
{*****************************************************************************
diff --git a/compiler/systems/t_nwm.pas b/compiler/systems/t_nwm.pas
index 277d72c00d..6cb0a08cb7 100644
--- a/compiler/systems/t_nwm.pas
+++ b/compiler/systems/t_nwm.pas
@@ -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;
{*****************************************************************************
diff --git a/compiler/systems/t_os2.pas b/compiler/systems/t_os2.pas
index 825266426b..83326adcb3 100644
--- a/compiler/systems/t_os2.pas
+++ b/compiler/systems/t_os2.pas
@@ -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;
{****************************************************************************
diff --git a/compiler/systems/t_sunos.pas b/compiler/systems/t_sunos.pas
index cae6f29ac7..661fa04072 100644
--- a/compiler/systems/t_sunos.pas
+++ b/compiler/systems/t_sunos.pas
@@ -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;
{*****************************************************************************
diff --git a/compiler/systems/t_win.pas b/compiler/systems/t_win.pas
index c734278f00..80a30e34ef 100644
--- a/compiler/systems/t_win.pas
+++ b/compiler/systems/t_win.pas
@@ -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;
diff --git a/compiler/utils/ppudump.pp b/compiler/utils/ppudump.pp
index f90753299d..4c7848e523 100644
--- a/compiler/utils/ppudump.pp
+++ b/compiler/utils/ppudump.pp
@@ -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;