paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-26 18:03:43 +02:00
Code Issues Packages Projects Releases Wiki Activity
5ea6603165
fpc/compiler/link.pas
peter 5ea6603165 * fixed searching for utils
2001-01-12 19:19:44 +00:00

584 lines
15 KiB
ObjectPascal
Raw Blame History

{
$Id$
Copyright (c) 1998-2000 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 defines.inc}
{ Needed for LFN support in path to the executable }
{$ifdef GO32V2}
{$define ALWAYSSHELL}
{$endif}
interface
uses
cobjects,cclasses,
fmodule;
Type
TLinkerInfo=record
ExeCmd,
DllCmd : array[1..3] of string[100];
ResName : string[12];
ExtraOptions : string;
DynamicLinker : string[100];
end;
TLinker = class
public
Info : TLinkerInfo;
ObjectFiles,
SharedLibFiles,
StaticLibFiles : TStringList;
{ Methods }
Constructor Create;
Destructor Destroy;override;
procedure AddModuleFiles(hp:tmodule);
function FindObjectFile(s : string;const unitpath:string) : string;
function FindLibraryFile(s:string;const ext:string;var found : boolean) : string;
Procedure AddObject(const S,unitpath : String);
Procedure AddStaticLibrary(const S : String);
Procedure AddSharedLibrary(S : String);
Function FindUtil(const s:string):String;
Function DoExec(const command,para:string;showinfo,useshell:boolean):boolean;
{ Virtuals }
procedure SetDefaultInfo;virtual;
Function MakeExecutable:boolean;virtual;
Function MakeSharedLibrary:boolean;virtual;
Function MakeStaticLibrary:boolean;virtual;
end;
Var
Linker : TLinker;
procedure InitLinker;
procedure DoneLinker;
Implementation
uses
{$ifdef Delphi}
dmisc,
{$else Delphi}
dos,
{$endif Delphi}
cutils,globtype,systems,
script,globals,verbose,ppu
{$ifdef i386}
{$ifndef NOTARGETLINUX}
,t_linux
{$endif}
{$ifndef NOTARGETFREEBSD}
,t_fbsd
{$endif}
{$ifndef NOTARGETOS2}
,t_os2
{$endif}
{$ifndef NOTARGETWIN32}
,t_win32
{$endif}
{$ifndef NOTARGETNETWARE}
,t_nwm
{$endif}
{$ifndef NOTARGETGO32V1}
,t_go32v1
{$endif}
{$ifndef NOTARGETGO32V2}
,t_go32v2
{$endif}
{$endif}
{$ifdef m68k}
{$ifndef NOTARGETLINUX}
,t_linux
{$endif}
{$endif}
{$ifdef powerpc}
{$ifndef NOTARGETLINUX}
,t_linux
{$endif}
{$endif}
{$ifdef alpha}
{$ifndef NOTARGETLINUX}
,t_linux
{$endif}
{$endif}
;
{*****************************************************************************
TLINKER
*****************************************************************************}
Constructor TLinker.Create;
begin
ObjectFiles:=TStringList.Create_no_double;
SharedLibFiles:=TStringList.Create_no_double;
StaticLibFiles:=TStringList.Create_no_double;
{ set generic defaults }
FillChar(Info,sizeof(Info),0);
Info.ResName:='link.res';
{ 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 TLinker.Destroy;
begin
ObjectFiles.Free;
SharedLibFiles.Free;
StaticLibFiles.Free;
end;
Procedure TLinker.SetDefaultInfo;
begin
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
AddObject(linkunitofiles.getusemask(mask),path^);
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^);
while not linkotherstaticlibs.empty do
AddStaticLibrary(linkotherstaticlibs.Getusemask(mask));
while not linkothersharedlibs.empty do
AddSharedLibrary(linkothersharedlibs.Getusemask(mask));
end;
end;
Function TLinker.FindUtil(const s:string):string;
var
Found : boolean;
FoundBin : string;
UtilExe : string;
begin
UtilExe:=AddExtension(s,source_os.exeext);
FoundBin:='';
Found:=false;
if utilsdirectory<>'' then
FoundBin:=FindFile(utilexe,utilsdirectory,Found)+utilexe;
if (not Found) then
FoundBin:=FindExe(utilexe,Found);
if (not Found) and not(cs_link_extern in aktglobalswitches) then
begin
Message1(exec_w_util_not_found,utilexe);
aktglobalswitches:=aktglobalswitches+[cs_link_extern];
end;
if (FoundBin<>'') then
Message1(exec_t_using_util,FoundBin);
FindUtil:=FoundBin;
end;
{ searches an object file }
function TLinker.FindObjectFile(s:string;const unitpath:string) : string;
var
found : boolean;
begin
findobjectfile:='';
if s='' then
exit;
if pos('.',s)=0 then
s:=s+target_info.objext;
s:=FixFileName(s);
if FileExists(s) then
begin
Findobjectfile:=s;
exit;
end;
{ 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 }
found:=false;
if unitpath<>'' then
findobjectfile:=FindFile(s,unitpath,found)+s;
if (not found) then
findobjectfile:=FindFile(s,'.'+DirSep,found)+s;
if (not found) then
findobjectfile:=UnitSearchPath.FindFile(s,found)+s;
if (not found) then
findobjectfile:=current_module.localobjectsearchpath.FindFile(s,found)+s;
if (not found) then
findobjectfile:=objectsearchpath.FindFile(s,found)+s;
if (not found) then
findobjectfile:=FindFile(s,exepath,found)+s;
if not(cs_link_extern in aktglobalswitches) and (not found) then
Message1(exec_w_objfile_not_found,s);
end;
{ searches an library file }
function TLinker.FindLibraryFile(s:string;const ext:string;var found : boolean) : string;
begin
found:=false;
findlibraryfile:='';
if s='' then
exit;
if pos('.',s)=0 then
s:=s+ext;
if FileExists(s) then
begin
found:=true;
FindLibraryFile:=s;
exit;
end;
{ find libary
1. cwd
2. local libary dir
3. global libary dir
4. exe path of the compiler }
found:=false;
findlibraryfile:=FindFile(s,'.'+DirSep,found)+s;
if (not found) then
findlibraryfile:=current_module.locallibrarysearchpath.FindFile(s,found)+s;
if (not found) then
findlibraryfile:=librarysearchpath.FindFile(s,found)+s;
if (not found) then
findlibraryfile:=FindFile(s,exepath,found)+s;
end;
Procedure TLinker.AddObject(const S,unitpath : String);
begin
ObjectFiles.Insert(FindObjectFile(s,unitpath));
end;
Procedure TLinker.AddSharedLibrary(S:String);
begin
if s='' then
exit;
{ remove prefix 'lib' }
if Copy(s,1,length(target_os.libprefix))=target_os.libprefix then
Delete(s,1,length(target_os.libprefix));
{ remove extension if any }
if Copy(s,length(s)-length(target_os.sharedlibext)+1,length(target_os.sharedlibext))=target_os.sharedlibext then
Delete(s,length(s)-length(target_os.sharedlibext)+1,length(target_os.sharedlibext)+1);
{ ready to be inserted }
SharedLibFiles.Insert (S);
end;
Procedure TLinker.AddStaticLibrary(const S:String);
var
ns : string;
found : boolean;
begin
if s='' then
exit;
ns:=FindLibraryFile(s,target_os.staticlibext,found);
if not(cs_link_extern in aktglobalswitches) and (not found) then
Message1(exec_w_libfile_not_found,s);
StaticLibFiles.Insert(ns);
end;
Function TLinker.DoExec(const command,para:string;showinfo,useshell:boolean):boolean;
begin
DoExec:=true;
if not(cs_link_extern in aktglobalswitches) then
begin
swapvectors;
{$ifdef ALWAYSSHELL}
shell(command+' '+para);
{$else}
if useshell then
shell(command+' '+para)
else
exec(command,para);
{$endif}
swapvectors;
if (doserror<>0) then
begin
Message(exec_w_cant_call_linker);
aktglobalswitches:=aktglobalswitches+[cs_link_extern];
DoExec:=false;
end
else
if (dosexitcode<>0) then
begin
Message(exec_w_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 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;
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(FixFileName(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;
{*****************************************************************************
Init/Done
*****************************************************************************}
procedure InitLinker;
begin
case target_info.target of
{$ifdef i386}
{$ifndef NOTARGETLINUX}
target_i386_linux :
linker:=Tlinkerlinux.Create;
{$endif}
{$ifndef NOTARGETFreeBSD}
target_i386_FreeBSD :
linker:=TlinkerFreeBSD.Create;
{$endif}
{$ifndef NOTARGETWIN32}
target_i386_Win32 :
linker:=Tlinkerwin32.Create;
{$endif}
{$ifndef NOTARGETNETWARE}
target_i386_Netware :
linker:=Tlinkernetware.Create;
{$endif}
{$ifndef NOTARGETGO32V1}
target_i386_Go32v1 :
linker:=TLinkergo32v1.Create;
{$endif}
{$ifndef NOTARGETGO32V2}
target_i386_Go32v2 :
linker:=TLinkergo32v2.Create;
{$endif}
{$ifndef NOTARGETOS2}
target_i386_os2 :
linker:=TLinkeros2.Create;
{$endif}
{$endif i386}
{$ifdef m68k}
{$ifndef NOTARGETPALMOS}
target_m68k_palmos:
linker:=Tlinker.Create;
{$endif}
{$ifndef NOTARGETLINUX}
target_m68k_linux :
linker:=Tlinkerlinux.Create;
{$endif}
{$endif m68k}
{$ifdef alpha}
{$ifndef NOTARGETLINUX}
target_alpha_linux :
linker:=Tlinkerlinux.Create;
{$endif}
{$endif alpha}
{$ifdef powerpc}
{$ifndef NOTARGETLINUX}
target_powerpc_linux :
linker:=Tlinkerlinux.Create;
{$endif}
{$endif powerpc}
else
linker:=Tlinker.Create;
end;
end;
procedure DoneLinker;
begin
if assigned(linker) then
Linker.Free;
end;
end.
{
$Log$
Revision 1.12 2001-01-12 19:19:44 peter
* fixed searching for utils
Revision 1.11 2000/12/25 00:07:26 peter
+ new tlinkedlist class (merge of old tstringqueue,tcontainer and
tlinkedlist objects)
Revision 1.10 2000/11/29 00:30:31 florian
* unused units removed from uses clause
* some changes for widestrings
Revision 1.9 2000/09/24 21:33:46 peter
* message updates merges
Revision 1.8 2000/09/24 15:06:18 peter
* use defines.inc
Revision 1.7 2000/09/16 12:22:52 peter
* freebsd support merged
Revision 1.6 2000/09/11 17:00:23 florian
+ first implementation of Netware Module support, thanks to
Armin Diehl (diehl@nordrhein.de) for providing the patches
Revision 1.5 2000/09/04 09:40:23 michael
+ merged Patch from peter
Revision 1.4 2000/08/27 16:11:51 peter
* moved some util functions from globals,cobjects to cutils
* splitted files into finput,fmodule
Revision 1.3 2000/07/26 13:08:19 jonas
* merged from fixes branch (v_hint to v_tried changed when attempting
to smart/static/shared link)
Revision 1.2 2000/07/13 11:32:43 michael
+ removed logs
}
Reference in New Issue View Git Blame Copy Permalink