fpc/compiler/targets/t_linux.pas
2001-11-02 22:58:00 +00:00

832 lines
25 KiB
ObjectPascal

{
$Id$
Copyright (c) 1998-2000 by Peter Vreman
This unit implements support import,export,link routines
for the (i386) Linux target
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 t_linux;
{$i defines.inc}
interface
uses
import,export,link;
type
timportliblinux=class(timportlib)
procedure preparelib(const s:string);override;
procedure importprocedure(const func,module:string;index:longint;const name:string);override;
procedure importvariable(const varname,module:string;const name:string);override;
procedure generatelib;override;
end;
texportliblinux=class(texportlib)
procedure preparelib(const s : string);override;
procedure exportprocedure(hp : texported_item);override;
procedure exportvar(hp : texported_item);override;
procedure generatelib;override;
end;
tlinkerlinux=class(tlinker)
private
Glibc2,
Glibc21 : boolean;
Function WriteResponseFile(isdll:boolean) : Boolean;
public
constructor Create;override;
procedure SetDefaultInfo;override;
function MakeExecutable:boolean;override;
function MakeSharedLibrary:boolean;override;
end;
implementation
uses
cutils,cclasses,
verbose,systems,globtype,globals,
symconst,script,
fmodule,aasm,cpuasm,cpubase,symsym;
{*****************************************************************************
TIMPORTLIBLINUX
*****************************************************************************}
procedure timportliblinux.preparelib(const s : string);
begin
end;
procedure timportliblinux.importprocedure(const func,module : string;index : longint;const name : string);
begin
{ insert sharedlibrary }
current_module.linkothersharedlibs.add(SplitName(module),link_allways);
{ do nothing with the procedure, only set the mangledname }
if name<>'' then
aktprocdef.setmangledname(name)
else
message(parser_e_empty_import_name);
end;
procedure timportliblinux.importvariable(const varname,module:string;const name:string);
begin
{ insert sharedlibrary }
current_module.linkothersharedlibs.add(SplitName(module),link_allways);
{ reset the mangledname and turn off the dll_var option }
aktvarsym.setmangledname(name);
exclude(aktvarsym.varoptions,vo_is_dll_var);
end;
procedure timportliblinux.generatelib;
begin
end;
{*****************************************************************************
TEXPORTLIBLINUX
*****************************************************************************}
procedure texportliblinux.preparelib(const s:string);
begin
end;
procedure texportliblinux.exportprocedure(hp : texported_item);
var
hp2 : texported_item;
begin
{ first test the index value }
if (hp.options and eo_index)<>0 then
begin
Message1(parser_e_no_export_with_index_for_target,'linux');
exit;
end;
{ now place in correct order }
hp2:=texported_item(current_module._exports.first);
while assigned(hp2) and
(hp.name^>hp2.name^) do
hp2:=texported_item(hp2.next);
{ insert hp there !! }
if assigned(hp2) and (hp2.name^=hp.name^) then
begin
{ this is not allowed !! }
Message1(parser_e_export_name_double,hp.name^);
exit;
end;
if hp2=texported_item(current_module._exports.first) then
current_module._exports.concat(hp)
else if assigned(hp2) then
begin
hp.next:=hp2;
hp.previous:=hp2.previous;
if assigned(hp2.previous) then
hp2.previous.next:=hp;
hp2.previous:=hp;
end
else
current_module._exports.concat(hp);
end;
procedure texportliblinux.exportvar(hp : texported_item);
begin
hp.is_var:=true;
exportprocedure(hp);
end;
procedure texportliblinux.generatelib;
var
hp2 : texported_item;
begin
hp2:=texported_item(current_module._exports.first);
while assigned(hp2) do
begin
if (not hp2.is_var) and
(hp2.sym.typ=procsym) then
begin
{ the manglednames can already be the same when the procedure
is declared with cdecl }
if tprocsym(hp2.sym).defs^.def.mangledname<>hp2.name^ then
begin
{$ifdef i386}
{ place jump in codesegment }
codesegment.concat(Tai_align.Create_op(4,$90));
codeSegment.concat(Tai_symbol.Createname_global(hp2.name^,0));
codeSegment.concat(Taicpu.Op_sym(A_JMP,S_NO,newasmsymbol(tprocsym(hp2.sym).defs^.def.mangledname)));
codeSegment.concat(Tai_symbol_end.Createname(hp2.name^));
{$endif i386}
end;
end
else
Message1(parser_e_no_export_of_variables_for_target,'linux');
hp2:=texported_item(hp2.next);
end;
end;
{*****************************************************************************
TLINKERLINUX
*****************************************************************************}
Constructor TLinkerLinux.Create;
begin
Inherited Create;
LibrarySearchPath.AddPath('/lib;/usr/lib;/usr/X11R6/lib',true);
end;
procedure TLinkerLinux.SetDefaultInfo;
{
This will also detect which libc version will be used
}
begin
Glibc2:=false;
Glibc21:=false;
with Info do
begin
ExeCmd[1]:='ld $OPT $DYNLINK $STATIC $STRIP -L. -o $EXE $RES';
DllCmd[1]:='ld $OPT $INIT $FINI $SONAME -shared -L. -o $EXE $RES';
DllCmd[2]:='strip --strip-unneeded $EXE';
{ first try glibc2 }
DynamicLinker:='/lib/ld-linux.so.2';
if FileExists(DynamicLinker) then
begin
Glibc2:=true;
{ Check for 2.0 files, else use the glibc 2.1 stub }
if FileExists('/lib/ld-2.0.*') then
Glibc21:=false
else
Glibc21:=true;
end
else
DynamicLinker:='/lib/ld-linux.so.1';
end;
end;
Function TLinkerLinux.WriteResponseFile(isdll:boolean) : Boolean;
Var
linkres : TLinkRes;
i : longint;
cprtobj,
gprtobj,
prtobj : string[80];
HPath : TStringListItem;
s,s1,s2 : string;
found1,
found2,
linkdynamic,
linklibc : boolean;
begin
WriteResponseFile:=False;
{ set special options for some targets }
linkdynamic:=not(SharedLibFiles.empty);
linklibc:=(SharedLibFiles.Find('c')<>nil);
if isdll then
begin
prtobj:='dllprt0';
cprtobj:='dllprt0';
gprtobj:='dllprt0';
end
else
begin
prtobj:='prt0';
cprtobj:='cprt0';
gprtobj:='gprt0';
if glibc21 then
begin
cprtobj:='cprt21';
gprtobj:='gprt21';
end;
end;
if cs_profile in aktmoduleswitches then
begin
prtobj:=gprtobj;
if not glibc2 then
AddSharedLibrary('gmon');
AddSharedLibrary('c');
linklibc:=true;
end
else
begin
if linklibc then
prtobj:=cprtobj;
end;
{ Open link.res file }
LinkRes:=TLinkRes.Create(outputexedir+Info.ResName);
{ Write path to search libraries }
HPath:=TStringListItem(current_module.locallibrarysearchpath.First);
while assigned(HPath) do
begin
LinkRes.Add('SEARCH_DIR('+HPath.Str+')');
HPath:=TStringListItem(HPath.Next);
end;
HPath:=TStringListItem(LibrarySearchPath.First);
while assigned(HPath) do
begin
LinkRes.Add('SEARCH_DIR('+HPath.Str+')');
HPath:=TStringListItem(HPath.Next);
end;
LinkRes.Add('INPUT(');
{ add objectfiles, start with prt0 always }
if prtobj<>'' then
LinkRes.AddFileName(FindObjectFile(prtobj,''));
{ try to add crti and crtbegin if linking to C }
if linklibc then
begin
if librarysearchpath.FindFile('crtbegin.o',s) then
LinkRes.AddFileName(s);
if librarysearchpath.FindFile('crti.o',s) then
LinkRes.AddFileName(s);
end;
{ main objectfiles }
while not ObjectFiles.Empty do
begin
s:=ObjectFiles.GetFirst;
if s<>'' then
LinkRes.AddFileName(s);
end;
LinkRes.Add(')');
{ Write staticlibraries }
if not StaticLibFiles.Empty then
begin
LinkRes.Add('GROUP(');
While not StaticLibFiles.Empty do
begin
S:=StaticLibFiles.GetFirst;
LinkRes.AddFileName(s)
end;
LinkRes.Add(')');
end;
{ Write sharedlibraries like -l<lib>, also add the needed dynamic linker
here to be sure that it gets linked this is needed for glibc2 systems (PFV) }
if not SharedLibFiles.Empty then
begin
LinkRes.Add('INPUT(');
While not SharedLibFiles.Empty do
begin
S:=SharedLibFiles.GetFirst;
if s<>'c' then
begin
i:=Pos(target_info.sharedlibext,S);
if i>0 then
Delete(S,i,255);
LinkRes.Add('-l'+s);
end
else
begin
linklibc:=true;
linkdynamic:=false; { libc will include the ld-linux for us }
end;
end;
{ be sure that libc is the last lib }
if linklibc then
LinkRes.Add('-lc');
{ when we have -static for the linker the we also need libgcc }
if (cs_link_staticflag in aktglobalswitches) then
LinkRes.Add('-lgcc');
if linkdynamic and (Info.DynamicLinker<>'') then
LinkRes.AddFileName(Info.DynamicLinker);
LinkRes.Add(')');
end;
{ objects which must be at the end }
if linklibc then
begin
found1:=librarysearchpath.FindFile('crtend.o',s1);
found2:=librarysearchpath.FindFile('crtn.o',s2);
if found1 or found2 then
begin
LinkRes.Add('INPUT(');
if found1 then
LinkRes.AddFileName(s1);
if found2 then
LinkRes.AddFileName(s2);
LinkRes.Add(')');
end;
end;
{ Write and Close response }
linkres.writetodisk;
linkres.Free;
WriteResponseFile:=True;
end;
function TLinkerLinux.MakeExecutable:boolean;
var
binstr,
cmdstr : string;
success : boolean;
DynLinkStr : string[60];
StaticStr,
StripStr : string[40];
begin
if not(cs_link_extern in aktglobalswitches) then
Message1(exec_i_linking,current_module.exefilename^);
{ Create some replacements }
StaticStr:='';
StripStr:='';
DynLinkStr:='';
if (cs_link_staticflag in aktglobalswitches) then
StaticStr:='-static';
if (cs_link_strip in aktglobalswitches) then
StripStr:='-s';
If (cs_profile in aktmoduleswitches) or
((Info.DynamicLinker<>'') and (not SharedLibFiles.Empty)) then
DynLinkStr:='-dynamic-linker='+Info.DynamicLinker;
{ Write used files and libraries }
WriteResponseFile(false);
{ Call linker }
SplitBinCmd(Info.ExeCmd[1],binstr,cmdstr);
Replace(cmdstr,'$EXE',current_module.exefilename^);
Replace(cmdstr,'$OPT',Info.ExtraOptions);
Replace(cmdstr,'$RES',outputexedir+Info.ResName);
Replace(cmdstr,'$STATIC',StaticStr);
Replace(cmdstr,'$STRIP',StripStr);
Replace(cmdstr,'$DYNLINK',DynLinkStr);
success:=DoExec(FindUtil(BinStr),CmdStr,true,false);
{ Remove ReponseFile }
if (success) and not(cs_link_extern in aktglobalswitches) then
RemoveFile(outputexedir+Info.ResName);
MakeExecutable:=success; { otherwise a recursive call to link method }
end;
Function TLinkerLinux.MakeSharedLibrary:boolean;
var
InitStr,
FiniStr,
SoNameStr : string[80];
binstr,
cmdstr : string;
success : boolean;
begin
MakeSharedLibrary:=false;
if not(cs_link_extern in aktglobalswitches) then
Message1(exec_i_linking,current_module.sharedlibfilename^);
{ Write used files and libraries }
WriteResponseFile(true);
{ Create some replacements }
InitStr:='-init FPC_LIB_START';
FiniStr:='-fini FPC_LIB_EXIT';
SoNameStr:='-soname '+SplitFileName(current_module.sharedlibfilename^);
{ Call linker }
SplitBinCmd(Info.DllCmd[1],binstr,cmdstr);
Replace(cmdstr,'$EXE',current_module.sharedlibfilename^);
Replace(cmdstr,'$OPT',Info.ExtraOptions);
Replace(cmdstr,'$RES',outputexedir+Info.ResName);
Replace(cmdstr,'$INIT',InitStr);
Replace(cmdstr,'$FINI',FiniStr);
Replace(cmdstr,'$SONAME',SoNameStr);
success:=DoExec(FindUtil(binstr),cmdstr,true,false);
{ Strip the library ? }
if success and (cs_link_strip in aktglobalswitches) then
begin
SplitBinCmd(Info.DllCmd[2],binstr,cmdstr);
Replace(cmdstr,'$EXE',current_module.sharedlibfilename^);
success:=DoExec(FindUtil(binstr),cmdstr,true,false);
end;
{ Remove ReponseFile }
if (success) and not(cs_link_extern in aktglobalswitches) then
RemoveFile(outputexedir+Info.ResName);
MakeSharedLibrary:=success; { otherwise a recursive call to link method }
end;
{*****************************************************************************
Initialize
*****************************************************************************}
{$ifdef i386}
const
target_i386_linux_info : ttargetinfo =
(
target : target_i386_LINUX;
name : 'Linux for i386';
shortname : 'Linux';
flags : [];
cpu : i386;
unit_env : 'LINUXUNITS';
extradefines : 'UNIX';
sourceext : '.pp';
pasext : '.pas';
exeext : '';
defext : '.def';
scriptext : '.sh';
smartext : '.sl';
unitext : '.ppu';
unitlibext : '.ppl';
asmext : '.s';
objext : '.o';
resext : '.res';
resobjext : '.or';
sharedlibext : '.so';
staticlibext : '.a';
staticlibprefix : 'libp';
sharedlibprefix : 'lib';
sharedClibext : '.so';
staticClibext : '.a';
staticClibprefix : 'lib';
sharedClibprefix : 'lib';
Cprefix : '';
newline : #10;
dirsep : '/';
files_case_relevent : true;
assem : as_i386_elf32;
assemextern : as_i386_as;
link : ld_i386_linux;
linkextern : ld_i386_linux;
ar : ar_gnu_ar;
res : res_none;
script : script_unix;
endian : endian_little;
alignment :
(
procalign : 4;
loopalign : 4;
jumpalign : 0;
constalignmin : 0;
constalignmax : 1;
varalignmin : 0;
varalignmax : 1;
localalignmin : 0;
localalignmax : 1;
paraalign : 4;
recordalignmin : 0;
recordalignmax : 2;
maxCrecordalign : 4
);
size_of_pointer : 4;
size_of_longint : 4;
heapsize : 256*1024;
maxheapsize : 32768*1024;
stacksize : 8192;
DllScanSupported:false;
use_bound_instruction : false;
use_function_relative_addresses : true
);
{$endif i386}
{$ifdef m68k}
const
target_m68k_linux_info : ttargetinfo =
(
target : target_m68k_linux;
name : 'Linux for m68k';
shortname : 'linux';
flags : [];
cpu : m68k;
short_name : 'LINUX';
unit_env : 'LINUXUNITS';
extradefines : 'UNIX';
sourceext : '.pp';
pasext : '.pas';
exeext : '';
defext : '';
scriptext : '.sh';
smartext : '.sl';
unitext : '.ppu';
unitlibext : '.ppl';
asmext : '.s';
objext : '.o';
resext : '.res';
resobjext : '.or';
sharedlibext : '.so';
staticlibext : '.a';
staticlibprefix : 'libp';
sharedlibprefix : 'lib';
sharedClibext : '.so';
staticClibext : '.a';
staticClibprefix : 'lib';
sharedClibprefix : 'lib';
Cprefix : '';
newline : #10;
dirsep : '/';
files_case_relevent : true;
assem : as_m68k_as;
assemextern : as_m68k_as;
link : ld_m68k_linux;
linkextern : ld_m68k_linux;
ar : ar_m68k_ar;
res : res_none;
script : script_unix;
endian : endian_big;
stackalignment : 2;
maxCrecordalignment : 32;
size_of_pointer : 4;
size_of_longint : 4;
heapsize : 128*1024;
maxheapsize : 32768*1024;
stacksize : 8192;
DllScanSupported:false;
use_bound_instruction : false;
use_function_relative_addresses : true
);
{$endif m68k}
{$ifdef powerpc}
const
target_powerpc_linux_info : ttargetinfo =
(
target : target_powerpc_LINUX;
name : 'Linux for PowerPC';
shortname : 'linuxppc';
flags : [];
cpu : powerpc;
short_name : 'LINUX';
unit_env : '';
extradefines : 'UNIX';
sourceext : '.pp';
pasext : '.pas';
exeext : '';
defext : '.def';
scriptext : '.sh';
smartext : '.sl';
unitext : '.ppu';
unitlibext : '.ppl';
asmext : '.s';
objext : '.o';
resext : '.res';
resobjext : '.or';
sharedlibext : '.so';
staticlibext : '.s';
staticlibprefix : 'libp';
sharedlibprefix : 'lib';
sharedClibext : '.so';
staticClibext : '.a';
staticClibprefix : 'lib';
sharedClibprefix : 'lib';
Cprefix : '';
newline : #10;
dirsep : '/';
files_case_relevent : true;
assem : as_powerpc_as;
assemsrc : as_powerpc_as;
ar : ar_powerpc_ar;
res : res_none;
script : script_unix;
endian : endian_big;
stackalignment : 8;
maxCrecordalignment : 32;
size_of_pointer : 4;
size_of_longint : 4;
heapsize : 256*1024;
maxheapsize : 32768*1024;
stacksize : 8192;
DllScanSupported:false;
use_bound_instruction : false;
use_function_relative_addresses : true
);
{$endif powerpc}
{$ifdef alpha}
const
target_alpha_linux_info : ttargetinfo =
(
target : target_alpha_LINUX;
name : 'Linux for Alpha';
shortname : 'axplinux';
flags : [];
cpu : alpha;
short_name : 'LINUX';
unit_env : 'LINUXUNITS';
extradefines : 'UNIX';
sourceext : '.pp';
pasext : '.pas';
exeext : '';
defext : '.def';
scriptext : '.sh';
smartext : '.sl';
unitext : '.ppu';
unitlibext : '.ppl';
asmext : '.s';
objext : '.o';
resext : '.res';
resobjext : '.or';
sharedlibext : '.so';
staticlibext : '.a';
staticlibprefix : 'libp';
sharedlibprefix : 'lib';
sharedClibext : '.so';
staticClibext : '.a';
staticClibprefix : 'lib';
sharedClibprefix : 'lib';
Cprefix : '';
newline : #10;
dirsep : '/';
files_case_relevent : true;
assem : as_alpha_as;
assemextern : as_alpha_as;
link : ld_alpha_linux;
linkextern : ld_alpha_linux;
ar : ar_alpha_ar;
res : res_none;
script : script_unix;
endian : endian_little;
stackalignment : 8;
maxCrecordalignment : 32;
size_of_pointer : 8;
size_of_longint : 4;
heapsize : 256*1024;
maxheapsize : 32768*1024;
stacksize : 8192;
DllScanSupported:false;
use_bound_instruction : false;
use_function_relative_addresses : true
);
{$endif alpha}
initialization
{$ifdef i386}
RegisterLinker(ld_i386_linux,TLinkerLinux);
RegisterImport(target_i386_linux,timportliblinux);
RegisterExport(target_i386_linux,texportliblinux);
RegisterTarget(target_i386_linux_info);
{$endif i386}
{$ifdef m68k}
RegisterLinker(ld_m68k_linux,TLinkerLinux);
RegisterImport(target_m68k_linux,timportliblinux);
RegisterExport(target_m68k_linux,texportliblinux);
RegisterTarget(target_m68k_linux_info);
{$endif m68k}
{$ifdef powerpc}
RegisterLinker(ld_powerpc_linux,TLinkerLinux);
RegisterImport(target_powerpc_linux,timportliblinux);
RegisterExport(target_powerpc_linux,texportliblinux);
RegisterTarget(target_powerpc_linux_info);
{$endif powerpc}
{$ifdef alpha}
RegisterLinker(ld_alpha_linux,TLinkerLinux);
RegisterImport(target_alpha_linux,timportliblinux);
RegisterExport(target_alpha_linux,texportliblinux);
RegisterTarget(target_alpha_linux_info);
{$endif alpha}
end.
{
$Log$
Revision 1.14 2001-11-02 22:58:12 peter
* procsym definition rewrite
Revision 1.13 2001/09/18 11:32:00 michael
* Fixes win32 linking problems with import libraries
* LINKLIB Libraries are now looked for using C file extensions
* get_exepath fix
Revision 1.12 2001/09/17 21:29:16 peter
* merged netbsd, fpu-overflow from fixes branch
Revision 1.11 2001/08/07 18:47:15 peter
* merged netbsd start
* profile for win32
Revision 1.10 2001/07/01 20:16:20 peter
* alignmentinfo record added
* -Oa argument supports more alignment settings that can be specified
per type: PROC,LOOP,VARMIN,VARMAX,CONSTMIN,CONSTMAX,RECORDMIN
RECORDMAX,LOCALMIN,LOCALMAX. It is possible to set the mimimum
required alignment and the maximum usefull alignment. The final
alignment will be choosen per variable size dependent on these
settings
Revision 1.9 2001/06/28 19:46:25 peter
* added override and virtual for constructors
Revision 1.8 2001/06/04 11:51:06 peter
* C linking fixed
Revision 1.7 2001/06/03 15:15:31 peter
* dllprt0 stub for linux shared libs
* pass -init and -fini for linux shared libs
* libprefix splitted into staticlibprefix and sharedlibprefix
Revision 1.6 2001/06/02 19:22:44 peter
* extradefines field added
Revision 1.5 2001/04/21 15:34:01 peter
* fixed writing of end objects to not output an empty INPUT()
Revision 1.4 2001/04/18 22:02:04 peter
* registration of targets and assemblers
Revision 1.3 2001/04/13 01:22:21 peter
* symtable change to classes
* range check generation and errors fixed, make cycle DEBUG=1 works
* memory leaks fixed
Revision 1.2 2001/03/22 10:08:12 michael
+ .ctor patch merged from fixbranch
Revision 1.1 2001/02/26 19:43:11 peter
* moved target units to subdir
Revision 1.11 2001/02/20 21:41:17 peter
* new fixfilename, findfile for unix. Look first for lowercase, then
NormalCase and last for UPPERCASE names.
Revision 1.10 2000/12/30 22:53:25 peter
* export with the case provided in the exports section
Revision 1.9 2000/12/25 00:07:30 peter
+ new tlinkedlist class (merge of old tstringqueue,tcontainer and
tlinkedlist objects)
Revision 1.8 2000/10/31 22:02:54 peter
* symtable splitted, no real code changes
Revision 1.7 2000/09/24 21:33:47 peter
* message updates merges
Revision 1.6 2000/09/24 15:06:31 peter
* use defines.inc
Revision 1.5 2000/09/10 20:26:55 peter
* bsd patches from marco
Revision 1.4 2000/08/27 16:11:54 peter
* moved some util functions from globals,cobjects to cutils
* splitted files into finput,fmodule
Revision 1.3 2000/07/13 12:08:28 michael
+ patched to 1.1.0 with former 1.09patch from peter
Revision 1.2 2000/07/13 11:32:50 michael
+ removed logs
}