paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-06 11:28:06 +02:00
Code Issues Packages Projects Releases Wiki Activity

* gba patch from Francesco Lombardi

Browse Source 
git-svn-id: trunk@3716 -
This commit is contained in:
florian 2006-05-28 14:48:24 +00:00
parent 9b54dcc781
commit 5575a837db
26 changed files with 4159 additions and 579 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
.gitattributes vendored
View File

@ -3775,12 +3775,28 @@ rtl/freebsd/unxsockh.inc svneol=native#text/plain
rtl/freebsd/unxsysc.inc svneol=native#text/plain
rtl/freebsd/x86_64/bsyscall.inc svneol=native#text/plain
rtl/freebsd/x86_64/prt0.as -text
rtl/gba/Makefile svneol=native#text/plain
rtl/gba/Makefile.fpc svneol=native#text/plain
rtl/gba/classes.pp svneol=native#text/plain
rtl/gba/dos.pp svneol=native#text/plain
rtl/gba/fpc4gba.txt svneol=native#text/plain
rtl/gba/gbabios.inc svneol=native#text/plain
rtl/gba/gbabiosh.inc svneol=native#text/plain
rtl/gba/lnkscript -text
rtl/gba/prt0.as svneol=native#text/plain
rtl/gba/prt0.s -text
rtl/gba/sysdir.inc svneol=native#text/plain
rtl/gba/sysfile.inc svneol=native#text/plain
rtl/gba/sysgba.pp svneol=native#text/plain
rtl/gba/sysheap.inc svneol=native#text/plain
rtl/gba/sysos.inc svneol=native#text/plain
rtl/gba/sysosh.inc svneol=native#text/plain
rtl/gba/system.pp svneol=native#text/plain
rtl/gba/systhrd.inc svneol=native#text/plain
rtl/gba/sysutils.pp svneol=native#text/plain
rtl/gba/tthread.inc svneol=native#text/plain
rtl/gba/unix.pp svneol=native#text/plain
rtl/gba/varutils.pp svneol=native#text/plain
rtl/go32v2/Makefile svneol=native#text/plain
rtl/go32v2/Makefile.fpc svneol=native#text/plain
rtl/go32v2/classes.pp svneol=native#text/plain

7
compiler/systems/i_gba.pas
View File

@ -32,10 +32,11 @@ unit i_gba;
system : system_arm_gba;
name : 'GameBoy Advance';
shortname : 'gba';
flags : [tf_needs_symbol_size,tf_files_case_sensitive,tf_use_function_relative_addresses];
flags : [tf_needs_symbol_size,tf_files_case_sensitive,tf_use_function_relative_addresses,
tf_smartlink_sections];
cpu : cpu_arm;
unit_env : 'LINUXUNITS';
extradefines : 'UNIX;HASUNIX';
unit_env : '';
extradefines : '';
exeext : '.gba';
defext : '.def';
scriptext : '.sh';

292
compiler/systems/t_gba.pas
View File

