{
$Id: link.pas,v 1.39 2003/12/11 17:53:03 florian Exp $
Copyright (c) 1998-2002 by Peter Vreman
This unit handles the linker and binder calls for programs and
libraries
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
****************************************************************************
}
unit link;
{$i fpcdefs.inc}
interface
uses
cclasses,
systems,
fmodule;
Type
TLinkerInfo=record
ExeCmd,
DllCmd : array[1..3] of string[100];
ResName : string[12];
ScriptName : string[12];
ExtraOptions : string;
DynamicLinker : string[100];
end;
TLinker = class(TAbstractLinker)
public
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);
Function MakeExecutable:boolean;virtual;
Function MakeSharedLibrary:boolean;virtual;
Function MakeStaticLibrary:boolean;virtual;
end;
TExternalLinker = class(TLinker)
public
Info : TLinkerInfo;
Constructor Create;override;
Destructor Destroy;override;
Function FindUtil(const s:string):String;
Function DoExec(const command,para:string;showinfo,useshell:boolean):boolean;
procedure SetDefaultInfo;virtual;
Function MakeStaticLibrary:boolean;override;
end;
TInternalLinker = class(TLinker)
private
procedure readobj(const fn:string);
public
Constructor Create;override;
Destructor Destroy;override;
Function MakeExecutable:boolean;override;
end;
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;
procedure InitLinker;
procedure DoneLinker;
Implementation
uses
{$ifdef Delphi}
dmisc,
{$else Delphi}
dos,
{$endif Delphi}
cutils,globtype,
script,globals,verbose,ppu,
aasmbase,aasmtai,aasmcpu,
ogbase,ogmap;
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 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. specified unit path (if specified)
2. cwd
3. unit search path
4. local object path
5. global object path
6. exepath (not when linking on target) }
found:=false;
if unitpath<>'' then
found:=FindFile(s,unitpath,foundfile);
if (not found) then
found:=FindFile(s,'.'+source_info.DirSep,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_extern in aktglobalswitches) and (not found) then
Message1(exec_w_objfile_not_found,s);
findobjectfile:=ScriptFixFileName(foundfile);
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,'.'+source_info.DirSep,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.AddModuleFiles(hp:tmodule);
var
mask : longint;
begin
with hp do
begin
{ link unit files }
if (flags and uf_no_link)=0 then
begin
{ create mask which unit files need linking }
mask:=link_allways;
{ 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
begin
AddObject(linkunitofiles.getusemask(mask),path^,true);
end;
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_allways;
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));
end;
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.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_extern 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.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_extern 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;
Function TLinker.MakeSharedLibrary:boolean;
begin
MakeSharedLibrary:=false;
Message(exec_e_dll_not_supported);
end;
Function TLinker.MakeStaticLibrary:boolean;
begin
MakeStaticLibrary:=false;
Message(exec_e_dll_not_supported);
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_extern in aktglobalswitches) then
begin
Message1(exec_e_util_not_found,utilexe);
aktglobalswitches:=aktglobalswitches+[cs_link_extern];
end;
if (FoundBin<>'') then
Message1(exec_t_using_util,FoundBin);
FindUtil:=FoundBin;
end;
Function TExternalLinker.DoExec(const command,para:string;showinfo,useshell:boolean):boolean;
begin
DoExec:=true;
if not(cs_link_extern in aktglobalswitches) then
begin
if useshell then
shell(maybequoted(command)+' '+para)
else
begin
swapvectors;
exec(command,para);
swapvectors;
end;
if (doserror<>0) then
begin
Message(exec_e_cant_call_linker);
aktglobalswitches:=aktglobalswitches+[cs_link_extern];
DoExec:=false;
end
else
if (dosexitcode<>0) then
begin
Message(exec_e_error_while_linking);
aktglobalswitches:=aktglobalswitches+[cs_link_extern];
DoExec:=false;
end;
end;
{ Update asmres when externmode is set }
if cs_link_extern 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;
var
smartpath,
cmdstr,
binstr : string;
success : 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(lower(current_module.modulename^)+target_info.smartext,false);
SplitBinCmd(target_ar.arcmd,binstr,cmdstr);
Replace(cmdstr,'$LIB',current_module.staticlibfilename^);
Replace(cmdstr,'$FILES',FixFileName(smartpath+current_module.asmprefix^+'*'+target_info.objext));
success:=DoExec(FindUtil(binstr),cmdstr,false,true);
{ Clean up }
if not(cs_asm_leave in aktglobalswitches) then
if not(cs_link_extern in aktglobalswitches) then
begin
while not SmartLinkOFiles.Empty do
RemoveFile(SmartLinkOFiles.GetFirst);
RemoveDir(smartpath);
end
else
begin
AsmRes.AddDeleteCommand(FixFileName(smartpath+current_module.asmprefix^+'*'+target_info.objext));
AsmRes.Add('rmdir '+smartpath);
end;
MakeStaticLibrary:=success;
end;
{*****************************************************************************
TINTERNALLINKER
*****************************************************************************}
Constructor TInternalLinker.Create;
begin
inherited Create;
exemap:=nil;
exeoutput:=nil;
end;
Destructor TInternalLinker.Destroy;
begin
exeoutput.free;
exeoutput:=nil;
inherited destroy;
end;
procedure TInternalLinker.readobj(const fn:string);
var
objdata : TAsmObjectData;
objinput : tobjectinput;
begin
Comment(V_Info,'Reading object '+fn);
objinput:=exeoutput.newobjectinput;
objdata:=objinput.newobjectdata(fn);
if objinput.readobjectfile(fn,objdata) then
exeoutput.addobjdata(objdata);
{ release input object }
objinput.free;
end;
function TInternalLinker.MakeExecutable:boolean;
var
s : string;
begin
MakeExecutable:=false;
{ no support yet for libraries }
if (not StaticLibFiles.Empty) or
(not SharedLibFiles.Empty) then
internalerror(123456789);
if (cs_link_map in aktglobalswitches) then
exemap:=texemap.create(current_module.mapfilename^);
{ read objects }
readobj(FindObjectFile('prt0','',false));
while not ObjectFiles.Empty do
begin
s:=ObjectFiles.GetFirst;
if s<>'' then
readobj(s);
end;
{ generate executable }
exeoutput.GenerateExecutable(current_module.exefilename^);
{ close map }
if assigned(exemap) then
begin
exemap.free;
exemap:=nil;
end;
MakeExecutable:=true;
end;
{*****************************************************************************
Init/Done
*****************************************************************************}
procedure InitLinker;
var
lk : TlinkerClass;
begin
if (cs_link_internal in aktglobalswitches) and
assigned(target_info.link) then
begin
lk:=TLinkerClass(target_info.link);
linker:=lk.Create;
end
else if assigned(target_info.linkextern) then
begin
lk:=TlinkerClass(target_info.linkextern);
linker:=lk.Create;
end
else
begin
linker:=Tlinker.Create;
end;
end;
procedure DoneLinker;
begin
if assigned(linker) then
Linker.Free;
end;
{*****************************************************************************
Initialize
*****************************************************************************}
const
ar_gnu_ar_info : tarinfo =
(
id : ar_gnu_ar;
arcmd : 'ar rs $LIB $FILES'
);
initialization
RegisterAr(ar_gnu_ar_info);
end.
{
$Log: link.pas,v $
Revision 1.39 2003/12/11 17:53:03 florian
* fixed external smartlinking
Revision 1.38 2003/09/14 21:33:11 peter
* don't check exepath when linking on target
Revision 1.37 2003/06/12 16:41:51 peter
* add inputfile prefix to ppas/link.res
Revision 1.36 2003/05/09 17:47:02 peter
* self moved to hidden parameter
* removed hdisposen,hnewn,selfn
Revision 1.35 2003/04/26 09:16:07 peter
* .o files belonging to the unit are first searched in the same dir
as the .ppu
Revision 1.34 2003/02/12 22:04:59 carl
- removed my stupid hello debug code
Revision 1.33 2002/11/15 01:58:48 peter
* merged changes from 1.0.7 up to 04-11
- -V option for generating bug report tracing
- more tracing for option parsing
- errors for cdecl and high()
- win32 import stabs
- win32 records<=8 are returned in eax:edx (turned off by default)
- heaptrc update
- more info for temp management in .s file with EXTDEBUG
Revision 1.32 2002/11/09 15:37:21 carl
- removed no longer used defines
Revision 1.31 2002/09/07 15:25:02 peter
* old logs removed and tabs fixed
Revision 1.30 2002/08/12 15:08:39 carl
+ stab register indexes for powerpc (moved from gdb to cpubase)
+ tprocessor enumeration moved to cpuinfo
+ linker in target_info is now a class
* many many updates for m68k (will soon start to compile)
- removed some ifdef or correct them for correct cpu
Revision 1.29 2002/07/01 18:46:22 peter
* internal linker
* reorganized aasm layer
Revision 1.28 2002/05/18 13:34:08 peter
* readded missing revisions
Revision 1.27 2002/05/16 19:46:37 carl
+ defines.inc -> fpcdefs.inc to avoid conflicts if compiling by hand
+ try to fix temp allocation (still in ifdef)
+ generic constructor calls
+ start of tassembler / tmodulebase class cleanup
Revision 1.25 2002/01/19 11:57:05 peter
* fixed path appending for lib
}
syntax highlighted by Code2HTML, v. 0.9.1