paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-12 09:46:12 +02:00
Code Issues Packages Projects Releases Wiki Activity

* moved target units to subdir

Browse Source
This commit is contained in:
peter 2001-02-26 19:43:11 +00:00
parent 156b4aa55f
commit 8e0b1c84d2
10 changed files with 4358 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
compiler/Makefile
View File

@ -177,7 +177,7 @@ endif
override LOCALOPT+=$(LOCALDEF) override LOCALOPT+=$(LOCALDEF)
override FPCOPT:=$(LOCALOPT) override FPCOPT:=$(LOCALOPT)
override COMPILER_INCLUDEDIR+=$(CPU_TARGET) override COMPILER_INCLUDEDIR+=$(CPU_TARGET)
override COMPILER_UNITDIR+=$(CPU_TARGET) override COMPILER_UNITDIR+=$(CPU_TARGET) targets
override COMPILER_TARGETDIR+=. override COMPILER_TARGETDIR+=.
ifndef ECHO ifndef ECHO
ECHO:=$(strip $(wildcard $(addsuffix /gecho$(EXEEXT),$(SEARCHPATH)))) ECHO:=$(strip $(wildcard $(addsuffix /gecho$(EXEEXT),$(SEARCHPATH))))

2
compiler/Makefile.fpc
View File

@ -8,7 +8,7 @@ version=1.1
[compiler] [compiler]
targetdir=. targetdir=.
unitdir=$(CPU_TARGET) unitdir=$(CPU_TARGET) targets
includedir=$(CPU_TARGET) includedir=$(CPU_TARGET)
[require] [require]

472
compiler/targets/t_fbsd.pas Normal file
View File

@ -0,0 +1,472 @@
{
$Id$
Copyright (c) 1998-2000 by Peter Vreman (original Linux)
(c) 2000 by Marco van de Voort (FreeBSD mods)
This unit implements support import,export,link routines
for the (i386)FreeBSD 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_fbsd;
{$i defines.inc}
interface
uses
import,export,link;
type
timportlibfreebsd=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;
texportlibfreebsd=class(texportlib)
procedure preparelib(const s : string);override;
procedure exportprocedure(hp : texported_item);override;
procedure exportvar(hp : texported_item);override;
procedure generatelib;override;
end;
tlinkerfreebsd=class(tlinker)
private
Glibc2,
Glibc21 : boolean;
Function WriteResponseFile(isdll:boolean) : Boolean;
public
constructor Create;
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 timportlibfreebsd.preparelib(const s : string);
begin
end;
procedure timportlibfreebsd.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
aktprocsym^.definition^.setmangledname(name)
else
message(parser_e_empty_import_name);
end;
procedure timportlibfreebsd.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 timportlibfreebsd.generatelib;
begin
end;
{*****************************************************************************
TEXPORTLIBLINUX
*****************************************************************************}
procedure texportlibfreebsd.preparelib(const s:string);
begin
end;
procedure texportlibfreebsd.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,'freebsd');
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 texportlibfreebsd.exportvar(hp : texported_item);
begin
hp.is_var:=true;
exportprocedure(hp);
end;
procedure texportlibfreebsd.generatelib;
var
hp2 : texported_item;
begin
hp2:=texported_item(current_module._exports.first);
while assigned(hp2) do
begin
if not hp2.is_var 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(hp2.sym^.mangledname)));
codeSegment.concat(Tai_symbol_end.Createname(hp2.name^));
{$endif i386}
end
else
Message1(parser_e_no_export_of_variables_for_target,'freebsd');
hp2:=texported_item(hp2.next);
end;
end;
{*****************************************************************************
TLINKERLINUX
*****************************************************************************}
Constructor TLinkerFreeBSD.Create;
begin
Inherited Create;
LibrarySearchPath.AddPath('/lib;/usr/lib;/usr/X11R6/lib',true);
end;
procedure TLinkerFreeBSD.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 -shared -L. -o $EXE $RES';
DllCmd[2]:='strip --strip-unneeded $EXE';
{ first try glibc2 }
{$ifndef BSD} {Keep linux code in place. FBSD might go to a different
glibc too once}
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';
{$ELSE}
DynamicLinker:='';
{$endif}
end;
end;
Function TLinkerFreeBSD.WriteResponseFile(isdll:boolean) : Boolean;
Var
linkres : TLinkRes;
i : longint;
cprtobj,
gprtobj,
prtobj : string[80];
HPath : TStringListItem;
s : string;
linkdynamic,
linklibc : boolean;
begin
WriteResponseFile:=False;
{ set special options for some targets }
linkdynamic:=not(SharedLibFiles.empty);
linklibc:=(SharedLibFiles.Find('c')<>nil);
prtobj:='prt0';
cprtobj:='cprt0';
gprtobj:='gprt0';
if glibc21 then
begin
cprtobj:='cprt21';
gprtobj:='gprt21';
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.Init(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;
{ objects which must be at the end }
if linklibc then
begin
if librarysearchpath.FindFile('crtend.o',s) then
LinkRes.AddFileName(s);
if librarysearchpath.FindFile('crtn.o',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_os.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;
{ Write and Close response }
linkres.writetodisk;
linkres.done;
WriteResponseFile:=True;
end;
function TLinkerFreeBSD.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 TLinkerFreeBSD.MakeSharedLibrary:boolean;
var
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);
{ 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);
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;
end.
{
$Log$
Revision 1.1 2001-02-26 19:43:11 peter
* moved target units to subdir
Revision 1.7 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.6 2000/12/30 22:53:25 peter
* export with the case provided in the exports section
Revision 1.5 2000/12/25 00:07:30 peter
+ new tlinkedlist class (merge of old tstringqueue,tcontainer and
tlinkedlist objects)
Revision 1.4 2000/10/31 22:02:53 peter
* symtable splitted, no real code changes
Revision 1.3 2000/09/24 21:33:47 peter
* message updates merges
Revision 1.2 2000/09/24 15:12:12 peter
* renamed to be 8.3
Revision 1.2 2000/09/16 12:24:00 peter
* freebsd support routines
}

209
compiler/targets/t_go32v1.pas Normal file
View File

@ -0,0 +1,209 @@
{
$Id$
Copyright (c) 1998-2000 by Peter Vreman
This unit implements support import,export,link routines
for the (i386) go32v1 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_go32v1;
{$i defines.inc}
interface
uses
link;
type
tlinkergo32v1=class(tlinker)
private
Function WriteResponseFile(isdll:boolean) : Boolean;
public
constructor Create;
procedure SetDefaultInfo;override;
function MakeExecutable:boolean;override;
end;
implementation
uses
cutils,cclasses,
globtype,globals,systems,verbose,script,fmodule;
{****************************************************************************
TLinkergo32v1
****************************************************************************}
Constructor TLinkergo32v1.Create;
begin
Inherited Create;
{ allow duplicated libs (PM) }
SharedLibFiles.doubles:=true;
StaticLibFiles.doubles:=true;
end;
procedure TLinkergo32v1.SetDefaultInfo;
begin
with Info do
begin
ExeCmd[1]:='ld -oformat coff-go32 $OPT $STRIP -o $EXE @$RES';
ExeCmd[2]:='aout2exe $EXE';
end;
end;
Function TLinkergo32v1.WriteResponseFile(isdll:boolean) : Boolean;
Var
linkres : TLinkRes;
i : longint;
HPath : TStringListItem;
s : string;
linklibc : boolean;
begin
WriteResponseFile:=False;
{ Open link.res file }
LinkRes.Init(outputexedir+Info.ResName);
{ Write path to search libraries }
HPath:=TStringListItem(current_module.locallibrarysearchpath.First);
while assigned(HPath) do
begin
LinkRes.Add('-L'+HPath.Str);
HPath:=TStringListItem(HPath.Next);
end;
HPath:=TStringListItem(LibrarySearchPath.First);
while assigned(HPath) do
begin
LinkRes.Add('-L'+HPath.Str);
HPath:=TStringListItem(HPath.Next);
end;
{ add objectfiles, start with prt0 always }
LinkRes.AddFileName(FindObjectFile('prt0',''));
while not ObjectFiles.Empty do
begin
s:=ObjectFiles.GetFirst;
if s<>'' then
LinkRes.AddFileName(s);
end;
{ Write staticlibraries }
if not StaticLibFiles.Empty then
begin
LinkRes.Add('-(');
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) }
linklibc:=false;
While not SharedLibFiles.Empty do
begin
S:=SharedLibFiles.GetFirst;
if s<>'c' then
begin
i:=Pos(target_os.sharedlibext,S);
if i>0 then
Delete(S,i,255);
LinkRes.Add('-l'+s);
end
else
begin
LinkRes.Add('-l'+s);
linklibc:=true;
end;
end;
{ be sure that libc&libgcc is the last lib }
if linklibc then
begin
LinkRes.Add('-lc');
LinkRes.Add('-lgcc');
end;
{ Write and Close response }
linkres.writetodisk;
linkres.done;
WriteResponseFile:=True;
end;
function TLinkergo32v1.MakeExecutable:boolean;
var
binstr,
cmdstr : string;
success : boolean;
StripStr : string[40];
begin
if not(cs_link_extern in aktglobalswitches) then
Message1(exec_i_linking,current_module.exefilename^);
{ Create some replacements }
StripStr:='';
if (cs_link_strip in aktglobalswitches) then
StripStr:='-s';
{ 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,'$STRIP',StripStr);
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;
end.
{
$Log$
Revision 1.1 2001-02-26 19:43:11 peter
* moved target units to subdir
Revision 1.5 2000/12/25 00:07:30 peter
+ new tlinkedlist class (merge of old tstringqueue,tcontainer and
tlinkedlist objects)
Revision 1.4 2000/09/24 15:06:30 peter
* use defines.inc
Revision 1.3 2000/08/27 16:11:54 peter
* moved some util functions from globals,cobjects to cutils
* splitted files into finput,fmodule
Revision 1.2 2000/07/13 11:32:50 michael
+ removed logs
}