@ -24,268 +24,200 @@ unit t_gba;
{$i fpcdefs.inc}
interface
uses
symsym,symdef,
import,export,link;
type
tlinkergba=class(texternallinker)
private
libctype:(libc5,glibc2,glibc21,uclibc);
Function WriteResponseFile : Boolean;
public
constructor Create;override;
procedure SetDefaultInfo;override;
function MakeExecutable:boolean;override;
end;
implementation
uses
link,
cutils,cclasses,
globtype,globals,systems,verbose,script,fmodule,i_gba;
uses
cutils,cclasses,verbose,systems,globtype,globals,
symconst,script,fmodule,dos,aasmbase,aasmtai,aasmdata,aasmcpu,
cpubase,cgobj,i_gba;
type
TlinkerGBA=class(texternallinker)
private
Function WriteResponseFile: Boolean;
public
constructor Create; override;
procedure SetDefaultInfo; override;
function MakeExecutable:boolean; override;
end;
{*****************************************************************************
TLINKERLINUX
TLINKERGBA
*****************************************************************************}
Constructor TLinkerGba.Create;
begin
Inherited Create;
if not Dontlinkstdlibpath Then
LibrarySearchPath.AddPath('/lib;/usr/lib;/usr/X11R6/lib',true);
SharedLibFiles.doubles:=true;
StaticLibFiles.doubles:=true;
end;
procedure TLinkerGba.SetDefaultInfo;
{
This will also detect which libc version will be used
}
begin
with Info do
begin
//ExeCmd[1]:='ld $OPT $DYNLINK $STATIC $GCSECTIONS $STRIP -L. -o $EXE $RES';
// Here we call ld with right options for GBA
ExeCmd[1]:='ld $OPT $DYNLINK $STATIC $GCSECTIONS $STRIP -Ttext 0x08000000 -Tbss 0x03000000 -L. -o $EXE $RES';
DllCmd[1]:='ld $OPT $INIT $FINI $SONAME -shared -L. -o $EXE $RES';
DllCmd[2]:='strip --strip-unneeded $EXE';
DynamicLinker:='/lib/ld-linux.so.2';
libctype:=glibc2;
ExeCmd[1]:='ld $OPT $DYNLINK $STATIC $GCSECTIONS $STRIP -L. -o $EXE $RES';
end;
end;
Function TLinkerGba.WriteResponseFile: Boolean;
Var
linkres : TLinkRes;
i : longint;
cprtobj,
gprtobj,
prtobj : string[80];
HPath : TStringListItem;
s,s1,s2 : string;
found1,
found2,
linklibc : boolean;
linkres : TLinkRes;
i : longint;
HPath : TStringListItem;
s : string;
linklibc : boolean;
begin
WriteResponseFile:=False;
{ set special options for some targets }
linklibc:=(SharedLibFiles.Find('c')<>nil);
prtobj:='prt0';
case libctype of
glibc21:
begin
cprtobj:='cprt21';
gprtobj:='gprt21';
end;
uclibc:
begin
cprtobj:='ucprt0';
gprtobj:='ugprt0';
end
else
cprtobj:='cprt0';
gprtobj:='gprt0';
end;
if cs_profile in aktmoduleswitches then
begin
prtobj:=gprtobj;
if not(libctype in [glibc2,glibc21]) then
AddSharedLibrary('gmon');
AddSharedLibrary('c');
linklibc:=true;
end
else
begin
if linklibc then
prtobj:=cprtobj;
end;
{ Open link.res file }
{ 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('+maybequoted(HPath.Str)+')');
HPath:=TStringListItem(HPath.Next);
s:=HPath.Str;
if (cs_link_on_target in aktglobalswitches) then
s:=ScriptFixFileName(s);
LinkRes.Add('-L'+s);
HPath:=TStringListItem(HPath.Next);
end;
HPath:=TStringListItem(LibrarySearchPath.First);
while assigned(HPath) do
begin
LinkRes.Add('SEARCH_DIR('+maybequoted(HPath.Str)+')');
HPath:=TStringListItem(HPath.Next);
s:=HPath.Str;
if s<>'' then
LinkRes.Add('SEARCH_DIR('+(maybequoted(s))+')');
HPath:=TStringListItem(HPath.Next);
end;
LinkRes.Add('INPUT(');
LinkRes.Add('INPUT (');
{ add objectfiles, start with prt0 always }
if prtobj<>'' then
LinkRes.AddFileName(maybequoted(FindObjectFile(prtobj,'',false)));
{ 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 }
s:=FindObjectFile('prt0','',false);
LinkRes.AddFileName(s);
while not ObjectFiles.Empty do
begin
s:=ObjectFiles.GetFirst;
if s<>'' then
LinkRes.AddFileName(maybequoted(s));
s:=ObjectFiles.GetFirst;
if s<>'' then
begin
{ vlink doesn't use SEARCH_DIR for object files }
if not(cs_link_on_target in aktglobalswitches) then
s:=FindObjectFile(s,'',false);
LinkRes.AddFileName((maybequoted(s)));
end;
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(maybequoted(s))
end;
LinkRes.Add(')');
{ vlink doesn't need, and doesn't support GROUP }
if (cs_link_on_target in aktglobalswitches) then
begin
LinkRes.Add(')');
LinkRes.Add('GROUP(');
end;
while not StaticLibFiles.Empty do
begin
S:=StaticLibFiles.GetFirst;
LinkRes.AddFileName((maybequoted(s)));
end;
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
if (cs_link_on_target in aktglobalswitches) 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;
end;
end;
{ be sure that libc is the last lib }
if linklibc then
LinkRes.Add(')');
{ 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_info.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');
{ when we have -static for the linker the we also need libgcc }
if (cs_link_staticflag in aktglobalswitches) then
LinkRes.Add('-lgcc');
LinkRes.Add(')');
end;
end
else
begin
while not SharedLibFiles.Empty do
begin
S:=SharedLibFiles.GetFirst;
LinkRes.Add('lib'+s+target_info.staticlibext);
end;
LinkRes.Add(')');
end;
{ objects which must be at the end }
if linklibc and (libctype<>uclibc) 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;
linkres.free;
WriteResponseFile:=True;
end;
function TLinkerGba.MakeExecutable:boolean;
var
binstr : String;
binstr : string;
cmdstr : TCmdStr;
success : boolean;
DynLinkStr : string[60];
GCSectionsStr,
StaticStr,
StripStr : string[40];
StripStr: string[40];
begin
//if not(cs_link_extern in aktglobalswitches) then
if not(cs_link_nolink in aktglobalswitches) then
Message1(exec_i_linking,current_module.exefilename^);
{ Create some replacements }
StaticStr:='';
StripStr:='';
GCSectionsStr:='';
DynLinkStr:='';
if (cs_link_staticflag in aktglobalswitches) then
StaticStr:='-static';
if (cs_link_strip in aktglobalswitches) then
StripStr:='-s';
if (cs_link_smart in aktglobalswitches) and
(tf_smartlink_sections in target_info.flags) then
GCSectionsStr:='--gc-sections';
If (cs_profile in aktmoduleswitches) or
((Info.DynamicLinker<>'') and (not SharedLibFiles.Empty)) then
begin
DynLinkStr:='-dynamic-linker='+Info.DynamicLinker;
if cshared Then
DynLinkStr:='--shared ' + DynLinkStr;
if rlinkpath<>'' Then
DynLinkStr:='--rpath-link '+rlinkpath + ' '+ DynLinkStr;
End;
{ Write used files and libraries }
WriteResponseFile;
WriteResponseFile();
{ Call linker }
SplitBinCmd(Info.ExeCmd[1],binstr,cmdstr);
Replace(cmdstr,'$EXE',maybequoted(current_module.exefilename^));
Replace(cmdstr,'$OPT',Info.ExtraOptions);
Replace(cmdstr,'$RES',maybequoted(outputexedir+Info.ResName));
Replace(cmdstr,'$STATIC',StaticStr);
Replace(cmdstr,'$STRIP',StripStr);
Replace(cmdstr,'$GCSECTIONS',GCSectionsStr);
Replace(cmdstr,'$DYNLINK',DynLinkStr);
success:=DoExec(FindUtil(utilsprefix+BinStr),CmdStr,true,false);
if not(cs_link_on_target in aktglobalswitches) then
begin
Replace(cmdstr,'$EXE',(maybequoted(ScriptFixFileName(current_module.exefilename^))));
Replace(cmdstr,'$RES',(maybequoted(ScriptFixFileName(outputexedir+Info.ResName))));
Replace(cmdstr,'$STRIP',StripStr);
end
else
begin
Replace(cmdstr,'$EXE',maybequoted(ScriptFixFileName(current_module.exefilename^)));
Replace(cmdstr,'$RES',maybequoted(ScriptFixFileName(outputexedir+Info.ResName)));
end;
success:=DoExec(FindUtil(BinStr),cmdstr,true,false);
{ Remove ReponseFile }
if (success) and not(cs_link_nolink in aktglobalswitches) then
RemoveFile(outputexedir+Info.ResName);
RemoveFile(outputexedir+Info.ResName);
MakeExecutable:=success; { otherwise a recursive call to link method }
end;

1
rtl/Makefile.fpc
View File

@ -26,6 +26,7 @@ dirs_netware=netware
dirs_netwlibc=netwlibc
dirs_palmos=palmos
dirs_solaris=solaris
dirs_gba=gba
[install]
fpcpackage=y

4
rtl/arm/arm.inc
View File

@ -19,14 +19,14 @@
procedure fpc_cpuinit;
begin
{$IFNDEF WINCE}
{$if not(defined(wince)) and not(defined(gba))}
asm
rfs r0
and r0,r0,#0xffe0ffff
orr r0,r0,#0x00020000
wfs r0
end;
{$ENDIF}
{$endif}
end;
{****************************************************************************

2174
rtl/gba/Makefile Normal file
View File

File diff suppressed because it is too large Load Diff

268
rtl/gba/Makefile.fpc
View File

@ -1,101 +1,67 @@
#
# Makefile.fpc for Free Pascal GBA RTL
# Makefile.fpc for Free Pascal Win32 RTL
#
[package]
main=rtl
[target]
loaders=prt0
units=$(SYSTEMUNIT) unixtype ctypes baseunix strings objpas macpas syscall unixutil \
heaptrc lineinfo \
sysutils typinfo math \
charset getopts \
errors \
types dateutils sysconst \
cthreads classes strutils rtlconsts dos objects
loaders=$(LOADERS)
units=system ctypes objpas macpas strings \
lineinfo heaptrc matrix \
windows winsock winsock2 initc cmem dynlibs signals \
dos crt objects messages \
rtlconsts sysconst sysutils math types \
strutils convutils dateutils varutils variants typinfo classes \
cpu mmx charset ucomplex getopts \
winevent sockets printer \
video mouse keyboard \
winsysut fpmkunit
rsts=math typinfo sysconst rtlconsts
rsts=math varutils typinfo variants classes dateutils sysconst fpmkunit
[require]
nortl=y
[clean]
units=sysgba gba
[install]
fpcpackage=y
[default]
fpcdir=../..
target=gba
target=win32
[compiler]
includedir=$(INC) $(PROCINC) $(UNIXINC) $(CPU_TARGET)
sourcedir=$(INC) $(PROCINC) $(UNIXINC) $(CPU_TARGET)
targetdir=.
includedir=$(INC) $(PROCINC)
sourcedir=$(INC) $(PROCINC) $(COMMON) $(WINDIR)
[lib]
libname=libfprtl.so
libversion=2.0.0
libunits=$(SYSTEMUNIT) objpas strings \
unix ports \
dos crt objects printer \
sysutils typinfo math \
cpu mmx getopts heaptrc \
errors
[prerules]
RTL=..
INC=$(RTL)/inc
COMMON=$(RTL)/common
PROCINC=$(RTL)/$(CPU_TARGET)
UNIXINC=$(RTL)/unix
ifeq ($(CPU_TARGET),i386)
CRT21=cprt21 gprt21
CPU_UNITS=x86 ports cpu mmx graph
else
CPU_UNITS=
endif
WININC=../win/wininc
WINDIR=../win
UNITPREFIX=rtl
ifeq ($(findstring 1.0.,$(FPC_VERSION)),)
SYSTEMUNIT=system
LINUXUNIT1=
ifeq ($(CPU_TARGET),i386)
CPU_UNITS+=oldlinux
endif
LINUXUNIT2=linux
else
SYSTEMUNIT=sysgba
LINUXUNIT1=gba
LINUXUNIT2=
override FPCOPT+=-dUNIX
endif
# Use new feature from 1.0.5 version
# that generates release PPU files
# which will not be recompiled
ifdef RELEASE
override FPCOPT+=-Ur
ifneq ($(findstring 2.0.,$(FPC_VERSION)),)
LOADERS=wprt0 wdllprt0 gprt0 wcygprt0
endif
# Paths
OBJPASDIR=$(RTL)/objpas
#GRAPHDIR=$(INC)/graph
# Use new graph unit ?
# NEWGRAPH=YES
# Use LibGGI ?
# Use
#
ifndef USELIBGGI
USELIBGGI=NO
endif
# Files used by windows.pp
include $(WININC)/makefile.inc
WINDOWS_SOURCE_FILES=$(addprefix $(WININC)/,$(addsuffix .inc,$(WINDOWS_FILES)))
[rules]
# Get the $(SYSTEMUNIT) independent include file names.
SYSTEMPPU=$(addsuffix $(PPUEXT),system)
# Get the system independent include file names.
# This will set the following variables :
# SYSINCNAMES
include $(INC)/makefile.inc
@ -107,7 +73,7 @@ SYSINCDEPS=$(addprefix $(INC)/,$(SYSINCNAMES))
include $(PROCINC)/makefile.cpu
SYSCPUDEPS=$(addprefix $(PROCINC)/,$(CPUINCNAMES))
# Put $(SYSTEMUNIT) unit dependencies together.
# Put system unit dependencies together.
SYSDEPS=$(SYSINCDEPS) $(SYSCPUDEPS)
@ -115,165 +81,157 @@ SYSDEPS=$(SYSINCDEPS) $(SYSCPUDEPS)
# Loaders
#
prt0$(OEXT) : $(CPU_TARGET)/prt0.as
$(AS) -o $(UNITTARGETDIRPREFIX)prt0$(OEXT) $(CPU_TARGET)/prt0.as
wprt0$(OEXT) : wprt0.as
gprt0$(OEXT) : gprt0.as
wdllprt0$(OEXT) : wdllprt0.as
wcygprt0$(OEXT) : wcygprt0.as
#
# $(SYSTEMUNIT) Units ($(SYSTEMUNIT), Objpas, Strings)
# System Units (System, Objpas, Strings)
#
$(SYSTEMUNIT)$(PPUEXT) : $(SYSTEMUNIT).pp $(SYSDEPS)
$(COMPILER) -Us -Sg $(SYSTEMUNIT).pp
system$(PPUEXT) : system.pp $(SYSDEPS)
$(COMPILER) -Us -Sg system.pp -Fi../win
objpas$(PPUEXT): $(OBJPASDIR)/objpas.pp $(INC)/except.inc $(SYSTEMUNIT)$(PPUEXT)
objpas$(PPUEXT): $(OBJPASDIR)/objpas.pp $(INC)/except.inc system$(PPUEXT)
$(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/objpas.pp
dateutils$(PPUEXT): $(OBJPASDIR)/dateutils.pp $(SYSTEMUNIT)$(PPUEXT)
$(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/dateutils.pp
strings$(PPUEXT) : $(INC)/strings.pp $(INC)/stringsi.inc\
$(PROCINC)/strings.inc $(PROCINC)/stringss.inc\
$(SYSTEMUNIT)$(PPUEXT)
system$(PPUEXT)
#
# $(SYSTEMUNIT) Dependent Units
# System Dependent Units
#
#unix$(PPUEXT) : unix.pp strings$(PPUEXT) baseunix$(PPUEXT) $(INC)/textrec.inc $(INC)/filerec.inc \
# unxconst.inc $(UNIXINC)/timezone.inc $(SYSTEMUNIT)$(PPUEXT) \
# unxfunc.inc
windows$(PPUEXT) : windows.pp $(WINDOWS_SOURCE_FILES) system$(PPUEXT)
$(COMPILER) -I$(WININC) windows.pp
unixtype$(PPUEXT) : $(UNIXINC)/unixtype.pp ptypes.inc $(UNIXINC)/ctypes.inc $(SYSTEMUNIT)$(PPUEXT)
messages$(PPUEXT): $(WINDIR)/messages.pp $(WININC)/messages.inc system$(PPUEXT)
$(COMPILER) -I$(WININC) $(WINDIR)/messages.pp
baseunix$(PPUEXT) : errno.inc ptypes.inc $(UNIXINC)/ctypes.inc \
$(UNIXINC)/bunxh.inc \
bunxsysc.inc $(CPU_TARGET)/syscallh.inc $(CPU_TARGET)/sysnr.inc \
ostypes.inc osmacro.inc $(UNIXINC)/gensigset.inc \
$(UNIXINC)/genfuncs.inc $(SYSTEMUNIT)$(PPUEXT)
opengl32$(PPUEXT) : opengl32.pp windows$(PPUEXT) system$(PPUEXT)
ports$(PPUEXT) : ports.pp unix$(PPUEXT) objpas$(PPUEXT)
winsock$(PPUEXT) : $(WINDIR)/winsock.pp windows$(PPUEXT) system$(PPUEXT)
$(COMPILER) $(WINDIR)/winsock.pp
#dl$(PPUEXT) : $(UNIXINC)/dl.pp $(SYSTEMUNIT)$(PPUEXT)
winsock2$(PPUEXT) : $(WINDIR)/winsock2.pp windows$(PPUEXT) system$(PPUEXT)
#dynlibs$(PPUEXT) : $(INC)/dynlibs.pp $(UNIXINC)/dynlibs.inc dl$(PPUEXT) objpas$(PPUEXT)
sockets$(PPUEXT) : $(WINDIR)/sockets.pp windows$(PPUEXT) winsock$(PPUEXT) winsock2$(PPUEXT) system$(PPUEXT) \
$(INC)/sockets.inc $(INC)/socketsh.inc
initc$(PPUEXT) : initc.pp system$(PPUEXT)
dynlibs$(PPUEXT) : $(INC)/dynlibs.pp windows$(PPUEXT)
$(COMPILER) -I$(WINDIR) $(INC)/dynlibs.pp
#
# TP7 Compatible RTL Units
#
dos$(PPUEXT) : dos.pp $(INC)/filerec.inc $(INC)/textrec.inc strings$(PPUEXT) \
unix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
dos$(PPUEXT) : $(WINDIR)/dos.pp $(INC)/filerec.inc $(INC)/textrec.inc strings$(PPUEXT) system$(PPUEXT)
$(COMPILER) $(WINDIR)/dos.pp
#crt$(PPUEXT) : crt.pp $(INC)/textrec.inc unix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
crt$(PPUEXT) : $(WINDIR)/crt.pp $(INC)/textrec.inc system$(PPUEXT) objpas$(PPUEXT) dos$(PPUEXT) windows$(PPUEXT)
objects$(PPUEXT) : $(INC)/objects.pp $(SYSTEMUNIT)$(PPUEXT)
objects$(PPUEXT) : $(INC)/objects.pp system$(PPUEXT)
#printer$(PPUEXT) : printer.pp $(INC)/textrec.inc unix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
#
# Graph
#
#include $(GRAPHDIR)/makefile.inc
#GRAPHINCDEPS=$(addprefix $(GRAPHDIR)/,$(GRAPHINCNAMES))
#graph$(PPUEXT) : graph.pp unix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) \
# $(GRAPHINCDEPS) $(UNIXINC)/graph16.inc
# $(COMPILER) -I$(GRAPHDIR) $(UNIXINC)/graph.pp
#ggigraph$(PPUEXT) : $(UNIXINC)/ggigraph.pp unix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) \
# $(GRAPHINCDEPS)
# $(COMPILER) -I$(GRAPHDIR) $(UNIXINC)/ggigraph.pp
printer$(PPUEXT) : $(WINDIR)/printer.pp system$(PPUEXT)
$(COMPILER) $(WINDIR)/printer.pp
#
# Delphi Compatible Units
#
sysutils$(PPUEXT) : $(UNIXINC)/sysutils.pp $(wildcard $(OBJPASDIR)/sysutils/*.inc) \
objpas$(PPUEXT) unix$(PPUEXT) errors$(PPUEXT) sysconst$(PPUEXT)
$(COMPILER) -Fi$(OBJPASDIR)/sysutils $(UNIXINC)/sysutils.pp
sysutils$(PPUEXT) : $(WINDIR)/sysutils.pp $(wildcard $(OBJPASDIR)/sysutils/*.inc) \
objpas$(PPUEXT) dos$(PPUEXT) windows$(PPUEXT) sysconst$(PPUEXT)
$(COMPILER) -Fi$(OBJPASDIR)/sysutils $(WINDIR)/sysutils.pp
classes$(PPUEXT) : $(UNIXINC)/classes.pp $(wildcard $(OBJPASDIR)/classes/*.inc) \
sysutils$(PPUEXT) typinfo$(PPUEXT) rtlconsts$(PPUEXT)
$(COMPILER) -Fi$(OBJPASDIR)/classes $(UNIXINC)/classes.pp
classes$(PPUEXT) : classes.pp $(wildcard $(OBJPASDIR)/classes/*.inc) \
sysutils$(PPUEXT) typinfo$(PPUEXT) rtlconsts$(PPUEXT) sysconst$(PPUEXT)
$(COMPILER) -Fi../win -Fi$(OBJPASDIR)/classes classes.pp
typinfo$(PPUEXT): $(OBJPASDIR)/typinfo.pp objpas$(PPUEXT) sysutils$(PPUEXT) rtlconsts$(PPUEXT)
winsysut$(PPUEXT) : winsysut.pp sysutils$(PPUEXT)
$(COMPILER) winsysut.pp
typinfo$(PPUEXT): $(OBJPASDIR)/typinfo.pp objpas$(PPUEXT)
$(COMPILER) -Sg $(OBJPASDIR)/typinfo.pp
math$(PPUEXT): $(OBJPASDIR)/math.pp objpas$(PPUEXT) sysutils$(PPUEXT)
$(COMPILER) $(OBJPASDIR)/math.pp
gettext$(PPUEXT): $(OBJPASDIR)/gettext.pp objpas$(PPUEXT) sysutils$(PPUEXT)
$(COMPILER) $(OBJPASDIR)/gettext.pp
varutils$(PPUEXT) : $(OBJPASDIR)/cvarutil.inc $(OBJPASDIR)/varutils.inc \
$(OBJPASDIR)/varutilh.inc $(WINDIR)/varutils.pp sysutils$(PPUEXT)
$(COMPILER) -Fi$(OBJPASDIR) $(WINDIR)/varutils.pp
#varutils$(PPUEXT) : $(OBJPASDIR)/cvarutil.inc $(OBJPASDIR)/varutils.inc \
# $(OBJPASDIR)/varutilh.inc varutils.pp sysutils$(PPUEXT)
# $(COMPILER) -I$(OBJPASDIR) $(UNIXINC)/varutils.pp
variants$(PPUEXT) : $(INC)/variants.pp varutils$(PPUEXT) sysutils$(PPUEXT) sysconst$(PPUEXT) typinfo$(PPUEXT) rtlconsts$(PPUEXT)
$(COMPILER) -Fi$(INC) $(INC)/variants.pp
#variants$(PPUEXT) : $(INC)/variants.pp sysutils$(PPUEXT) sysconst$(PPUEXT) varutils$(PPUEXT) typinfo$(PPUEXT) rtlconsts$(PPUEXT)
# $(COMPILER) -Fi$(INC) $(INC)/variants.pp
types$(PPUEXT) : $(OBJPASDIR)/types.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
types$(PPUEXT) : $(OBJPASDIR)/types.pp objpas$(PPUEXT) system$(PPUEXT)
$(COMPILER) $(OBJPASDIR)/types.pp
sysconst$(PPUEXT) : $(OBJPASDIR)/sysconst.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
$(COMPILER) $(OBJPASDIR)/sysconst.pp
rtlconsts$(PPUEXT) : $(OBJPASDIR)/rtlconsts.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
rtlconsts$(PPUEXT) : objpas$(PPUEXT) $(OBJPASDIR)/rtlconsts.pp
$(COMPILER) $(OBJPASDIR)/rtlconsts.pp
strutils$(PPUEXT) : $(OBJPASDIR)/strutils.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) \
sysutils$(PPUEXT)
$(COMPILER) $(OBJPASDIR)/strutils.pp
sysconst$(PPUEXT) : $(OBJPASDIR)/sysconst.pp objpas$(PPUEXT) system$(PPUEXT)
$(COMPILER) $(OBJPASDIR)/sysconst.pp
dateutils$(PPUEXT) : $(OBJPASDIR)/dateutils.pp
$(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/dateutils.pp
convutils$(PPUEXT) : $(OBJPASDIR)/convutils.pp
$(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/convutils.pp
strutils$(PPUEXT) : $(OBJPASDIR)/strutils.pp
$(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/strutils.pp
#
# Mac Pascal Model
#
#macpas$(PPUEXT) : $(INC)/macpas.pp $(SYSTEMUNIT)$(PPUEXT)
# $(COMPILER) $(INC)/macpas.pp $(REDIR)
macpas$(PPUEXT) : $(INC)/macpas.pp system$(PPUEXT)
$(COMPILER) $(INC)/macpas.pp $(REDIR)
#
# Other $(SYSTEMUNIT)-independent RTL Units
# Other system-independent RTL Units
#
cpu$(PPUEXT) : $(PROCINC)/cpu.pp $(SYSTEMUNIT)$(PPUEXT)
cpu$(PPUEXT) : $(PROCINC)/cpu.pp system$(PPUEXT)
#mmx$(PPUEXT) : $(PROCINC)/mmx.pp cpu$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
mmx$(PPUEXT) : $(PROCINC)/mmx.pp cpu$(PPUEXT) system$(PPUEXT)
getopts$(PPUEXT) : $(INC)/getopts.pp $(SYSTEMUNIT)$(PPUEXT)
getopts$(PPUEXT) : $(INC)/getopts.pp system$(PPUEXT)
heaptrc$(PPUEXT) : $(INC)/heaptrc.pp $(SYSTEMUNIT)$(PPUEXT)
heaptrc$(PPUEXT) : $(INC)/heaptrc.pp system$(PPUEXT)
$(COMPILER) -Sg $(INC)/heaptrc.pp
lineinfo$(PPUEXT) : $(INC)/lineinfo.pp $(SYSTEMUNIT)$(PPUEXT)
lineinfo$(PPUEXT) : $(INC)/lineinfo.pp system$(PPUEXT)
charset$(PPUEXT) : $(INC)/charset.pp $(SYSTEMUNIT)$(PPUEXT)
charset$(PPUEXT) : $(INC)/charset.pp system$(PPUEXT)
#ucomplex$(PPUEXT) : $(INC)/ucomplex.pp math$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
cmem$(PPUEXT) : $(INC)/cmem.pp system$(PPUEXT)
ucomplex$(PPUEXT) : $(INC)/ucomplex.pp math$(PPUEXT) system$(PPUEXT)
fpmkunit$(PPUEXT) : $(COMMON)/fpmkunit.pp classes$(PPUEXT)
#
# Other $(SYSTEMUNIT)-dependent RTL Units
# Other system-dependent RTL Units
#
#sockets$(PPUEXT) : sockets.pp $(INC)/textrec.inc $(INC)/filerec.inc \
# unixsock.inc unix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
callspec$(PPUEXT) : $(INC)/callspec.pp system$(PPUEXT)
errors$(PPUEXT) : errors.pp strings$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
ctypes$(PPUEXT) : $(INC)/ctypes.pp system$(PPUEXT)
#ipc$(PPUEXT) : ipc.pp unix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
variants$(PPUEXT) : $(INC)/variants.pp varutils$(PPUEXT) typinfo$(PPUEXT)
#terminfo$(PPUEXT) : terminfo.pp unix$(PPUEXT)
winevent$(PPUEXT) : $(WINDIR)/winevent.pp windows$(PPUEXT)
callspec$(PPUEXT) : $(INC)/callspec.pp $(SYSTEMUNIT)$(PPUEXT)
video$(PPUEXT) : $(WINDIR)/video.pp windows$(PPUEXT) dos$(PPUEXT)
cmem$(PPUEXT) : $(INC)/cmem.pp $(SYSTEMUNIT)$(PPUEXT)
cthreads$(PPUEXT) : $(UNIXINC)/cthreads.pp $(SYSTEMUNIT)$(PPUEXT)
#cwstring$(PPUEXT) : $(UNIXINC)/cwstring.pp $(SYSTEMUNIT)$(PPUEXT) sysutils$(PPUEXT) baseunix$(PPUEXT) unix$(PPUEXT) unixtype$(PPUEXT) ctypes$(PPUEXT)
#gpm$(PPUEXT): gpm.pp unix$(PPUEXT) baseunix$(PPUEXT) sockets$(PPUEXT)
ctypes$(PPUEXT) : $(INC)/ctypes.pp $(SYSTEMUNIT)$(PPUEXT)
mouse$(PPUEXT) : $(WINDIR)/mouse.pp windows$(PPUEXT) dos$(PPUEXT) winevent$(PPUEXT)
keyboard$(PPUEXT) : $(WINDIR)/keyboard.pp windows$(PPUEXT) dos$(PPUEXT) winevent$(PPUEXT)

45
rtl/gba/classes.pp Normal file
View File

@ -0,0 +1,45 @@
{
This file is part of the Free Component Library (FCL)
Copyright (c) 1999-2002 by the Free Pascal development team
Classes unit for Gameboy Advance
Copyright (c) 2006 by Francesco Lombardi
See the file COPYING.FPC, included in this distribution,
for details about the copyright.
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.
**********************************************************************}
{$mode objfpc}
unit Classes;
interface
uses
sysutils,
rtlconsts,
types,
typinfo;
{$i classesh.inc}
implementation
{ OS - independent class implementations are in /inc directory. }
{$i classes.inc}
initialization
CommonInit;
finalization
CommonCleanup;
end.

242
rtl/gba/dos.pp Normal file
View File

@ -0,0 +1,242 @@
{
This file is part of the Free Pascal run time library.
Copyright (c) 2004 by Karoly Balogh for Genesi S.a.r.l.
Heavily based on the Commodore Amiga/m68k RTL by Nils Sjoholm and
Carl Eric Codere
MorphOS port was done on a free Pegasos II/G4 machine
provided by Genesi S.a.r.l. <www.genesi.lu>
This unit is based on the MorphOS one and is adapted for Gameboy Advance
simply by stripping out all stuff inside funcs and procs.
Copyright (c) 2006 by Francesco Lombardi
See the file COPYING.FPC, included in this distribution,
for details about the copyright.
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.
**********************************************************************}
unit Dos;
interface
type
SearchRec = Packed Record
AnchorPtr : Pointer; { Pointer to the Anchorpath structure }
Fill: Array[1..15] of Byte; {future use}
{End of replacement for fill}
Attr : BYTE; {attribute of found file}
Time : LongInt; {last modify date of found file}
Size : LongInt; {file size of found file}
Name : String[255]; {name of found file}
End;
{$I dosh.inc}
implementation
{$I dos.inc}
{******************************************************************************
--- Internal routines ---
******************************************************************************}
function dosLock(const name: String; accessmode: Longint) : LongInt;
begin
end;
function IsLeapYear(Source : Word) : Boolean;
begin
end;
function dosSetProtection(const name: string; mask:longint): Boolean;
begin
end;
function dosSetFileDate(name: string): Boolean;
begin
end;
{******************************************************************************
--- Info / Date / Time ---
******************************************************************************}
function DosVersion: Word;
begin
end;
procedure NewList ();
begin
end;
function CreateExtIO (size: Longint): integer;
begin
end;
procedure DeleteExtIO ();
begin
end;
function Createport(name : PChar; pri : longint): integer;
begin
end;
procedure DeletePort ();
begin
end;
function Create_Timer(theUnit : longint) : integer;
begin
end;
Procedure Delete_Timer();
begin
end;
function set_new_time(secs, micro : longint): longint;
begin
end;
function get_sys_time(): longint;
begin
end;
procedure GetDate(Var Year, Month, MDay, WDay: Word);
begin
end;
procedure SetDate(Year, Month, Day: Word);
begin
end;
procedure GetTime(Var Hour, Minute, Second, Sec100: Word);
begin
end;
Procedure SetTime(Hour, Minute, Second, Sec100: Word);
begin
end;
{******************************************************************************
--- Exec ---
******************************************************************************}
procedure Exec(const Path: PathStr; const ComLine: ComStr);
begin
end;
{******************************************************************************
--- Disk ---
******************************************************************************}
Function DiskFree(Drive: Byte): int64;
Begin
end;
Function DiskSize(Drive: Byte): int64;
Begin
end;
procedure FindFirst(const Path: PathStr; Attr: Word; Var f: SearchRec);
begin
end;
procedure FindNext(Var f: SearchRec);
begin
end;
procedure FindClose(Var f: SearchRec);
begin
end;
{******************************************************************************
--- File ---
******************************************************************************}
function FSearch(path: PathStr; dirlist: String) : PathStr;
begin
end;
Procedure getftime (var f; var time : longint);
begin
end;
Procedure setftime(var f; time : longint);
Begin
End;
procedure getfattr(var f; var attr : word);
begin
End;
procedure setfattr(var f; attr : word);
begin
end;
{******************************************************************************
--- Environment ---
******************************************************************************}
function getpathstring: string;
begin
end;
function EnvCount: Longint;
begin
end;
function EnvStr(Index: LongInt): String;
begin
end;
function GetEnv(envvar : String): String;
begin
end;
procedure AddDevice(str : String);
begin
end;
function MakeDeviceName(str : pchar): string;
begin
end;
function IsInDeviceList(str : string): boolean;
begin
end;
procedure ReadInDevices;
begin
end;
begin
// DosError:=0;
// numberofdevices := 0;
// StrOfPaths := '';
// ReadInDevices;
end.

179
rtl/gba/gbabios.inc Normal file
View File

@ -0,0 +1,179 @@
{
This file is part of the Free Component Library (FCL)
Copyright (c) 1999-2002 by the Free Pascal development team
BIOS functions unit for Gameboy Advance
Copyright (c) 2006 by Francesco Lombardi
See the file COPYING.FPC, included in this distribution,
for details about the copyright.
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.
*****************************************************************************}
{*****************************************************************************
GBA Bios Functions
*****************************************************************************}
(*
GBA Bios Functions
------------------
Following infos come from GBATEK, Gameboy Advance Technical Info, that you can
find here: http://nocash.emubase.de/gbatek.htm
GBA Bios includes some useful optimized functions which can be accessed by
SWI. Parameters can be passed to function by r0,r1,r2 and r3 registers; results
are stored in r0,r1 and r3. Unused 'out registers' generally return garbage;
other registers are unchanged.
In ARM mode SWI register are called by:
SWI n * 0x010000
In THUMB mode:
SWI n
SWI Hex Function
--- --- --------
0 00h SoftReset
1 01h RegisterRamReset
2 02h Halt
3 03h Stop
4 04h IntrWait
5 05h VBlankIntrWait
6 06h Div
7 07h DivArm
8 08h Sqrt
9 09h ArcTan
10 0Ah ArcTan2
11 0Bh CpuSet
12 0Ch CpuFastSet
13 0Dh -Undoc- ("GetBiosChecksum")
14 0Eh BgAffineSet
15 0Fh ObjAffineSet
16 10h BitUnPack
17 11h LZ77UnCompWram
18 12h LZ77UnCompVram
19 13h HuffUnComp
20 14h RLUnCompWram
21 15h RLUnCompVram
22 16h Diff8bitUnFilterWram
23 17h Diff8bitUnFilterVram
24 18h Diff16bitUnFilter
25 19h SoundBias
26 1Ah SoundDriverInit
27 1Bh SoundDriverMode
28 1Ch SoundDriverMain
29 1Dh SoundDriverVSync
30 1Eh SoundChannelClear
31 1Fh MidiKey2Freq
32-36 20h-24h -Undoc- (Sound Related ???)
37 25h MultiBoot
38 26h -Undoc- ("HardReset")
39 27h -Undoc- ("CustomHalt")
40 28h SoundDriverVSyncOff
41 29h SoundDriverVSyncOn
42 2Ah -Undoc- ("GetJumpList" for Sound ???)
43-255 2Bh-FFh -Not used-
Values passed to SWI aren't range-checked, so calling 43-255 will lock-up GBA.
*)
(*
Following defines are intended for future use, when fpc hopefully will handle
both arm and thumb code. I have provided ARM and THUMB funcs, that can be
activated by defines:
{$define __THUMB__}
{$define __ARM__}
At this time I'll force ARM definition in "system.pp"
*)
(* Generic system call !!Does Not Work!!
{$ifdef __THUMB__}
procedure SystemCall(Number: integer); assembler; inline;
asm
SWI r0
end;
{$else}
procedure SystemCall(n: integer); assembler; inline;
asm
MOV R0, R0, LSL #0x10
SWI R0
end;
{$endif}
*)
{$ifdef __THUMB__}
(*=========================
SWI6 Div
Signed Division, r0/r1.
r0 signed 32bit Number
r1 signed 32bit Denom
Return:
r0 Number DIV Denom
=========================*)
function fpc_div_longint(n,z: longint):longint; [public, alias: 'FPC_DIV_LONGINT']; compilerproc; assembler; inline;
asm
swi 6
end;
(*=====================*)
(*=========================
SWI6 DivMod
Signed Division, r0/r1.
r0 signed 32bit Number
r1 signed 32bit Denom
Return:
r1 Number MOD Denom
=========================*)
function fpc_mod_longint(n,z: longint):longint; [public, alias: 'FPC_MOD_LONGINT']; compilerproc; assembler; inline;
asm
swi 6
mov r0, r1
end;
(*=========================*)
{$endif}
{$ifdef __ARM__}
(*=========================
SWI7 DivArm
Signed Division, r1/r0.
r1 signed 32bit Number
r0 signed 32bit Denom
Return:
r0 Number DIV Denom
=========================*)
function fpc_div_longint(n,z: longint):longint; [public, alias: 'FPC_DIV_LONGINT']; compilerproc; assembler; inline;
asm
swi #0x070000
end;
(*=========================*)
(*=========================
SWI7 DivModArm
Signed Division, r1/r0.
r1 signed 32bit Number
r0 signed 32bit Denom
Return:
r1 Number MOD Denom
=========================*)
function fpc_mod_longint(n,z: longint):longint; [public, alias: 'FPC_MOD_LONGINT']; compilerproc; assembler; inline;
asm
swi #0x070000
mov r0, r1
end;
(*=========================*)
{$endif}

22
rtl/gba/gbabiosh.inc Normal file
View File

@ -0,0 +1,22 @@
{
This file is part of the Free Component Library (FCL)
Copyright (c) 1999-2002 by the Free Pascal development team
BIOS functions unit for Gameboy Advance
Copyright (c) 2006 by Francesco Lombardi
See the file COPYING.FPC, included in this distribution,
for details about the copyright.
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.
*****************************************************************************}
{*****************************************************************************
GBA Bios Functions
*****************************************************************************}
{ FPC funcs replaced by GBA BIOS ones }
{$DEFINE FPC_SYSTEM_HAS_MOD_LONGINT}
{$DEFINE FPC_SYSTEM_HAS_DIV_LONGINT}

271
rtl/gba/lnkscript Normal file
View File

@ -0,0 +1,271 @@
/* (c) 2006 by devkitPro (http://www.devkitpro.org) */
OUTPUT_FORMAT("elf32-littlearm", "elf32-bigarm", "elf32-littlearm")
OUTPUT_ARCH(arm)
ENTRY(_start)
MEMORY {
rom : ORIGIN = 0x08000000, LENGTH = 32M
iwram : ORIGIN = 0x03000000, LENGTH = 32K
ewram : ORIGIN = 0x02000000, LENGTH = 256K
}
__text_start = 0x8000000;
__eheap_end = 0x2040000;
__iwram_start = 0x3000000;
__iwram_end = 0x3008000;
__sp_irq = __iwram_end - 0x100;
__sp_usr = __sp_irq - 0x100;
SECTIONS
{
. = __text_start;
.init :
{
KEEP (*(.init))
. = ALIGN(4);
} >rom =0xff
.plt :
{
*(.plt)
. = ALIGN(4); /* REQUIRED. LD is flaky without it. */
} >rom
.text : /* ALIGN (4): */
{
*(EXCLUDE_FILE (*.iwram*) .text)
*(.text.*)
*(.stub)
/* .gnu.warning sections are handled specially by elf32.em. */
*(.gnu.warning)
*(.gnu.linkonce.t*)
*(.glue_7)
*(.glue_7t)
. = ALIGN(4); /* REQUIRED. LD is flaky without it. */
} >rom = 0xff
__text_end = .;
.fini :
{
KEEP (*(.fini))
. = ALIGN(4); /* REQUIRED. LD is flaky without it. */
} >rom =0
.rodata :
{
*(.rodata)
*all.rodata*(*)
*(.roda)
*(.rodata.*)
*(.gnu.linkonce.r*)
SORT(CONSTRUCTORS)
. = ALIGN(4); /* REQUIRED. LD is flaky without it. */
} >rom = 0xff
.ctors :
{
/* gcc uses crtbegin.o to find the start of the constructors, so
we make sure it is first. Because this is a wildcard, it
doesn't matter if the user does not actually link against
crtbegin.o; the linker won't look for a file to match a
wildcard. The wildcard also means that it doesn't matter which
directory crtbegin.o is in. */
KEEP (*crtbegin.o(.ctors))
KEEP (*(EXCLUDE_FILE (*crtend.o) .ctors))
KEEP (*(SORT(.ctors.*)))
KEEP (*(.ctors))
. = ALIGN(4); /* REQUIRED. LD is flaky without it. */
} >rom = 0
.dtors :
{
KEEP (*crtbegin.o(.dtors))
KEEP (*(EXCLUDE_FILE (*crtend.o) .dtors))
KEEP (*(SORT(.dtors.*)))
KEEP (*(.dtors))
. = ALIGN(4); /* REQUIRED. LD is flaky without it. */
} >rom = 0
.jcr : { KEEP (*(.jcr)) } >rom
.eh_frame :
{
KEEP (*(.eh_frame))
. = ALIGN(4); /* REQUIRED. LD is flaky without it. */
} >rom = 0
.gcc_except_table :
{
*(.gcc_except_table)
. = ALIGN(4); /* REQUIRED. LD is flaky without it. */
} >rom = 0
__iwram_lma = .;
.iwram __iwram_start : AT (__iwram_lma)
{
__iwram_start = ABSOLUTE(.) ;
*(.iwram)
*iwram.*(.text)
. = ALIGN(4); /* REQUIRED. LD is flaky without it. */
} >iwram = 0xff
__iwram_end = . ;
.bss ALIGN(4) :
{
__bss_start = ABSOLUTE(.);
__bss_start__ = ABSOLUTE(.);
*(.dynbss)
*(.gnu.linkonce.b*)
*(.bss*)
*(COMMON)
. = ALIGN(4); /* REQUIRED. LD is flaky without it. */
} >iwram
__bss_end = . ;
__bss_end__ = . ;
__iwram_overlay_lma = __iwram_lma + SIZEOF(.iwram);
__iwram_overlay_start = . ;
OVERLAY ALIGN(4) : NOCROSSREFS AT (__iwram_overlay_lma)
{
.iwram0 { *(.iwram0) . = ALIGN(4);}
.iwram1 { *(.iwram1) . = ALIGN(4);}
.iwram2 { *(.iwram2) . = ALIGN(4);}
.iwram3 { *(.iwram3) . = ALIGN(4);}
.iwram4 { *(.iwram4) . = ALIGN(4);}
.iwram5 { *(.iwram5) . = ALIGN(4);}
.iwram6 { *(.iwram6) . = ALIGN(4);}
.iwram7 { *(.iwram7) . = ALIGN(4);}
.iwram8 { *(.iwram8) . = ALIGN(4);}
.iwram9 { *(.iwram9) . = ALIGN(4);}
}>iwram = 0xff
__ewram_lma = LOADADDR(.iwram0) + SIZEOF(.iwram0)+SIZEOF(.iwram1)+SIZEOF(.iwram2)+SIZEOF(.iwram3)+SIZEOF(.iwram4)+SIZEOF(.iwram5)+SIZEOF(.iwram6)+SIZEOF(.iwram7)+SIZEOF(.iwram8)+SIZEOF(.iwram9);
__iwram_overlay_end = . ;
__iheap_start = . ;
__ewram_start = 0x2000000;
.ewram __ewram_start : AT (__ewram_lma)
{
*(.ewram)
. = ALIGN(4); /* REQUIRED. LD is flaky without it. */
}>ewram = 0xff
__data_lma = __ewram_lma + SIZEOF(.ewram) ;
.data ALIGN(4) : AT (__data_lma)
{
__data_start = ABSOLUTE(.);
*(.data)
*(.data.*)
*(.gnu.linkonce.d*)
CONSTRUCTORS
. = ALIGN(4);
} >ewram = 0xff
__data_end = .;
__ewram_overlay_lma = __data_lma + SIZEOF(.data);
.sbss ALIGN(4):
{
__sbss_start = ABSOLUTE(.);
*(.sbss)
. = ALIGN(4);
} >ewram
__sbss_end = .;
__ewram_end = . ;
__ewram_overlay_start = . ;
OVERLAY ALIGN(4): NOCROSSREFS AT (__ewram_overlay_lma)
{
.ewram0 { *(.ewram0) . = ALIGN(4);}
.ewram1 { *(.ewram1) . = ALIGN(4);}
.ewram2 { *(.ewram2) . = ALIGN(4);}
.ewram3 { *(.ewram3) . = ALIGN(4);}
.ewram4 { *(.ewram4) . = ALIGN(4);}
.ewram5 { *(.ewram5) . = ALIGN(4);}
.ewram6 { *(.ewram6) . = ALIGN(4);}
.ewram7 { *(.ewram7) . = ALIGN(4);}
.ewram8 { *(.ewram8) . = ALIGN(4);}
.ewram9 { *(.ewram9) . = ALIGN(4);}
}>ewram = 0xff
__pad_lma = LOADADDR(.ewram0) + SIZEOF(.ewram0)+SIZEOF(.ewram1)+SIZEOF(.ewram2)+SIZEOF(.ewram3)+SIZEOF(.ewram4)+SIZEOF(.ewram5)+SIZEOF(.ewram6)+SIZEOF(.ewram7)+SIZEOF(.ewram8)+SIZEOF(.ewram9);
/* EZF Advance strips trailing 0xff bytes, add a pad section so nothing important is removed */
.pad ALIGN(4) : AT (__pad_lma)
{
LONG(0x52416b64)
LONG(0x4d)
. = ALIGN(4); /* REQUIRED. LD is flaky without it. */
} = 0xff
__ewram_overlay_end = . ;
__eheap_start = . ;
_end = .;
__end__ = _end ; /* v1.3 */
PROVIDE (end = _end); /* v1.3 */
/* Stabs debugging sections. */
.stab 0 : { *(.stab) }
.stabstr 0 : { *(.stabstr) }
.stab.excl 0 : { *(.stab.excl) }
.stab.exclstr 0 : { *(.stab.exclstr) }
.stab.index 0 : { *(.stab.index) }
.stab.indexstr 0 : { *(.stab.indexstr) }
.comment 0 : { *(.comment) }
/* DWARF debug sections.
Symbols in the DWARF debugging sections are relative to the beginning
of the section so we begin them at 0. */
/* DWARF 1 */
.debug 0 : { *(.debug) }
.line 0 : { *(.line) }
/* GNU DWARF 1 extensions */
.debug_srcinfo 0 : { *(.debug_srcinfo) }
.debug_sfnames 0 : { *(.debug_sfnames) }
/* DWARF 1.1 and DWARF 2 */
.debug_aranges 0 : { *(.debug_aranges) }
.debug_pubnames 0 : { *(.debug_pubnames) }
/* DWARF 2 */
.debug_info 0 : { *(.debug_info) }
.debug_abbrev 0 : { *(.debug_abbrev) }
.debug_line 0 : { *(.debug_line) }
.debug_frame 0 : { *(.debug_frame) }
.debug_str 0 : { *(.debug_str) }
.debug_loc 0 : { *(.debug_loc) }
.debug_macinfo 0 : { *(.debug_macinfo) }
/* SGI/MIPS DWARF 2 extensions */
.debug_weaknames 0 : { *(.debug_weaknames) }
.debug_funcnames 0 : { *(.debug_funcnames) }
.debug_typenames 0 : { *(.debug_typenames) }
.debug_varnames 0 : { *(.debug_varnames) }
.stack 0x80000 : { _stack = .; *(.stack) }
/* These must appear regardless of . */
}

267
rtl/gba/prt0.s Normal file
View File

@ -0,0 +1,267 @@
@ (c) 2006 by devkitPro (http://www.devkitpro.org)
.section ".init"
.global _start
.align
.arm
@---------------------------------------------------------------------------------
_start:
@---------------------------------------------------------------------------------
b rom_header_end
.fill 156,1,0 @ Nintendo Logo Character Data (8000004h)
.fill 16,1,0 @ Game Title
.byte 0x30,0x31 @ Maker Code (80000B0h)
.byte 0x96 @ Fixed Value (80000B2h)
.byte 0x00 @ Main Unit Code (80000B3h)
.byte 0x00 @ Device Type (80000B4h)
.fill 7,1,0 @ unused
.byte 0x00 @ Software Version No (80000BCh)
.byte 0xf0 @ Complement Check (80000BDh)
.byte 0x00,0x00 @ Checksum (80000BEh)
@---------------------------------------------------------------------------------
rom_header_end:
@---------------------------------------------------------------------------------
b start_vector @ This branch must be here for proper
@ positioning of the following header.
.GLOBAL __boot_method, __slave_number
@---------------------------------------------------------------------------------
__boot_method:
@---------------------------------------------------------------------------------
.byte 0 @ boot method (0=ROM boot, 3=Multiplay boot)
@---------------------------------------------------------------------------------
__slave_number:
@---------------------------------------------------------------------------------
.byte 0 @ slave # (1=slave#1, 2=slave#2, 3=slave#3)
.byte 0 @ reserved
.byte 0 @ reserved
.word 0 @ reserved
.word 0 @ reserved
.word 0 @ reserved
.word 0 @ reserved
.word 0 @ reserved
.word 0 @ reserved
.global start_vector
.align
@---------------------------------------------------------------------------------
start_vector:
@---------------------------------------------------------------------------------
mov r0, #0x4000000 @ REG_BASE
str r0, [r0, #0x208]
mov r0, #0x12 @ Switch to IRQ Mode
msr cpsr, r0
ldr sp, =__sp_irq @ Set IRQ stack
mov r0, #0x1f @ Switch to System Mode
msr cpsr, r0
ldr sp, =__sp_usr @ Set user stack
@---------------------------------------------------------------------------------
@ Enter Thumb mode
@---------------------------------------------------------------------------------
add r0, pc, #1
bx r0
.thumb
ldr r0, =__text_start
lsl r0, #5 @ Was code compiled at 0x08000000 or higher?
bcs DoEWRAMClear @ yes, you can not run it in external WRAM
mov r0, pc
lsl r0, #5 @ Are we running from ROM (0x8000000 or higher) ?
bcc SkipEWRAMClear @ No, so no need to do a copy.
@---------------------------------------------------------------------------------
@ We were started in ROM, silly emulators. :P
@ So we need to copy to ExWRAM.
@---------------------------------------------------------------------------------
mov r2, #2
lsl r2, r2, #24 @ r2= 0x02000000
ldr r3, =__end__ @ last ewram address
sub r3, r2 @ r3= actual binary size
mov r6, r2 @ r6= 0x02000000
lsl r1, r2, #2 @ r1= 0x08000000
bl CopyMem
bx r6 @ Jump to the code to execute
@---------------------------------------------------------------------------------
DoEWRAMClear: @ Clear External WRAM to 0x00
@---------------------------------------------------------------------------------
mov r1, #0x40
lsl r1, #12 @ r1 = 0x40000
lsl r0, r1, #7 @ r0 = 0x2000000
bl ClearMem
@---------------------------------------------------------------------------------
SkipEWRAMClear: @ Clear Internal WRAM to 0x00
@---------------------------------------------------------------------------------
@---------------------------------------------------------------------------------
@ Clear BSS section to 0x00
@---------------------------------------------------------------------------------
ldr r0, =__bss_start
ldr r1, =__bss_end
sub r1, r0
bl ClearMem
@---------------------------------------------------------------------------------
@ Clear SBSS section to 0x00
@---------------------------------------------------------------------------------
ldr r0, =__sbss_start
ldr r1, =__sbss_end
sub r1, r0
bl ClearMem
@---------------------------------------------------------------------------------
@ Copy initialized data (data section) from LMA to VMA (ROM to RAM)
@---------------------------------------------------------------------------------
ldr r1, =__data_lma
ldr r2, =__data_start
ldr r4, =__data_end
bl CopyMemChk
@---------------------------------------------------------------------------------
@ Copy internal work ram (iwram section) from LMA to VMA (ROM to RAM)
@---------------------------------------------------------------------------------
ldr r1,= __iwram_lma
ldr r2,= __iwram_start
ldr r4,= __iwram_end
bl CopyMemChk
@---------------------------------------------------------------------------------
@ Copy internal work ram overlay 0 (iwram0 section) from LMA to VMA (ROM to RAM)
@---------------------------------------------------------------------------------
ldr r2,= __load_stop_iwram0
ldr r1,= __load_start_iwram0
sub r3, r2, r1 @ Is there any data to copy?
beq CIW0Skip @ no
ldr r2,= __iwram_overlay_start
bl CopyMem
@---------------------------------------------------------------------------------
CIW0Skip:
@---------------------------------------------------------------------------------
@---------------------------------------------------------------------------------
@ Copy external work ram (ewram section) from LMA to VMA (ROM to RAM)
@---------------------------------------------------------------------------------
ldr r1, =__ewram_lma
ldr r2, =__ewram_start
ldr r4, =__ewram_end
bl CopyMemChk
@---------------------------------------------------------------------------------
@ Copy external work ram overlay 0 (ewram0 section) from LMA to VMA (ROM to RAM)
@---------------------------------------------------------------------------------
ldr r2, =__load_stop_ewram0
ldr r1, =__load_start_ewram0
sub r3, r2, r1 @ Is there any data to copy?
beq CEW0Skip @ no
ldr r2, =__ewram_overlay_start
bl CopyMem
@---------------------------------------------------------------------------------
CEW0Skip:
@---------------------------------------------------------------------------------
@---------------------------------------------------------------------------------
@ Jump to user code
@---------------------------------------------------------------------------------
mov r0,#0 @ int argc
mov r1,#0 @ char *argv[]
ldr r3,=start_vector
mov lr,r3 @ Set start_vector as return address
ldr r3,=main
bx r3
.GLOBAL __FarFunction,__FarProcedure
.THUMB_FUNC
__FarFunction:
.THUMB_FUNC
__FarProcedure:
bx r0
nop
nop @ This nop is here to allow unmapped memory to be used as
@ as a delay of almost 1 sec with a 1 cycle resolution.
@ Read this for technical info:
@ http://www.devrs.com/gba/files/gbadevfaqs.php#RepeatUses
@---------------------------------------------------------------------------------
@ Clear memory to 0x00 if length != 0
@---------------------------------------------------------------------------------
@ r0 = Start Address
@ r1 = Length
@---------------------------------------------------------------------------------
ClearMem:
@---------------------------------------------------------------------------------
mov r2,#3 @ These commands are used in cases where
add r1,r2 @ the length is not a multiple of 4,
bic r1,r2 @ even though it should be.
beq ClearMX @ Length is zero so exit
mov r2,#0
@---------------------------------------------------------------------------------
ClrLoop:
@---------------------------------------------------------------------------------
stmia r0!, {r2}
sub r1,#4
bne ClrLoop
@---------------------------------------------------------------------------------
ClearMX:
@---------------------------------------------------------------------------------
bx lr
@---------------------------------------------------------------------------------
@ Copy memory if length != 0
@---------------------------------------------------------------------------------
@ r1 = Source Address
@ r2 = Dest Address
@ r4 = Dest Address + Length
@---------------------------------------------------------------------------------
CopyMemChk:
@---------------------------------------------------------------------------------
sub r3, r4, r2 @ Is there any data to copy?
@---------------------------------------------------------------------------------
@ Copy memory
@---------------------------------------------------------------------------------
@ r1 = Source Address
@ r2 = Dest Address
@ r3 = Length
@---------------------------------------------------------------------------------
CopyMem:
@---------------------------------------------------------------------------------
mov r0, #3 @ These commands are used in cases where
add r3, r0 @ the length is not a multiple of 4,
bic r3, r0 @ even though it should be.
beq CIDExit @ Length is zero so exit
@---------------------------------------------------------------------------------
CIDLoop:
@---------------------------------------------------------------------------------
ldmia r1!, {r0}
stmia r2!, {r0}
sub r3, #4
bne CIDLoop
@---------------------------------------------------------------------------------
CIDExit:
@---------------------------------------------------------------------------------
bx lr
.align
.pool
.end

39
rtl/gba/sysdir.inc Normal file
View File

@ -0,0 +1,39 @@
{
This file is part of the Free Pascal run time library.
Copyright (c) 2006 by Free Pascal development team
Low level directory functions
GBA does not have any drive, so no directory handling is needed.
Copyright (c) 2006 by Francesco Lombardi
See the file COPYING.FPC, included in this distribution,
for details about the copyright.
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.
**********************************************************************}
{*****************************************************************************
Directory Handling
*****************************************************************************}
procedure mkdir(const s : string);[IOCheck];
begin
end;
procedure rmdir(const s : string);[IOCheck];
begin
end;
procedure chdir(const s : string);[IOCheck];
begin
end;
procedure GetDir (DriveNr: byte; var Dir: ShortString);
begin
end;

74
rtl/gba/sysfile.inc Normal file
View File

@ -0,0 +1,74 @@
{
This file is part of the Free Pascal run time library.
Copyright (c) 2005 by Free Pascal development team
Low level file functions
GBA does not have any drive, so no file handling is needed.
Copyright (c) 2006 by Francesco Lombardi
See the file COPYING.FPC, included in this distribution,
for details about the copyright.
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.
**********************************************************************}
{****************************************************************************
Low level File Routines
All these functions can set InOutRes on errors
****************************************************************************}
{ close a file from the handle value }
procedure do_close(handle : longint);
begin
end;
procedure do_erase(p : pchar);
begin
end;
procedure do_rename(p1,p2 : pchar);
begin
end;
function do_write(h: longint; addr: pointer; len: longint) : longint;
begin
end;
function do_read(h: longint; addr: pointer; len: longint) : longint;
begin
end;
function do_filepos(handle: longint) : longint;
begin
end;
procedure do_seek(handle, pos: longint);
begin
end;
function do_seekend(handle: longint):longint;
begin
end;
function do_filesize(handle : longint) : longint;
begin
end;
{ truncate at a given position }
procedure do_truncate(handle, pos: longint);
begin
end;
procedure do_open(var f;p:pchar;flags:longint);
begin
end;
function do_isdevice(handle: longint): boolean;
begin
end;

30
rtl/gba/sysheap.inc Normal file
View File

@ -0,0 +1,30 @@
{
This file is part of the Free Pascal run time library.
Copyright (c) 2005 by Free Pascal development team
Low level memory functions
See the file COPYING.FPC, included in this distribution,
for details about the copyright.
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.
**********************************************************************}
{*****************************************************************************
OS Memory allocation / deallocation
****************************************************************************}
function SysOSAlloc(size: ptrint): pointer;
begin
end;
{ $define HAS_SYSOSFREE}
procedure SysOSFree(p: pointer; size: ptrint);
begin
end;

16
rtl/gba/sysos.inc Normal file
View File

@ -0,0 +1,16 @@
{
This file is part of the Free Pascal run time library.
Copyright (c) 2001 by Free Pascal development team
This file implements all the base types and limits required
for a minimal POSIX compliant subset required to port the compiler
to a new OS.
See the file COPYING.FPC, included in this distribution,
for details about the copyright.
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.
**********************************************************************}

29
rtl/gba/sysosh.inc Normal file
View File

@ -0,0 +1,29 @@
{
This file is part of the Free Pascal run time library.
Copyright (c) 2001 by Free Pascal development team
This file implements all the base types and limits required
for a minimal POSIX compliant subset required to port the compiler
to a new OS.
See the file COPYING.FPC, included in this distribution,
for details about the copyright.
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.
**********************************************************************}
{Platform specific information}
type
THandle = Longint;
TThreadID = THandle;
PRTLCriticalSection = ^TRTLCriticalSection;
TRTLCriticalSection = record
Locked: boolean
end;

303
rtl/gba/system.pp
View File

@ -1,10 +1,8 @@
{
$Id: system.pp,v 1.25 2005/04/24 21:19:22 peter Exp $
This file is part of the Free Pascal run time librar~y.
Copyright (c) 2000 by Marco van de Voort
member of the Free Pascal development team.
This file is part of the Free Pascal run time library.
Copyright (c) 2006 by Francesco Lombardi.
System unit for Linux.
System unit for Gameboy Advance
See the file COPYING.FPC, included in this distribution,
for details about the copyright.
@ -15,285 +13,120 @@
**********************************************************************}
{ These things are set in the makefile, }
{ But you can override them here.}
unit System;
interface
{ If you use an aout system, set the conditional AOUT}
{.$Define AOUT}
Unit {$ifdef VER1_0}Sysgba{$else}System{$endif};
Interface
{$define __ARM__} (* For future usage! *)
{$define FPC_IS_SYSTEM}
{$i osdefs.inc}
{$i gbabiosh.inc}
{$I sysunixh.inc}
{$I systemh.inc}
Implementation
const
LineEnding = #10;
LFNSupport = true;
CtrlZMarksEOF: boolean = false;
DirectorySeparator = '/';
DriveSeparator = ':';
PathSeparator = ';';
FileNameCaseSensitive = false;
maxExitCode = 255;
MaxPathLen = 255;
sLineBreak : string[1] = LineEnding;
DefaultTextLineBreakStyle : TTextLineBreakStyle = tlbsCRLF;
const
UnusedHandle = $ffff;
StdInputHandle = 0;
StdOutputHandle = 1;
StdErrorHandle = $ffff;
var
argc: LongInt = 0;
argv: PPChar;
envp: PPChar;
errno: integer;
implementation
{$I system.inc}
{$i gbabios.inc}
function GetProcessID: SizeUInt;
begin
end;
{*****************************************************************************
Misc. System Dependent Functions
*****************************************************************************}
//procedure fpc_initializeunits;[public,alias:'FPC_INITIALIZEUNITS'];
//begin
// { dummy }
//end;
//procedure fpc_do_exit;[public,alias:'FPC_DO_EXIT'];
//begin
// { dummy }
//end;
//procedure halt; [public,alias:'FPC_HALT_ZERO'];
//begin
// fpc_do_exit;
//end;
///-F-/// procedure haltproc(e:longint);cdecl;external name '_haltproc';
procedure System_exit;
begin
///-F-/// haltproc(ExitCode);
End;
Function ParamCount: Longint;
Begin
///-F-/// Paramcount:=argc-1
End;
function BackPos(c:char; const s: shortstring): integer;
var
i: integer;
Begin
for i:=length(s) downto 0 do
if s[i] = c then break;
if i=0 then
BackPos := 0
else
BackPos := i;
end;
{ variable where full path and filename and executable is stored }
{ is setup by the startup of the system unit. }
var
execpathstr : shortstring;
function paramstr(l: longint) : string;
begin
{ stricly conforming POSIX applications }
{ have the executing filename as argv[0] }
///-F-/// if l=0 then
///-F-/// begin
///-F-/// paramstr := execpathstr;
///-F-/// end
///-F-/// else
///-F-/// paramstr:=strpas(argv[l]);
end;
Procedure Randomize;
Begin
randseed:=longint(Fptime(nil));
End;
{*****************************************************************************
SystemUnit Initialization
ParamStr/Randomize
*****************************************************************************}
function reenable_signal(sig : longint) : boolean;
var
e : TSigSet;
i,j : byte;
{ number of args }
function paramcount : longint;
begin
fillchar(e,sizeof(e),#0);
{ set is 1 based PM }
dec(sig);
i:=sig mod 32;
j:=sig div 32;
e[j]:=1 shl i;
fpsigprocmask(SIG_UNBLOCK,@e,nil);
reenable_signal:=geterrno=0;
paramcount:=0;
end;
// signal handler is arch dependant due to processorexception to language
// exception translation
{$i sighnd.inc}
var
act: SigActionRec;
Procedure InstallSignals;
{ argument number l }
function paramstr(l : longint) : string;
begin
{ Initialize the sigaction structure }
{ all flags and information set to zero }
FillChar(act, sizeof(SigActionRec),0);
{ initialize handler }
act.sa_handler := SigActionHandler(@SignalToRunError);
act.sa_flags:=SA_SIGINFO
{$ifdef cpux86_64}
or $4000000
{$endif cpux86_64}
;
FpSigAction(SIGFPE,@act,nil);
FpSigAction(SIGSEGV,@act,nil);
FpSigAction(SIGBUS,@act,nil);
FpSigAction(SIGILL,@act,nil);
paramstr:='';
end;
procedure SetupCmdLine;
var
bufsize,
len,j,
size,i : longint;
found : boolean;
buf : pchar;
procedure AddBuf;
begin
reallocmem(cmdline,size+bufsize);
move(buf^,cmdline[size],bufsize);
inc(size,bufsize);
bufsize:=0;
end;
{ set randseed to a new pseudo random value }
procedure randomize;
begin
///-F-///
{
GetMem(buf,ARG_MAX);
size:=0;
bufsize:=0;
i:=0;
while (i<argc) do
begin
len:=strlen(argv[i]);
if len>ARG_MAX-2 then
len:=ARG_MAX-2;
found:=false;
for j:=1 to len do
if argv[i][j]=' ' then
begin
found:=true;
break;
end;
if bufsize+len>=ARG_MAX-2 then
AddBuf;
if found then
begin
buf[bufsize]:='"';
inc(bufsize);
end;
move(argv[i]^,buf[bufsize],len);
inc(bufsize,len);
if found then
begin
buf[bufsize]:='"';
inc(bufsize);
end;
if i<argc then
buf[bufsize]:=' '
else
buf[bufsize]:=#0;
inc(bufsize);
inc(i);
end;
AddBuf;
FreeMem(buf,ARG_MAX);
///-F-///
}
end;
procedure SysInitStdIO;
begin
OpenStdIO(Input,fmInput,StdInputHandle);
OpenStdIO(Output,fmOutput,StdOutputHandle);
OpenStdIO(ErrOutput,fmOutput,StdErrorHandle);
OpenStdIO(StdOut,fmOutput,StdOutputHandle);
OpenStdIO(StdErr,fmOutput,StdErrorHandle);
end;
procedure SysInitExecPath;
var
i : longint;
begin
execpathstr[0]:=#0;
i:=Fpreadlink('/proc/self/exe',@execpathstr[1],high(execpathstr));
{ it must also be an absolute filename, linux 2.0 points to a memory
location so this will skip that }
if (i>0) and (execpathstr[1]='/') then
execpathstr[0]:=char(i);
end;
function GetProcessID: SizeUInt;
begin
GetProcessID := SizeUInt (fpGetPID);
end;
function CheckInitialStkLen(stklen : SizeUInt) : SizeUInt;
begin
result := stklen;
end;
Begin
///-F-/// IsConsole := TRUE;
///-F-/// IsLibrary := FALSE;
begin
StackLength := CheckInitialStkLen(InitialStkLen);
StackBottom := Sptr - StackLength;
{ Set up signals handlers }
InstallSignals;
{ Setup heap }
{ OS specific startup }
{ Set up signals handlers }
{ Setup heap }
InitHeap;
SysInitExceptions;
{ Arguments }
///-F-/// SetupCmdLine;
SysInitExecPath;
{ Setup stdin, stdout and stderr }
{ Setup stdin, stdout and stderr }
SysInitStdIO;
{ Reset IO Error }
{ Reset IO Error }
InOutRes:=0;
{ threading }
{ Arguments }
InitSystemThreads;
{$ifdef HASVARIANT}
///-F-/// initvariantmanager;
{$endif HASVARIANT}
{$ifdef HASWIDESTRING}
///-F-/// initwidestringmanager;
{$endif HASWIDESTRING}
End.
{
$Log: system.pp,v $
Revision 1.25 2005/04/24 21:19:22 peter
* unblock signal in signalhandler, remove the sigprocmask call
from setjmp
Revision 1.24 2005/02/14 17:13:30 peter
* truncate log
Revision 1.23 2005/02/13 21:47:56 peter
* include file cleanup part 2
Revision 1.22 2005/02/06 11:20:52 peter
* threading in system unit
* removed systhrds unit
Revision 1.21 2005/02/01 20:22:49 florian
* improved widestring infrastructure manager
}
initvariantmanager;
initwidestringmanager;
end.

25
rtl/gba/systhrd.inc Normal file
View File

@ -0,0 +1,25 @@
{
This file is part of the Free Pascal run time library.
Copyright (c) 2002 by Peter Vreman,
member of the Free Pascal development team.
Linux (pthreads) threading support implementation
See the file COPYING.FPC, included in this distribution,
for details about the copyright.
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.
**********************************************************************}
Procedure InitSystemThreads;
begin
{ This should be changed to a real value during
thread driver initialization if appropriate. }
ThreadID := 1;
SetNoThreadManager;
end;

258
rtl/gba/sysutils.pp Normal file
View File

@ -0,0 +1,258 @@
{
This file is part of the Free Pascal run time library.
Copyright (c) 2004 by Karoly Balogh
Sysutils unit for Gameboy Advance.
This unit is based on the MorphOS one and is adapted for Gameboy Advance
simply by stripping out all stuff inside funcs and procs.
Copyright (c) 2006 by Francesco Lombardi
Based on Amiga version by Carl Eric Codere, and other
parts of the RTL
See the file COPYING.FPC, included in this distribution,
for details about the copyright.
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.
**********************************************************************}
unit sysutils;
interface
{$MODE objfpc}
{ force ansistrings }
{$H+}
{ Include platform independent interface part }
{$i sysutilh.inc}
implementation
uses dos, sysconst;
{ Include platform independent implementation part }
{$i sysutils.inc}
{****************************************************************************
File Functions
****************************************************************************}
function FileOpen(const FileName: string; Mode: Integer): LongInt;
begin
end;
function FileGetDate(Handle: LongInt) : LongInt;
begin
end;
function FileSetDate(Handle, Age: LongInt) : LongInt;
begin
end;
function FileCreate(const FileName: string) : LongInt;
begin
end;
function FileCreate(const FileName: string; Mode: integer): LongInt;
begin
end;
function FileRead(Handle: LongInt; var Buffer; Count: LongInt): LongInt;
begin
end;
function FileWrite(Handle: LongInt; const Buffer; Count: LongInt): LongInt;
begin
end;
function FileSeek(Handle, FOffset, Origin: LongInt) : LongInt;
begin
end;
function FileSeek(Handle: LongInt; FOffset, Origin: Int64): Int64;
begin
end;
procedure FileClose(Handle: LongInt);
begin
end;
function FileTruncate(Handle, Size: LongInt): Boolean;
begin
end;
function DeleteFile(const FileName: string) : Boolean;
begin
end;
function RenameFile(const OldName, NewName: string): Boolean;
begin
end;
(****** end of non portable routines ******)
Function FileAge (Const FileName : String): Longint;
begin
end;
Function FileExists (Const FileName : String) : Boolean;
Begin
end;
Function FindFirst (Const Path : String; Attr : Longint; Out Rslt : TSearchRec) : Longint;
begin
end;
Function FindNext (Var Rslt : TSearchRec) : Longint;
begin
end;
Procedure FindClose (Var F : TSearchrec);
begin
end;
Function FileGetAttr (Const FileName : String) : Longint;
begin
end;
Function FileSetAttr (Const Filename : String; Attr: longint) : Longint;
begin
end;
{****************************************************************************
Disk Functions
****************************************************************************}
Procedure AddDisk(const path:string);
begin
end;
Function DiskFree(Drive: Byte): int64;
Begin
End;
Function DiskSize(Drive: Byte): int64;
Begin
End;
Function GetCurrentDir : String;
begin
end;
Function SetCurrentDir (Const NewDir : String) : Boolean;
begin
end;
Function CreateDir (Const NewDir : String) : Boolean;
begin
end;
Function RemoveDir (Const Dir : String) : Boolean;
begin
end;
function DirectoryExists(const Directory: string): Boolean;
begin
end;
{****************************************************************************
Misc Functions
****************************************************************************}
procedure Beep;
begin
end;
{****************************************************************************
Locale Functions
****************************************************************************}
Procedure GetLocalTime(var SystemTime: TSystemTime);
begin
end ;
function SysErrorMessage(ErrorCode: Integer): String;
begin
{ Result:=StrError(ErrorCode);}
end;
{****************************************************************************
OS utility functions
****************************************************************************}
Function GetEnvironmentVariable(Const EnvVar : String) : String;
begin
end;
Function GetEnvironmentVariableCount : Integer;
begin
end;
Function GetEnvironmentString(Index : Integer) : String;
begin
end;
function ExecuteProcess (const Path: AnsiString; const ComLine: AnsiString): integer;
begin
end;
function ExecuteProcess (const Path: AnsiString;
const ComLine: array of AnsiString): integer;
begin
end;
{****************************************************************************
Initialization code
****************************************************************************}
Initialization
InitExceptions;
Finalization
DoneExceptions;
end.

112
rtl/gba/tthread.inc Normal file
View File

@ -0,0 +1,112 @@
{
This file is part of the Free Component Library (FCL)
Copyright (c) 1999-2002 by the Free Pascal development team
See the file COPYING.FPC, included in this distribution,
for details about the copyright.
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.
**********************************************************************}
{****************************************************************************}
{* TThread *}
{****************************************************************************}
{$WARNING This file is only a stub, and will not work!}
const
ThreadCount: longint = 0;
(* Implementation of exported functions *)
procedure AddThread (T: TThread);
begin
Inc (ThreadCount);
end;
procedure RemoveThread (T: TThread);
begin
Dec (ThreadCount);
end;
procedure TThread.CallOnTerminate;
begin
FOnTerminate (Self);
end;
function TThread.GetPriority: TThreadPriority;
begin
end;
procedure TThread.SetPriority(Value: TThreadPriority);
begin
end;
procedure TThread.SetSuspended(Value: Boolean);
begin
if Value <> FSuspended then
begin
if Value then Suspend else Resume;
end;
end;
procedure TThread.DoTerminate;
begin
if Assigned (FOnTerminate) then Synchronize (@CallOnTerminate);
end;
constructor TThread.Create(CreateSuspended: Boolean;
const StackSize: SizeUInt = DefaultStackSize);
var
Flags: cardinal;
begin
inherited Create;
AddThread (Self);
end;
destructor TThread.Destroy;
begin
if not FFinished and not Suspended then
begin
Terminate;
WaitFor;
end;
end;
procedure TThread.Resume;
begin
end;
procedure TThread.Suspend;
begin
end;
procedure TThread.Terminate;
begin
FTerminated := true;
end;
function TThread.WaitFor: Integer;
begin
end;

38
rtl/gba/varutils.pp Normal file
View File

@ -0,0 +1,38 @@
{
This file is part of the Free Pascal run time library.
Copyright (c) 1999-2000 by the Free Pascal development team
Interface and OS-dependent part of variant support
See the file COPYING.FPC, included in this distribution,
for details about the copyright.
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.
**********************************************************************}
{$MODE ObjFPC}
Unit varutils;
Interface
Uses sysutils;
// Read definitions.
{$i varutilh.inc}
Implementation
// Code common to all platforms.
{$i cvarutil.inc}
// Code common to non-win32 platforms.
{$i varutils.inc}
end.

10
rtl/inc/heap.inc
View File

@ -716,6 +716,7 @@ end;
Grow Heap
*****************************************************************************}
{$ifndef gba}
function alloc_oschunk(chunkindex, size: ptrint):pointer;
var
pmcfirst,
@ -843,6 +844,15 @@ begin
result:=pmcv;
end;
end;
{$else gba}
function alloc_oschunk(chunkindex, size: ptrint):pointer;
begin
alloc_oschunk := nil;
if not ReturnNilIfGrowHeapFails then
runerror(203);
end;
{$endif gba}
{*****************************************************************************

7
utils/fpcm/fpcmake.ini
View File

@ -901,6 +901,13 @@ HASSHAREDLIB=1
SHORTSUFFIX=dwn
endif
# gba
ifeq ($(OS_TARGET),gba)
EXEEXT=.gba
SHAREDLIBEXT=.so
SHORTSUFFIX=gba
endif
else
# long version for 1.0.x - target specific extensions

9
utils/fpcm/fpcmmain.pp
View File

@ -70,7 +70,7 @@ interface
o_linux,o_go32v2,o_win32,o_os2,o_freebsd,o_beos,o_netbsd,
o_amiga,o_atari, o_solaris, o_qnx, o_netware, o_openbsd,o_wdosx,
o_palmos,o_macos,o_darwin,o_emx,o_watcom,o_morphos,o_netwlibc,
o_win64,o_wince
o_win64,o_wince,o_gba
);
TTargetSet=array[tcpu,tos] of boolean;
@ -88,14 +88,14 @@ interface
'linux','go32v2','win32','os2','freebsd','beos','netbsd',
'amiga','atari','solaris', 'qnx', 'netware','openbsd','wdosx',
'palmos','macos','darwin','emx','watcom','morphos','netwlibc',
'win64','wince'
'win64','wince','gba'
);
OSSuffix : array[TOS] of string=(
'_linux','_go32v2','_win32','_os2','_freebsd','_beos','_netbsd',
'_amiga','_atari','_solaris', '_qnx', '_netware','_openbsd','_wdosx',
'_palmos','_macos','_darwin','_emx','_watcom','_morphos','_netwlibc',
'_win64','_wince'
'_win64','_wince','_gba'
);
{ This table is kept OS,Cpu because it is easier to maintain (PFV) }
@ -123,7 +123,8 @@ interface
{ morphos } ( false, false, true, false ,false, false, false),
{ netwlibc }( true, false, false, false, false, false, false),
{ win64 } ( false, false, false, false, true, false, false),
{ wince }( true, false, false, false, false, true, false)
{ wince }( true, false, false, false, false, true, false),
{ gba } ( false, false, false, false, false, true, false)
);
type