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 = ''; + 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='!'#10; - ar_magic:array[1..length(armag)] of char=armag;} -const ar_magic:array[1..8] of char='!'#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='!'#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='!'#10; - ar_magic:array[1..length(armag)] of char=armag;} -const ar_magic:array[1..8] of char='!'#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='!'#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;