445
compiler/targets/t_go32v2.pas Normal file
View File

@ -0,0 +1,445 @@
{
$Id$
Copyright (c) 1998-2000 by Peter Vreman
This unit implements support import,export,link routines
for the (i386) Go32v2 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_go32v2;
{$i defines.inc}
interface
uses
link;
type
tlinkergo32v2=class(tlinker)
private
Function WriteResponseFile(isdll:boolean) : Boolean;
Function WriteScript(isdll:boolean) : Boolean;
public
constructor Create;
procedure SetDefaultInfo;override;
function MakeExecutable:boolean;override;
end;
implementation
uses
cutils,cclasses,
globtype,globals,systems,verbose,script,fmodule;
{****************************************************************************
TLinkerGo32v2
****************************************************************************}
Constructor TLinkerGo32v2.Create;
begin
Inherited Create;
{ allow duplicated libs (PM) }
SharedLibFiles.doubles:=true;
StaticLibFiles.doubles:=true;
end;
procedure TLinkerGo32v2.SetDefaultInfo;
begin
with Info do
begin
if cs_align in aktglobalswitches then
ExeCmd[1]:='ld $SCRIPT $OPT $STRIP -o $EXE'
else
ExeCmd[1]:='ld -oformat coff-go32-exe $OPT $STRIP -o $EXE @$RES'
end;
end;
Function TLinkerGo32v2.WriteResponseFile(isdll:boolean) : Boolean;
Var
linkres : TLinkRes;
i : longint;
HPath : TStringListItem;
s : string;
linklibc : boolean;
begin
WriteResponseFile:=False;
{ Open link.res file }
LinkRes.Init(outputexedir+Info.ResName);
{ Write path to search libraries }
HPath:=TStringListItem(current_module.locallibrarysearchpath.First);
while assigned(HPath) do
begin
LinkRes.Add('-L'+GetShortName(HPath.Str));
HPath:=TStringListItem(HPath.Next);
end;
HPath:=TStringListItem(LibrarySearchPath.First);
while assigned(HPath) do
begin
LinkRes.Add('-L'+GetShortName(HPath.Str));
HPath:=TStringListItem(HPath.Next);
end;
{ add objectfiles, start with prt0 always }
LinkRes.AddFileName(GetShortName(FindObjectFile('prt0','')));
while not ObjectFiles.Empty do
begin
s:=ObjectFiles.GetFirst;
if s<>'' then
LinkRes.AddFileName(GetShortName(s));
end;
{ Write staticlibraries }
if not StaticLibFiles.Empty then
begin
LinkRes.Add('-(');
While not StaticLibFiles.Empty do
begin
S:=StaticLibFiles.GetFirst;
LinkRes.AddFileName(GetShortName(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) }
linklibc:=false;
While not SharedLibFiles.Empty do
begin
S:=SharedLibFiles.GetFirst;
if s<>'c' then
begin
i:=Pos(target_os.sharedlibext,S);
if i>0 then
Delete(S,i,255);
LinkRes.Add('-l'+s);
end
else
begin
LinkRes.Add('-l'+s);
linklibc:=true;
end;
end;
{ be sure that libc&libgcc is the last lib }
if linklibc then
begin
LinkRes.Add('-lc');
LinkRes.Add('-lgcc');
end;
{ Write and Close response }
linkres.writetodisk;
linkres.done;
WriteResponseFile:=True;
end;
Function TLinkerGo32v2.WriteScript(isdll:boolean) : Boolean;
Var
scriptres : TLinkRes;
i : longint;
s : string;
linklibc : boolean;
begin
WriteScript:=False;
{ Open link.res file }
ScriptRes.Init(outputexedir+Info.ResName);
ScriptRes.Add('OUTPUT_FORMAT("coff-go32-exe")');
ScriptRes.Add('ENTRY(start)');
{$ifdef dummy}
{ Write path to search libraries }
HPath:=current_module.locallibrarysearchpath.First;
while assigned(HPath) do
begin
ScriptRes.Add('SEARCH_PATH("'+GetShortName(HPath^.Data^)+'")');
HPath:=HPath^.Next;
end;
HPath:=LibrarySearchPath.First;
while assigned(HPath) do
begin
ScriptRes.Add('SEARCH_PATH("'+GetShortName(HPath^.Data^)+'")');
HPath:=HPath^.Next;
end;
{$endif dummy}
ScriptRes.Add('SECTIONS');
ScriptRes.Add('{');
ScriptRes.Add(' .text 0x1000+SIZEOF_HEADERS : {');
ScriptRes.Add(' . = ALIGN(16);');
{ add objectfiles, start with prt0 always }
ScriptRes.Add(' '+GetShortName(FindObjectFile('prt0',''))+'(.text)');
while not ObjectFiles.Empty do
begin
s:=ObjectFiles.GetFirst;
if s<>'' then
begin
ScriptRes.Add(' . = ALIGN(16);');
ScriptRes.Add(' '+GetShortName(s)+'(.text)');
end;
end;
ScriptRes.Add(' *(.text)');
ScriptRes.Add(' etext = . ; _etext = .;');
ScriptRes.Add(' . = ALIGN(0x200);');
ScriptRes.Add(' }');
ScriptRes.Add(' .data ALIGN(0x200) : {');
ScriptRes.Add(' djgpp_first_ctor = . ;');
ScriptRes.Add(' *(.ctor)');
ScriptRes.Add(' djgpp_last_ctor = . ;');
ScriptRes.Add(' djgpp_first_dtor = . ;');
ScriptRes.Add(' *(.dtor)');
ScriptRes.Add(' djgpp_last_dtor = . ;');
ScriptRes.Add(' *(.data)');
ScriptRes.Add(' *(.gcc_exc)');
ScriptRes.Add(' ___EH_FRAME_BEGIN__ = . ;');
ScriptRes.Add(' *(.eh_fram)');
ScriptRes.Add(' ___EH_FRAME_END__ = . ;');
ScriptRes.Add(' LONG(0)');
ScriptRes.Add(' edata = . ; _edata = .;');
ScriptRes.Add(' . = ALIGN(0x200);');
ScriptRes.Add(' }');
ScriptRes.Add(' .bss SIZEOF(.data) + ADDR(.data) :');
ScriptRes.Add(' {');
ScriptRes.Add(' _object.2 = . ;');
ScriptRes.Add(' . += 24 ;');
ScriptRes.Add(' *(.bss)');
ScriptRes.Add(' *(COMMON)');
ScriptRes.Add(' end = . ; _end = .;');
ScriptRes.Add(' . = ALIGN(0x200);');
ScriptRes.Add(' }');
ScriptRes.Add(' }');
{ Write staticlibraries }
if not StaticLibFiles.Empty then
begin
ScriptRes.Add('-(');
While not StaticLibFiles.Empty do
begin
S:=StaticLibFiles.GetFirst;
ScriptRes.AddFileName(GetShortName(s))
end;
ScriptRes.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) }
linklibc:=false;
While not SharedLibFiles.Empty do
begin
S:=SharedLibFiles.GetFirst;
if s<>'c' then
begin
i:=Pos(target_os.sharedlibext,S);
if i>0 then
Delete(S,i,255);
ScriptRes.Add('-l'+s);
end
else
begin
ScriptRes.Add('-l'+s);
linklibc:=true;
end;
end;
{ be sure that libc&libgcc is the last lib }
if linklibc then
begin
ScriptRes.Add('-lc');
ScriptRes.Add('-lgcc');
end;
{ Write and Close response }
ScriptRes.WriteToDisk;
ScriptRes.done;
WriteScript:=True;
end;
function TLinkerGo32v2.MakeExecutable:boolean;
var
binstr,
cmdstr : string;
success : boolean;
StripStr : string[40];
begin
if not(cs_link_extern in aktglobalswitches) then
Message1(exec_i_linking,current_module.exefilename^);
{ Create some replacements }
StripStr:='';
if (cs_link_strip in aktglobalswitches) then
StripStr:='-s';
if cs_align in aktglobalswitches then
WriteScript(false)
else
{ 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,'$STRIP',StripStr);
Replace(cmdstr,'$SCRIPT','--script='+outputexedir+Info.ResName);
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;
{$ifdef notnecessary}
procedure tlinkergo32v2.postprocessexecutable(const n : string);
type
tcoffheader=packed record
mach : word;
nsects : word;
time : longint;
sympos : longint;
syms : longint;
opthdr : word;
flag : word;
end;
tcoffsechdr=packed record
name : array[0..7] of char;
vsize : longint;
rvaofs : longint;
datalen : longint;
datapos : longint;
relocpos : longint;
lineno1 : longint;
nrelocs : word;
lineno2 : word;
flags : longint;
end;
psecfill=^tsecfill;
tsecfill=record
fillpos,
fillsize : longint;
next : psecfill;
end;
var
f : file;
coffheader : tcoffheader;
firstsecpos,
maxfillsize,
l : longint;
coffsec : tcoffsechdr;
secroot,hsecroot : psecfill;
zerobuf : pointer;
begin
{ when -s is used quit, because there is no .exe }
if cs_link_extern in aktglobalswitches then
exit;
{ open file }
assign(f,n);
{$I-}
reset(f,1);
if ioresult<>0 then
Message1(execinfo_f_cant_open_executable,n);
{ read headers }
seek(f,2048);
blockread(f,coffheader,sizeof(tcoffheader));
{ read section info }
maxfillsize:=0;
firstsecpos:=0;
secroot:=nil;
for l:=1to coffheader.nSects do
begin
blockread(f,coffsec,sizeof(tcoffsechdr));
if coffsec.datapos>0 then
begin
if secroot=nil then
firstsecpos:=coffsec.datapos;
new(hsecroot);
hsecroot^.fillpos:=coffsec.datapos+coffsec.vsize;
hsecroot^.fillsize:=coffsec.datalen-coffsec.vsize;
hsecroot^.next:=secroot;
secroot:=hsecroot;
if secroot^.fillsize>maxfillsize then
maxfillsize:=secroot^.fillsize;
end;
end;
if firstsecpos>0 then
begin
l:=firstsecpos-filepos(f);
if l>maxfillsize then
maxfillsize:=l;
end
else
l:=0;
{ get zero buffer }
getmem(zerobuf,maxfillsize);
fillchar(zerobuf^,maxfillsize,0);
{ zero from sectioninfo until first section }
blockwrite(f,zerobuf^,l);
{ zero section alignments }
while assigned(secroot) do
begin
seek(f,secroot^.fillpos);
blockwrite(f,zerobuf^,secroot^.fillsize);
hsecroot:=secroot;
secroot:=secroot^.next;
dispose(hsecroot);
end;
freemem(zerobuf,maxfillsize);
close(f);
{$I+}
i:=ioresult;
postprocessexecutable:=true;
end;
{$endif}
end.
{
$Log$
Revision 1.1 2001-02-26 19:43:11 peter
* moved target units to subdir
Revision 1.7 2001/01/27 21:29:35 florian
* behavior -Oa optimized
Revision 1.6 2000/12/25 00:07:30 peter
+ new tlinkedlist class (merge of old tstringqueue,tcontainer and
tlinkedlist objects)
Revision 1.5 2000/09/24 15:06:31 peter
* use defines.inc
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/08/16 13:06:07 florian
+ support of 64 bit integer constants
Revision 1.2 2000/07/13 11:32:50 michael
+ removed logs
}

481
compiler/targets/t_linux.pas Normal file
View File

@ -0,0 +1,481 @@
{
$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;
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
aktprocsym^.definition^.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 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(hp2.sym^.mangledname)));
codeSegment.concat(Tai_symbol_end.Createname(hp2.name^));
{$endif i386}
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 -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';
{$ifdef BSD}
DynamicLinker:='';
{$endif}
end;
end;
Function TLinkerLinux.WriteResponseFile(isdll:boolean) : Boolean;
Var
linkres : TLinkRes;
i : longint;
cprtobj,
gprtobj,
prtobj : string[80];
HPath : TStringListItem;
s : string;
linkdynamic,
linklibc : boolean;
begin
WriteResponseFile:=False;
{ set special options for some targets }
linkdynamic:=not(SharedLibFiles.empty);
linklibc:=(SharedLibFiles.Find('c')<>nil);
prtobj:='prt0';
cprtobj:='cprt0';
gprtobj:='gprt0';
if glibc21 then
begin
cprtobj:='cprt21';
gprtobj:='gprt21';
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.Init(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;
{ objects which must be at the end }
if linklibc then
begin
if librarysearchpath.FindFile('crtend.o',s) then
LinkRes.AddFileName(s);
if librarysearchpath.FindFile('crtn.o',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_os.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;
{ Write and Close response }
linkres.writetodisk;
linkres.done;
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
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);
{ 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);
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;
end.
{
$Log$
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
}

449
compiler/targets/t_nwm.pas Normal file
View File

@ -0,0 +1,449 @@
{
$Id$
Copyright (c) 1998-2000 by Peter Vreman
This unit implements support import,export,link routines
for the (i386) Netware 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.
First Implementation 10 Sept 2000 Armin Diehl
Currently generating NetWare-NLM's only work under Linux. This is
because nlmconf from binutils does not work with i.e. win32 coff
object files. It works fine with ELF-Objects.
The following compiler-swiches are supported for NetWare:
$DESCRIPTION : NLM-Description, will be displayed at load-time
$M : For Stack-Size, Heap-Size will be ignored
$VERSION x.x.x : Sets Major, Minor and Revision
Sorry, Displaying copyright does not work with nlmconv from gnu bunutils.
Exports will be handled like in win32:
procedure bla;
begin
end;
exports bla name 'bla';
Without Name 'bla' this will be exported in upper-case.
The path to the import-Files (from netware-sdk, see developer.novell.com)
must be specified by the library-path. All external modules are defined
as autoload.
i.e. Procedure ConsolePrintf (p:pchar); cdecl; external 'clib.nlm';
sets IMPORT @clib.imp and MODULE clib.
If you dont have nlmconv, compile gnu-binutils with
./configure --enable-targets=i386-linux,i386-netware
make all
Debugging is currently only possible at assembler level with nwdbg, written
by Jan Beulich. Nwdbg supports symbols but it's not a source-level
debugger. You can get nwdbg from developer.novell.com. To enter the
debugger from your program, define "EnterDebugger" as external cdecl and
call it. Int3 will not work with Netware 5.
A sample program:
Program Hello;
(*$DESCRIPTION HelloWorldNlm*)
(*$VERSION 1.2.2*)
(*$M 8192,8192*)
begin
writeLn ('hello world');
end.
compile with:
ppc386 -Tnetware hello
ToDo:
- No duplicate imports and autoloads
- Screen and Thread-Names
****************************************************************************
}
unit t_nwm;
{$i defines.inc}
interface
uses
import,export,link;
type
timportlibnetware=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;
texportlibnetware=class(texportlib)
procedure preparelib(const s : string);override;
procedure exportprocedure(hp : texported_item);override;
procedure exportvar(hp : texported_item);override;
procedure generatelib;override;
end;
tlinkernetware=class(tlinker)
private
Function WriteResponseFile(isdll:boolean) : Boolean;
public
constructor Create;
procedure SetDefaultInfo;override;
function MakeExecutable:boolean;override;
end;
implementation
uses
cutils,
verbose,systems,globtype,globals,
symconst,script,
fmodule,aasm,cpuasm,cpubase,symsym;
{*****************************************************************************
TIMPORTLIBNETWARE
*****************************************************************************}
procedure timportlibnetware.preparelib(const s : string);
begin
end;
procedure timportlibnetware.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
aktprocsym^.definition^.setmangledname(name)
else
message(parser_e_empty_import_name);
end;
procedure timportlibnetware.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 timportlibnetware.generatelib;
begin
end;
{*****************************************************************************
TEXPORTLIBNETWARE
*****************************************************************************}
procedure texportlibnetware.preparelib(const s:string);
begin
end;
procedure texportlibnetware.exportprocedure(hp : texported_item);
var
hp2 : texported_item;
begin
{ first test the index value }
if (hp.options and eo_index)<>0 then
begin
Comment(V_Error,'can''t export with index under netware');
exit;
end;
{ use pascal name is none specified }
if (hp.options and eo_name)=0 then
begin
hp.name:=stringdup(hp.sym^.name);
hp.options:=hp.options or eo_name;
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.insert(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 texportlibnetware.exportvar(hp : texported_item);
begin
hp.is_var:=true;
exportprocedure(hp);
end;
procedure texportlibnetware.generatelib;
var
hp2 : texported_item;
begin
hp2:=texported_item(current_module._exports.first);
while assigned(hp2) do
begin
if not hp2.is_var 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(hp2.sym^.mangledname)));
codeSegment.concat(Tai_symbol_end.Createname(hp2.name^));
{$endif i386}
end
else
Comment(V_Error,'Exporting of variables is not supported under netware');
hp2:=texported_item(hp2.next);
end;
end;
{*****************************************************************************
TLINKERNETWARE
*****************************************************************************}
Constructor TLinkerNetware.Create;
begin
Inherited Create;
end;
procedure TLinkerNetware.SetDefaultInfo;
begin
with Info do
begin
ExeCmd[1]:='nlmconv -T$RES';
{DllCmd[1]:='ld $OPT -shared -L. -o $EXE $RES';}
DllCmd[2]:='strip --strip-unneeded $EXE';
end;
end;
Function TLinkerNetware.WriteResponseFile(isdll:boolean) : Boolean;
Var
linkres : TLinkRes;
i : longint;
s,s2 : string;
ProgNam : string [80];
NlmNam : string [80];
hp2 : texported_item; { for exports }
begin
WriteResponseFile:=False;
ProgNam := current_module.exefilename^;
i:=Pos(target_os.exeext,ProgNam);
if i>0 then
Delete(ProgNam,i,255);
NlmNam := ProgNam + target_os.exeext;
{ Open link.res file }
LinkRes.Init(outputexedir+Info.ResName);
if Description <> '' then
LinkRes.Add('DESCRIPTION "' + Description + '"');
LinkRes.Add('VERSION '+tostr(dllmajor)+','+tostr(dllminor)+','+tostr(dllrevision));
LinkRes.Add('SCREENNAME "' + ProgNam + '"'); { for that, we have }
LinkRes.Add('THREADNAME "' + ProgNam + '"'); { to add comiler directives }
if stacksize > 1024 then
begin
str (stacksize, s);
LinkRes.Add ('STACKSIZE '+s);
end;
{ add objectfiles, start with nwpre always }
LinkRes.Add ('INPUT '+FindObjectFile('nwpre',''));
{ main objectfiles }
while not ObjectFiles.Empty do
begin
s:=ObjectFiles.GetFirst;
if s<>'' then
LinkRes.Add ('INPUT ' + FindObjectFile (s,''));
end;
{ output file (nlm) }
LinkRes.Add ('OUTPUT ' + NlmNam);
{ start and stop-procedures }
LinkRes.Add ('START _Prelude'); { defined in rtl/netware/nwpre.pp }
LinkRes.Add ('EXIT _Stop');
//if not (cs_link_strip in aktglobalswitches) then
{ ahhhggg: how do i detect if we have debug-symbols ? }
LinkRes.Add ('DEBUG');
{ Write staticlibraries, is that correct ? }
if not StaticLibFiles.Empty then
begin
While not StaticLibFiles.Empty do
begin
S:=lower (StaticLibFiles.GetFirst);
if s<>'' then
begin
i:=Pos(target_os.staticlibext,S);
if i>0 then
Delete(S,i,255);
S := S + '.imp';
librarysearchpath.FindFile(S,s);
LinkRes.Add('IMPORT @'+s);
end
end;
end;
if not SharedLibFiles.Empty then
begin
While not SharedLibFiles.Empty do
begin
{becuase of upper/lower case mix, we may get duplicate
names but nlmconv ignores that.
Here we are setting the import-files for nlmconv. I.e. for
the module clib or clib.nlm we add IMPORT @clib.imp and also
the module clib.nlm (autoload)
? may it be better to set autoload's via StaticLibFiles ? }
S:=lower (SharedLibFiles.GetFirst);
if s<>'' then
begin
s2:=s;
i:=Pos(target_os.sharedlibext,S);
if i>0 then
Delete(S,i,255);
S := S + '.imp';
librarysearchpath.FindFile(S,s);
LinkRes.Add('IMPORT @'+s);
LinkRes.Add('MODULE '+s2);
end
end;
end;
{ write exports }
hp2:=texported_item(current_module._exports.first);
while assigned(hp2) do
begin
if not hp2.is_var then
begin
{ Export the Symbol
Warning: The Symbol is converted to upper-case if not explicitly
specified by >>Exports BlaBla NAME 'BlaBla';<< }
Comment(V_Debug,'Exporting '+hp2.name^);
LinkRes.Add ('EXPORT '+hp2.name^);
end
else
{ really ? }
Comment(V_Error,'Exporting of variables is not supported under netware');
hp2:=texported_item(hp2.next);
end;
{ Write and Close response }
linkres.writetodisk;
linkres.done;
WriteResponseFile:=True;
end;
function TLinkerNetware.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:='';
{ 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;
end.
{
$Log$
Revision 1.1 2001-02-26 19:43:11 peter
* moved target units to subdir
Revision 1.6 2001/02/20 21:41:16 peter
* new fixfilename, findfile for unix. Look first for lowercase, then
NormalCase and last for UPPERCASE names.
Revision 1.5 2000/12/25 00:07:30 peter
+ new tlinkedlist class (merge of old tstringqueue,tcontainer and
tlinkedlist objects)
Revision 1.4 2000/11/29 00:30:42 florian
* unused units removed from uses clause
* some changes for widestrings
Revision 1.3 2000/10/31 22:02:55 peter
* symtable splitted, no real code changes
Revision 1.2 2000/09/24 15:06:31 peter
* use defines.inc
Revision 1.1 2000/09/11 17:00:23 florian
+ first implementation of Netware Module support, thanks to
Armin Diehl (diehl@nordrhein.de) for providing the patches
}

529
compiler/targets/t_os2.pas Normal file
View File

@ -0,0 +1,529 @@
{
$Id$
Copyright (c) 1998-2000 by Daniel Mantione
Portions Copyright (c) 1998-2000 Eberhard Mattes
Unit to write out import libraries and def files for OS/2
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.
****************************************************************************
}
{
A lot of code in this unit has been ported from C to Pascal from the
emximp utility, part of the EMX development system. Emximp is copyrighted
by Eberhard Mattes. Note: Eberhard doesn't know much about the Pascal
port, please send questions to Daniel Mantione
<d.s.p.mantione@twi.tudelft.nl>.
}
unit t_os2;
{$i defines.inc}
interface
uses
import,link,comprsrc;
type
timportlibos2=class(timportlib)
procedure preparelib(const s:string);override;
procedure importprocedure(const func,module:string;index:longint;const name:string);override;
procedure generatelib;override;
end;
tlinkeros2=class(tlinker)
private
Function WriteResponseFile(isdll:boolean) : Boolean;
public
constructor Create;
procedure SetDefaultInfo;override;
function MakeExecutable:boolean;override;
end;
{***************************************************************************}
{***************************************************************************}
implementation
uses
{$ifdef Delphi}
sysutils,
dmisc,
{$else Delphi}
strings,
dos,
{$endif Delphi}
cutils,cclasses,
globtype,comphook,systems,
globals,verbose,fmodule,script;
const profile_flag:boolean=false;
const n_ext = 1;
n_abs = 2;
n_text = 4;
n_data = 6;
n_bss = 8;
n_imp1 = $68;
n_imp2 = $6a;
type reloc=packed record {This is the layout of a relocation table
entry.}
address:longint; {Fixup location}
remaining:longint;
{Meaning of bits for remaining:
0..23: Symbol number or segment
24: Self-relative fixup if non-zero
25..26: Fixup size (0: 1 byte, 1: 2, 2: 4 bytes)
27: Reference to symbol or segment
28..31 Not used}
end;
nlist=packed record {This is the layout of a symbol table entry.}
strofs:longint; {Offset in string table}
typ:byte; {Type of the symbol}
other:byte; {Other information}
desc:word; {More information}
value:longint; {Value (address)}
end;
a_out_header=packed record
magic:word; {Magic word, must be $0107}
machtype:byte; {Machine type}
flags:byte; {Flags}
text_size:longint; {Length of text, in bytes}
data_size:longint; {Length of initialized data, in bytes}
bss_size:longint; {Length of uninitialized data, in bytes}
sym_size:longint; {Length of symbol table, in bytes}
entry:longint; {Start address (entry point)}
trsize:longint; {Length of relocation info for text, bytes}
drsize:longint; {Length of relocation info for data, bytes}
end;
ar_hdr=packed record
ar_name:array[0..15] of char;
ar_date:array[0..11] of char;
ar_uid:array[0..5] of char;
ar_gid:array[0..5] of char;
ar_mode:array[0..7] of char;
ar_size:array[0..9] of char;
ar_fmag:array[0..1] of char;
end;
var aout_str_size:longint;
aout_str_tab:array[0..2047] of byte;
aout_sym_count:longint;
aout_sym_tab:array[0..5] of nlist;
aout_text:array[0..63] of byte;
aout_text_size:longint;
aout_treloc_tab:array[0..1] of reloc;
aout_treloc_count:longint;
aout_size:longint;
seq_no:longint;
ar_member_size:longint;
out_file:file;
procedure write_ar(const name:string;size:longint);
var ar:ar_hdr;
time:datetime;
dummy:word;
numtime:longint;
tmp:string[19];
begin
ar_member_size:=size;
fillchar(ar.ar_name,sizeof(ar.ar_name),' ');
move(name[1],ar.ar_name,length(name));
getdate(time.year,time.month,time.day,dummy);
gettime(time.hour,time.min,time.sec,dummy);
packtime(time,numtime);
str(numtime,tmp);
fillchar(ar.ar_date,sizeof(ar.ar_date),' ');
move(tmp[1],ar.ar_date,length(tmp));
ar.ar_uid:='0 ';
ar.ar_gid:='0 ';
ar.ar_mode:='100666'#0#0;
str(size,tmp);
fillchar(ar.ar_size,sizeof(ar.ar_size),' ');
move(tmp[1],ar.ar_size,length(tmp));
ar.ar_fmag:='`'#10;
blockwrite(out_file,ar,sizeof(ar));
end;
procedure finish_ar;
var a:byte;
begin
a:=0;
if odd(ar_member_size) then
blockwrite(out_file,a,1);
end;
procedure aout_init;
begin
aout_str_size:=sizeof(longint);
aout_sym_count:=0;
aout_text_size:=0;
aout_treloc_count:=0;
end;
function aout_sym(const name:string;typ,other:byte;desc:word;
value:longint):longint;
begin
if aout_str_size+length(name)+1>sizeof(aout_str_tab) then
Do_halt($da);
if aout_sym_count>=sizeof(aout_sym_tab) div sizeof(aout_sym_tab[0]) then
Do_halt($da);
aout_sym_tab[aout_sym_count].strofs:=aout_str_size;
aout_sym_tab[aout_sym_count].typ:=typ;
aout_sym_tab[aout_sym_count].other:=other;
aout_sym_tab[aout_sym_count].desc:=desc;
aout_sym_tab[aout_sym_count].value:=value;
strPcopy(@aout_str_tab[aout_str_size],name);
aout_str_size:=aout_str_size+length(name)+1;
aout_sym:=aout_sym_count;
inc(aout_sym_count);
end;
procedure aout_text_byte(b:byte);
begin
if aout_text_size>=sizeof(aout_text) then
Do_halt($da);
aout_text[aout_text_size]:=b;
inc(aout_text_size);
end;
procedure aout_text_dword(d:longint);
type li_ar=array[0..3] of byte;
begin
aout_text_byte(li_ar(d)[0]);
aout_text_byte(li_ar(d)[1]);
aout_text_byte(li_ar(d)[2]);
aout_text_byte(li_ar(d)[3]);
end;
procedure aout_treloc(address,symbolnum,pcrel,len,ext:longint);
begin
if aout_treloc_count>=sizeof(aout_treloc_tab) div sizeof(reloc) then
Do_halt($da);
aout_treloc_tab[aout_treloc_count].address:=address;
aout_treloc_tab[aout_treloc_count].remaining:=symbolnum+pcrel shl 24+
len shl 25+ext shl 27;
inc(aout_treloc_count);
end;
procedure aout_finish;
begin
while (aout_text_size and 3)<>0 do
aout_text_byte ($90);
aout_size:=sizeof(a_out_header)+aout_text_size+aout_treloc_count*
sizeof(reloc)+aout_sym_count*sizeof(aout_sym_tab[0])+aout_str_size;
end;
procedure aout_write;
var ao:a_out_header;
begin
ao.magic:=$0107;
ao.machtype:=0;
ao.flags:=0;
ao.text_size:=aout_text_size;
ao.data_size:=0;
ao.bss_size:=0;
ao.sym_size:=aout_sym_count*sizeof(aout_sym_tab[0]);
ao.entry:=0;
ao.trsize:=aout_treloc_count*sizeof(reloc);
ao.drsize:=0;
blockwrite(out_file,ao,sizeof(ao));
blockwrite(out_file,aout_text,aout_text_size);
blockwrite(out_file,aout_treloc_tab,sizeof(reloc)*aout_treloc_count);
blockwrite(out_file,aout_sym_tab,sizeof(aout_sym_tab[0])*aout_sym_count);
longint((@aout_str_tab)^):=aout_str_size;
blockwrite(out_file,aout_str_tab,aout_str_size);
end;
procedure timportlibos2.preparelib(const s:string);
{This code triggers a lot of bugs in the compiler.
const armag='!<arch>'#10;
ar_magic:array[1..length(armag)] of char=armag;}
const ar_magic:array[1..8] of char='!<arch>'#10;
var
libname : string;
begin
libname:=FixFileName(s+'.ao2');
seq_no:=1;
current_module.linkunitstaticlibs.add(libname,link_allways);
assign(out_file,current_module.outputpath^+libname);
rewrite(out_file,1);
blockwrite(out_file,ar_magic,sizeof(ar_magic));
end;
procedure timportlibos2.importprocedure(const func,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.
name = Name of function in DLL. Ignored when index=0;}
var tmp1,tmp2,tmp3:string;
sym_mcount,sym_import:longint;
fixup_mcount,fixup_import:longint;
begin
aout_init;
tmp2:=func;
if profile_flag and not (copy(func,1,4)='_16_') then
begin
{sym_entry:=aout_sym(func,n_text+n_ext,0,0,aout_text_size);}
sym_mcount:=aout_sym('__mcount',n_ext,0,0,0);
{Use, say, "_$U_DosRead" for "DosRead" to import the
non-profiled function.}
tmp2:='__$U_'+func;
sym_import:=aout_sym(tmp2,n_ext,0,0,0);
aout_text_byte($55); {push ebp}
aout_text_byte($89); {mov ebp, esp}
aout_text_byte($e5);
aout_text_byte($e8); {call _mcount}
fixup_mcount:=aout_text_size;
aout_text_dword(0-(aout_text_size+4));
aout_text_byte($5d); {pop ebp}
aout_text_byte($e9); {jmp _$U_DosRead}
fixup_import:=aout_text_size;
aout_text_dword(0-(aout_text_size+4));
aout_treloc(fixup_mcount,sym_mcount,1,2,1);
aout_treloc (fixup_import, sym_import,1,2,1);
end;
str(seq_no,tmp1);
tmp1:='IMPORT#'+tmp1;
if name='' then
begin
str(index,tmp3);
tmp3:=func+'='+module+'.'+tmp3;
end
else
tmp3:=func+'='+module+'.'+name;
aout_sym(tmp2,n_imp1+n_ext,0,0,0);
aout_sym(tmp3,n_imp2+n_ext,0,0,0);
aout_finish;
write_ar(tmp1,aout_size);
aout_write;
finish_ar;
inc(seq_no);
end;
procedure timportlibos2.generatelib;
begin
close(out_file);
end;
{****************************************************************************
TLinkeros2
****************************************************************************}
Constructor TLinkeros2.Create;
begin
Inherited Create;
{ allow duplicated libs (PM) }
SharedLibFiles.doubles:=true;
StaticLibFiles.doubles:=true;
end;
procedure TLinkeros2.SetDefaultInfo;
begin
with Info do
begin
ExeCmd[1]:='ld $OPT -o $EXE @$RES';
ExeCmd[2]:='emxbind -b $STRIP $APPTYPE $RSRC -k$STACKKB -h$HEAPMB -o $EXE.exe $EXE -aim -s$DOSHEAPKB';
end;
end;
Function TLinkeros2.WriteResponseFile(isdll:boolean) : Boolean;
Var
linkres : TLinkRes;
i : longint;
HPath : TStringListItem;
s : string;
begin
WriteResponseFile:=False;
{ Open link.res file }
LinkRes.Init(outputexedir+Info.ResName);
{ Write path to search libraries }
HPath:=TStringListItem(current_module.locallibrarysearchpath.First);
while assigned(HPath) do
begin
LinkRes.Add('-L'+HPath.Str);
HPath:=TStringListItem(HPath.Next);
end;
HPath:=TStringListItem(LibrarySearchPath.First);
while assigned(HPath) do
begin
LinkRes.Add('-L'+HPath.Str);
HPath:=TStringListItem(HPath.Next);
end;
{ add objectfiles, start with prt0 always }
LinkRes.AddFileName(FindObjectFile('prt0',''));
while not ObjectFiles.Empty do
begin
s:=ObjectFiles.GetFirst;
if s<>'' then
LinkRes.AddFileName(s);
end;
{ Write staticlibraries }
{ No group !! This will not work correctly PM }
While not StaticLibFiles.Empty do
begin
S:=StaticLibFiles.GetFirst;
LinkRes.AddFileName(s)
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) }
While not SharedLibFiles.Empty do
begin
S:=SharedLibFiles.GetFirst;
i:=Pos(target_os.sharedlibext,S);
if i>0 then
Delete(S,i,255);
LinkRes.Add('-l'+s);
end;
{ Write and Close response }
linkres.writetodisk;
linkres.done;
WriteResponseFile:=True;
end;
function TLinkeros2.MakeExecutable:boolean;
var
binstr,
cmdstr : string;
success : boolean;
i : longint;
AppTypeStr,
StripStr: string[40];
RsrcStr : string;
begin
if not(cs_link_extern in aktglobalswitches) then
Message1(exec_i_linking,current_module.exefilename^);
{ Create some replacements }
if (cs_link_strip in aktglobalswitches) then
StripStr := '-s'
else
StripStr := '';
if (usewindowapi) or (AppType = app_gui) then
AppTypeStr := '-p'
else if AppType = app_fs then
AppTypeStr := '-f'
else AppTypeStr := '-w';
if not (Current_module.ResourceFiles.Empty) then
RsrcStr := '-r ' + Current_module.ResourceFiles.GetFirst
else
RsrcStr := '';
(* Only one resource file supported, discard everything else
(should be already empty anyway, however. *)
Current_module.ResourceFiles.Clear;
{ Write used files and libraries }
WriteResponseFile(false);
{ Call linker }
success:=false;
for i:=1 to 2 do
begin
SplitBinCmd(Info.ExeCmd[i],binstr,cmdstr);
if binstr<>'' then
begin
Replace(cmdstr,'$HEAPMB',tostr((maxheapsize+1048575) shr 20));
{Size of the stack when an EMX program runs in OS/2.}
Replace(cmdstr,'$STACKKB',tostr((stacksize+1023) shr 10));
{When an EMX program runs in DOS, the heap and stack share the
same memory pool. The heap grows upwards, the stack grows downwards.}
Replace(cmdstr,'$DOSHEAPKB',tostr((stacksize+maxheapsize+1023) shr 10));
Replace(cmdstr,'$STRIP',StripStr);
Replace(cmdstr,'$APPTYPE',AppTypeStr);
Replace(cmdstr,'$RES',outputexedir+Info.ResName);
Replace(cmdstr,'$OPT',Info.ExtraOptions);
Replace(cmdstr,'$RSRC',RsrcStr);
Replace(cmdstr,'$EXE',current_module.exefilename^);
success:=DoExec(FindUtil(binstr),cmdstr,(i=1),false);
(* We still want to have the PPAS script complete, right?
if not success then
break;
*)
end;
end;
{ 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;
end.
{
$Log$
Revision 1.1 2001-02-26 19:43:11 peter
* moved target units to subdir
Revision 1.7 2001/01/20 18:32:52 hajny
+ APPTYPE support under OS/2, app_fs, GetEnvPChar for OS/2
Revision 1.6 2000/12/25 00:07:30 peter
+ new tlinkedlist class (merge of old tstringqueue,tcontainer and
tlinkedlist objects)
Revision 1.5 2000/09/24 15:06:31 peter
* use defines.inc
Revision 1.4 2000/09/20 19:38:34 peter
* fixed staticlib filename and unitlink instead of otherlinky
Revision 1.3 2000/08/27 16:11:54 peter
* moved some util functions from globals,cobjects to cutils
* splitted files into finput,fmodule
Revision 1.2 2000/07/13 11:32:50 michael
+ removed logs
}

480
compiler/targets/t_sunos.pas Normal file
View File

@ -0,0 +1,480 @@
{
$Id$
Copyright (c) 1998-2000 by Peter Vreman
This unit implements support import,export,link routines
for the (i386) sunos 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_sunos;
{$i defines.inc}
interface
{ copy from t_linux
// Up to now we use gld since the solaris ld seems not support .res-files}
{-$DEFINE LinkTest} { DON't del link.res and write Info }
{$DEFINE GnuLd} {The other is not implemented }
uses
import,export,link;
type
timportlibsunos=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;
texportlibsunos=class(texportlib)
procedure preparelib(const s : string);override;
procedure exportprocedure(hp : texported_item);override;
procedure exportvar(hp : texported_item);override;
procedure generatelib;override;
end;
tlinkersunos=class(tlinker)
private
Glibc2,
Glibc21 : boolean;
Function WriteResponseFile(isdll:boolean) : Boolean;
public
constructor Create;
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;
{*****************************************************************************
TIMPORTLIBsunos
*****************************************************************************}
procedure timportlibsunos.preparelib(const s : string);
begin
{$ifDef LinkTest}
WriteLN('Prepare import: ',s);
{$EndIf}
end;
procedure timportlibsunos.importprocedure(const func,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_allways);
{ do nothing with the procedure, only set the mangledname }
if name<>'' then
aktprocsym^.definition^.setmangledname(name)
else
message(parser_e_empty_import_name);
end;
procedure timportlibsunos.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 timportlibsunos.generatelib;
begin
end;
{*****************************************************************************
TEXPORTLIBsunos
*****************************************************************************}
procedure texportlibsunos.preparelib(const s:string);
begin
end;
procedure texportlibsunos.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,'SunOS');
exit;
end;
{ use pascal name is none specified }
if (hp.options and eo_name)=0 then
begin
hp.name:=stringdup(hp.sym^.name);
hp.options:=hp.options or eo_name;
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.insert(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 texportlibsunos.exportvar(hp : texported_item);
begin
hp.is_var:=true;
exportprocedure(hp);
end;
procedure texportlibsunos.generatelib;
var
hp2 : texported_item;
begin
hp2:=texported_item(current_module._exports.first);
while assigned(hp2) do
begin
if not hp2.is_var 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(hp2.sym^.mangledname)));
codeSegment.concat(Tai_symbol_end.Createname(hp2.name^));
{$endif i386}
end
else
Message1(parser_e_no_export_of_variables_for_target,'SunOS');
hp2:=texported_item(hp2.next);
end;
end;
{*****************************************************************************
TLINKERSUNOS
*****************************************************************************}
Constructor TLinkersunos.Create;
begin
Inherited Create;
LibrarySearchPath.AddPath('/lib;/usr/lib;/usr/X11R6/lib;/opt/sfw/lib',true);
{$ifdef LinkTest}
if (cs_link_staticflag in aktglobalswitches) then WriteLN('ForceLinkStaticFlag');
if (cs_link_static in aktglobalswitches) then WriteLN('LinkStatic-Flag');
if (cs_link_shared in aktglobalswitches) then WriteLN('LinkSynamicFlag');
{$EndIf}
end;
procedure TLinkersunos.SetDefaultInfo;
{
This will also detect which libc version will be used
}
begin
Glibc2:=false;
Glibc21:=false;
with Info do
begin
{$IFDEF GnuLd}
ExeCmd[1]:='gld $OPT $DYNLINK $STATIC $STRIP -L. -o $EXE $RES';
DllCmd[1]:='gld $OPT -shared -L. -o $EXE $RES';
DllCmd[2]:='strip --strip-unneeded $EXE';
DynamicLinker:=''; { Gnu uses the default }
Glibc21:=false;
{$ELSE}
Not Implememted
{$ENDIF}
(* Linux Stuff not needed?
{ first try glibc2 } // muss noch gendert werden
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 TLinkersunos.WriteResponseFile(isdll:boolean) : Boolean;
Var
linkres : TLinkRes;
i : longint;
cprtobj,
gprtobj,
prtobj : string[80];
HPath : TStringListItem;
s : string;
linkdynamic,
linklibc : boolean;
begin
WriteResponseFile:=False;
{ set special options for some targets }
linkdynamic:=not(SharedLibFiles.empty);
{ linkdynamic:=false; // da nicht getestet }
linklibc:=(SharedLibFiles.Find('c')<>nil);
prtobj:='prt0';
cprtobj:='cprt0';
gprtobj:='gprt0';
(* if glibc21 then
begin
cprtobj:='cprt21';
gprtobj:='gprt21';
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
else
AddSharedLibrary('c'); { quick hack: this sunos implementation needs alwys libc }
end;
{ Open link.res file }
LinkRes.Init(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 { Needed in sunos? }
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;
{ objects which must be at the end }
if linklibc then { Needed in sunos? }
begin
if librarysearchpath.FindFile('crtend.o',s) then
LinkRes.AddFileName(s);
if librarysearchpath.FindFile('crtn.o',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_os.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-sunos (war 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 begin
LinkRes.Add('-lgcc');
end;
if linkdynamic and (Info.DynamicLinker<>'') then { gld has a default, DynamicLinker is not set in sunos }
LinkRes.AddFileName(Info.DynamicLinker);
LinkRes.Add(')');
end;
{ Write and Close response }
linkres.writetodisk;
linkres.done;
WriteResponseFile:=True;
end;
function TLinkersunos.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:='-Bstatic';
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;
{ sunos sets DynamicLinker, but gld will (hopefully) defaults to -Bdynamic and add the default-linker }
{ 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 }
{$IFNDEF LinkTest}
if (success) and not(cs_link_extern in aktglobalswitches) then
RemoveFile(outputexedir+Info.ResName);
{$ENDIF}
MakeExecutable:=success; { otherwise a recursive call to link method }
end;
Function TLinkersunos.MakeSharedLibrary:boolean;
var
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);
{ 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);
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 }
{$IFNDEF LinkTest}
if (success) and not(cs_link_extern in aktglobalswitches) then
RemoveFile(outputexedir+Info.ResName);
{$ENDIF}
MakeSharedLibrary:=success; { otherwise a recursive call to link method }
end;
end.
{
$Log$
Revision 1.1 2001-02-26 19:43:11 peter
* moved target units to subdir
}

1291
compiler/targets/t_win32.pas Normal file
View File

File diff suppressed because it is too large Load Diff