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

* restores atari support/rtl partially

Browse Source 
git-svn-id: trunk@25699 -
This commit is contained in:
florian 2013-10-06 19:36:59 +00:00
parent 6be9627e74
commit 304d7ef7a1
13 changed files with 3574 additions and 351 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
.gitattributes vendored
View File

@ -7509,12 +7509,16 @@ rtl/arm/strings.inc svneol=native#text/plain
rtl/arm/stringss.inc svneol=native#text/plain
rtl/arm/thumb.inc svneol=native#text/plain
rtl/arm/thumb2.inc svneol=native#text/plain
rtl/atari/os.inc svneol=native#text/plain
rtl/atari/Makefile svneol=native#text/plain
rtl/atari/Makefile.fpc svneol=native#text/plain
rtl/atari/prt0.as svneol=native#text/plain
rtl/atari/readme -text
rtl/atari/rtldefs.inc svneol=native#text/plain
rtl/atari/sysatari.pas svneol=native#text/plain
rtl/atari/system.pas svneol=native#text/plain
rtl/atari/sysfile.inc svneol=native#text/plain
rtl/atari/sysheap.inc svneol=native#text/plain
rtl/atari/sysos.inc svneol=native#text/plain
rtl/atari/sysosh.inc svneol=native#text/plain
rtl/atari/system.pp svneol=native#text/plain
rtl/avr/avr.inc svneol=native#text/plain
rtl/avr/int64p.inc svneol=native#text/plain
rtl/avr/makefile.cpu svneol=native#text/plain

3
compiler/m68k/cputarg.pas
View File

@ -41,6 +41,9 @@ implementation
{$ifndef NOTARGETAMIGA}
,t_amiga
{$endif}
{$ifndef NOTARGETATARI}
,t_atari
{$endif}
{$ifndef NOTARGETPALMOS}
,t_palmos
{$endif}

5
compiler/options.pas
View File

@ -3296,8 +3296,9 @@ begin
{ force fpu emulation on arm/wince, arm/gba, arm/embedded and arm/nds
if fpu type not explicitly set }
if not(option.FPUSetExplicitly) and
((target_info.system in [system_arm_wince,system_arm_gba,system_m68k_amiga,
system_m68k_linux,system_arm_nds,system_arm_embedded])
((target_info.system in [system_arm_wince,system_arm_gba,
system_m68k_amiga,system_m68k_atari,system_m68k_linux,
system_arm_nds,system_arm_embedded])
{$ifdef arm}
or (target_info.abi=abi_eabi)
{$endif arm}

1
compiler/systems.inc
View File

@ -200,6 +200,7 @@
tlink = (ld_none,
ld_aix, { external linkers (one per OS, handles all CPUs) }
ld_amiga,
ld_atari,
ld_android,
ld_beos,
ld_bsd,

33
compiler/systems/i_atari.pas
View File

@ -31,12 +31,11 @@ unit i_atari;
const
system_m68k_atari_info : tsysteminfo =
(
system : target_m68k_Atari;
system : system_m68k_Atari;
name : 'Atari ST/STE';
shortname : 'atari';
flags : [tf_use_8_3];
cpu : cpu_m68k;
short_name : 'ATARI';
unit_env : '';
extradefines : '';
exeext : '.tpp';
@ -59,25 +58,37 @@ unit i_atari;
sharedClibprefix : '';
importlibprefix : 'libimp';
importlibext : '.a';
p_ext_support : false;
Cprefix : '_';
newline : #10;
dirsep : '/';
files_case_relevent : true;
assem : as_gas;
assemextern : as_gas;
link : ld_m68k_atari;
linkextern : ld_m68k_atari;
ar : ar_m68k_ar;
link : ld_atari;
linkextern : ld_atari;
ar : ar_gnu_ar;
res : res_none;
dbg : dbg_stabs;
script : script_unix;
endian : endian_big;
maxCrecordalignment : 4;
stacksize : 8192;
alignment :
(
procalign : 4;
loopalign : 4;
jumpalign : 0;
constalignmin : 0;
constalignmax : 4;
varalignmin : 0;
varalignmax : 4;
localalignmin : 0;
localalignmax : 4;
recordalignmin : 0;
recordalignmax : 2;
maxCrecordalign : 4
);
first_parm_offset : 8;
stacksize : 262144;
stackalign : 2;
DllScanSupported:false;
use_function_relative_addresses : false
abi : abi_default;
);
implementation

2879
rtl/atari/Makefile Normal file
View File

File diff suppressed because it is too large Load Diff

233
rtl/atari/Makefile.fpc Normal file
View File

@ -0,0 +1,233 @@
#
# Makefile.fpc for Free Pascal Atari RTL
#
[package]
main=rtl
[target]
loaders=prt0
units=$(SYSTEMUNIT) uuchar objpas macpas iso7185 strings \
dos heaptrc lineinfo ctypes \
sysutils fgl classes strutils math typinfo varutils fmtbcd \
charset cpall ucomplex getopts matrix \
variants types rtlconsts sysconst dateutil objects
implicitunits=cp1250 cp1251 cp1252 cp1253 cp1254 cp1255 cp1256 cp1257 cp1258 \
cp437 cp646 cp850 cp866 cp874 cp932 cp936 cp949 cp950 cp8859_1 cp8859_5
# \
# exec timer doslib utility hardware inputevent graphics layers \
# intuition aboxlib mui \
# these can be moved to packages later
# clipboard datatypes asl ahi tinygl get9 muihelper \
rsts=math rtlconsts varutils typinfo variants classes sysconst dateutil
#implicitunits=exeinfo
[require]
nortl=y
[install]
fpcpackage=y
[default]
fpcdir=../..
target=atari
cpu=m68k
[compiler]
includedir=$(INC) $(PROCINC) $(CPU_TARGET)
sourcedir=$(INC) $(PROCINC) $(CPU_TARGET) $(COMMON)
[prerules]
RTL=..
INC=$(RTL)/inc
COMMON=$(RTL)/common
PROCINC=$(RTL)/$(CPU_TARGET)
UNITPREFIX=rtl
SYSTEMUNIT=system
# Use new feature from 1.0.5 version
# that generates release PPU files
# which will not be recompiled
ifdef RELEASE
override FPCOPT+=-Ur
endif
# Paths
OBJPASDIR=$(RTL)/objpas
GRAPHDIR=$(INC)/graph
[rules]
.NOTPARALLEL:
# Get the system independent include file names.
# This will set the following variables :
# SYSINCNAMES
include $(INC)/makefile.inc
SYSINCDEPS=$(addprefix $(INC)/,$(SYSINCNAMES))
# Get the processor dependent include file names.
# This will set the following variables :
# CPUINCNAMES
include $(PROCINC)/makefile.cpu
SYSCPUDEPS=$(addprefix $(PROCINC)/,$(CPUINCNAMES))
# Put system unit dependencies together.
SYSDEPS=$(SYSINCDEPS) $(SYSCPUDEPS)
#
# Loaders
#
prt0$(OEXT) : prt0.as
$(AS) -o $(UNITTARGETDIRPREFIX)prt0$(OEXT) prt0.as
#
# Base Units (System, strings, os-dependent-base-unit)
#
$(SYSTEMUNIT)$(PPUEXT) : $(SYSTEMUNIT).pp $(SYSDEPS)
$(COMPILER) -Us -Sg $(SYSTEMUNIT).pp $(REDIR)
uuchar$(PPUEXT): $(SYSTEMUNIT)$(PPUEXT) $(INC)/uuchar.pp
objpas$(PPUEXT): $(OBJPASDIR)/objpas.pp $(INC)/except.inc $(SYSTEMUNIT)$(PPUEXT)
$(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/objpas.pp $(REDIR)
strings$(PPUEXT) : $(INC)/strings.pp $(INC)/stringsi.inc \
$(PROCINC)/strings.inc $(PROCINC)/stringss.inc \
$(SYSTEMUNIT)$(PPUEXT)
#
# System Dependent Units
#
#ports$(PPUEXT) : ports.pas objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
#doscalls$(PPUEXT) : doscalls.pas strings$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
#
# TP7 Compatible RTL Units
#
dos$(PPUEXT) : dos.pp $(INC)/filerec.inc $(INC)/textrec.inc strings$(PPUEXT) \
$(SYSTEMUNIT)$(PPUEXT)
#crt$(PPUEXT) : crt.pas $(INC)/textrec.inc $(SYSTEMUNIT)$(PPUEXT)
objects$(PPUEXT) : $(INC)/objects.pp dos$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
#printer$(PPUEXT) : printer.pas $(INC)/textrec.inc $(SYSTEMUNIT)$(PPUEXT)
#graph$(PPUEXT) : graph.pp
#
# Delphi Compatible Units
#
sysutils$(PPUEXT) : sysutils.pp $(wildcard $(OBJPASDIR)/sysutils/*.inc) \
objpas$(PPUEXT) dos$(PPUEXT) sysconst$(PPUEXT)
$(COMPILER) -Fi$(OBJPASDIR)/sysutils sysutils.pp
classes$(PPUEXT) : classes.pp $(wildcard $(OBJPASDIR)/classes/*.inc) \
sysutils$(PPUEXT) typinfo$(PPUEXT) rtlconsts$(PPUEXT) types$(PPUEXT) fgl$(PPUEXT)
$(COMPILER) -Fi$(OBJPASDIR)/classes classes.pp
strutils$(PPUEXT) : $(OBJPASDIR)/strutils.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) \
sysutils$(PPUEXT)
$(COMPILER) $(OBJPASDIR)/strutils.pp
typinfo$(PPUEXT): $(OBJPASDIR)/typinfo.pp objpas$(PPUEXT)
$(COMPILER) -Sg $(OBJPASDIR)/typinfo.pp $(REDIR)
math$(PPUEXT): $(OBJPASDIR)/math.pp objpas$(PPUEXT) sysutils$(PPUEXT)
$(COMPILER) $(OBJPASDIR)/math.pp $(REDIR)
varutils$(PPUEXT) : $(OBJPASDIR)/cvarutil.inc $(OBJPASDIR)/varutils.inc \
$(OBJPASDIR)/varutilh.inc varutils.pp
$(COMPILER) -I$(OBJPASDIR) varutils.pp $(REDIR)
fmtbcd$(PPUEXT) : $(OBJPASDIR)/fmtbcd.pp objpas$(PPUEXT) sysutils$(PPUEXT) variants$(PPUEXT) classes$(PPUEXT) system$(PPUEXT)
$(COMPILER) $(OBJPASDIR)/fmtbcd.pp
fgl$(PPUEXT) : $(OBJPASDIR)/fgl.pp objpas$(PPUEXT) types$(PPUEXT) system$(PPUEXT) sysutils$(PPUEXT)
$(COMPILER) $(OBJPASDIR)/fgl.pp
types$(PPUEXT) : $(OBJPASDIR/types.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
$(COMPILER) $(OBJPASDIR)/types.pp
rtlconsts$(PPUEXT) : $(OBJPASDIR)/rtlconsts.pp
$(COMPILER) $(OBJPASDIR)/rtlconsts.pp
sysconst$(PPUEXT) : $(OBJPASDIR)/sysconst.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
$(COMPILER) $(OBJPASDIR)/sysconst.pp
dateutil$(PPUEXT) : $(OBJPASDIR)/dateutil.pp
$(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/dateutil.pp
#
# Mac Pascal Model
#
macpas$(PPUEXT) : $(INC)/macpas.pp objpas$(PPUEXT) math$(PPUEXT)
$(COMPILER) $(INC)/macpas.pp $(REDIR)
#
# Other system-independent RTL Units
#
ucomplex$(PPUEXT): $(INC)/ucomplex.pp math$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
getopts$(PPUEXT) : $(INC)/getopts.pp $(SYSTEMUNIT)$(PPUEXT)
heaptrc$(PPUEXT) : $(INC)/heaptrc.pp $(SYSTEMUNIT)$(PPUEXT)
$(COMPILER) -Sg $(INC)/heaptrc.pp $(REDIR)
#lineinfo$(PPUEXT) : $(INC)/lineinfo.pp $(SYSTEMUNIT)$(PPUEXT)
charset$(PPUEXT) : $(INC)/charset.pp $(SYSTEMUNIT)$(PPUEXT)
cpall$(PPUEXT): $(RTL)/charmaps/cpall.pas system$(PPUEXT) charset$(PPUEXT)
$(COMPILER) -Fu$(INC) -Fi$(RTL)/charmaps $(RTL)/charmaps/cpall.pas
#
# Other system-dependent RTL Units
#
#exec$(PPUEXT) : exec.pp execf.inc execd.inc
#timer$(PPUEXT) : timer.pp timerd.inc timerf.inc
#utility$(PPUEXT) : utility.pp exec$(PPUEXT) utilf.inc utild1.inc utild2.inc
#doslib$(PPUEXT) : doslib.pp exec$(PPUEXT) timer$(PPUEXT) doslibd.inc doslibf.inc
#hardware$(PPUEXT): hardware.pas exec$(PPUEXT)
#inputevent$(PPUEXT): inputevent.pas exec$(PPUEXT) timer$(PPUEXT) utility$(PPUEXT)
#graphics$(PPUEXT): graphics.pas exec$(PPUEXT) utility$(PPUEXT) hardware$(PPUEXT)
#layers$(PPUEXT) : layers.pas exec$(PPUEXT) graphics$(PPUEXT) utility$(PPUEXT)
#intuition$(PPUEXT): intuition.pas exec$(PPUEXT) graphics$(PPUEXT) utility$(PPUEXT) \
# inputevent$(PPUEXT) timer$(PPUEXT) layers$(PPUEXT)
#aboxlib$(PPUEXT): aboxlib.pas
#clipboard$(PPUEXT): clipboard.pas exec$(PPUEXT)
#datatype$(PPUEXT): datatypes.pas exec$(PPUEXT) doslib$(PPUEXT) intuition$(PPUEXT) \
# utility$(PPUEXT) graphics$(PPUEXT)
#asl$(PPUEXT): asl.pas exec$(PPUEXT) graphics$(PPUEXT) utility$(PPUEXT)
#ahi$(PPUEXT): ahi.pas exec$(PPUEXT) utility$(PPUEXT)
#mui$(PPUEXT): mui.pas exec$(PPUEXT) utility$(PPUEXT) intuition$(PPUEXT) graphics$(PPUEXT)
#tinygl$(PPUEXT): tinygl.pp exec$(PPUEXT)
#get9$(PPUEXT): get9.pas exec$(PPUEXT)
#muihelper$(PPUEXT): muihelper.pas intuition$(PPUEXT) mui$(PPUEXT) doslib$(PPUEXT) utility$(PPUEXT)

1
rtl/atari/sysatari.pas
View File

@ -1 +0,0 @@
{$i system.pas}

332
rtl/atari/sysfile.inc Normal file
View File

@ -0,0 +1,332 @@
{
This file is part of the Free Pascal run time library.
Copyright (c) 2005 by Free Pascal development team
Low level file 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.
**********************************************************************}
{$asmmode motorola}
{****************************************************************************
Low Level File Routines
****************************************************************************}
procedure DoDirSeparators(p:pchar);
var
i : longint;
begin
{ allow slash as backslash }
for i:=0 to strlen(p) do
if p[i] in AllowDirectorySeparators then p[i]:=DirectorySeparator;
end;
procedure do_close(h : longint);
begin
asm
movem.l d2/d3/a2/a3,-(sp)
move.l h,d0
move.w d0,-(sp)
move.w #$3e,-(sp)
trap #1
add.l #4,sp { restore stack ... }
movem.l (sp)+,d2/d3/a2/a3
end;
end;
procedure do_erase(p : pchar);
begin
DoDirSeparators(p);
asm
move.l d2,d6 { save d2 }
movem.l d3/a2/a3,-(sp) { save regs }
move.l p,-(sp)
move.w #$41,-(sp)
trap #1
add.l #6,sp
move.l d6,d2 { restore d2 }
movem.l (sp)+,d3/a2/a3
tst.w d0
beq @doserend
move.w d0,errno
@doserend:
end;
if errno <> 0 then
Error2InOut;
end;
procedure do_rename(p1,p2 : pchar);
begin
DoDirSeparators(p1);
DoDirSeparators(p2);
asm
move.l d2,d6 { save d2 }
movem.l d3/a2/a3,-(sp)
move.l p1,-(sp)
move.l p2,-(sp)
clr.w -(sp)
move.w #$56,-(sp)
trap #1
lea 12(sp),sp
move.l d6,d2 { restore d2 }
movem.l (sp)+,d3/a2/a3
tst.w d0
beq @dosreend
move.w d0,errno { error ... }
@dosreend:
end;
if errno <> 0 then
Error2InOut;
end;
function do_isdevice(handle:word):boolean;
begin
if (handle=stdoutputhandle) or (handle=stdinputhandle) or
(handle=stderrorhandle) then
do_isdevice:=FALSE
else
do_isdevice:=TRUE;
end;
function do_write(h,addr,len : longint) : longint;
begin
asm
move.l d2,d6 { save d2 }
movem.l d3/a2/a3,-(sp)
move.l addr,-(sp)
move.l len,-(sp)
move.l h,d0
move.w d0,-(sp)
move.w #$40,-(sp)
trap #1
lea 12(sp),sp
move.l d6,d2 { restore d2 }
movem.l (sp)+,d3/a2/a3
tst.l d0
bpl @doswrend
move.w d0,errno { error ... }
@doswrend:
move.l d0,@RESULT
end;
if errno <> 0 then
Error2InOut;
end;
function do_read(h,addr,len : longint) : longint;
begin
asm
move.l d2,d6 { save d2 }
movem.l d3/a2/a3,-(sp)
move.l addr,-(sp)
move.l len,-(sp)
move.l h,d0
move.w d0,-(sp)
move.w #$3f,-(sp)
trap #1
lea 12(sp),sp
move.l d6,d2 { restore d2 }
movem.l (sp)+,d3/a2/a3
tst.l d0
bpl @dosrdend
move.w d0,errno { error ... }
@dosrdend:
move.l d0,@Result
end;
if errno <> 0 then
Error2InOut;
end;
function do_filepos(handle : longint) : longint;
begin
asm
move.l d2,d6 { save d2 }
movem.l d3/a2/a3,-(sp)
move.w #1,-(sp) { seek from current position }
move.l handle,d0
move.w d0,-(sp)
move.l #0,-(sp) { with a seek offset of zero }
move.w #$42,-(sp)
trap #1
lea 10(sp),sp
move.l d6,d2 { restore d2 }
movem.l (sp)+,d3/a2/a3
move.l d0,@Result
end;
end;
procedure do_seek(handle,pos : longint);
begin
asm
move.l d2,d6 { save d2 }
movem.l d3/a2/a3,-(sp)
move.w #0,-(sp) { seek from start of file }
move.l handle,d0
move.w d0,-(sp)
move.l pos,-(sp)
move.w #$42,-(sp)
trap #1
lea 10(sp),sp
move.l d6,d2 { restore d2 }
movem.l (sp)+,d3/a2/a3
end;
end;
function do_seekend(handle:longint):longint;
var
t: longint;
begin
asm
move.l d2,d6 { save d2 }
movem.l d3/a2/a3,-(sp)
move.w #2,-(sp) { seek from end of file }
move.l handle,d0
move.w d0,-(sp)
move.l #0,-(sp) { with an offset of 0 from end }
move.w #$42,-(sp)
trap #1
lea 10(sp),sp
move.l d6,d2 { restore d2 }
movem.l (sp)+,d3/a2/a3
move.l d0,t
end;
do_seekend:=t;
end;
function do_filesize(handle : longint) : longint;
var
aktfilepos : longint;
begin
aktfilepos:=do_filepos(handle);
do_filesize:=do_seekend(handle);
do_seek(handle,aktfilepos);
end;
procedure do_truncate (handle,pos:longint);
begin
do_seek(handle,pos);
{!!!!!!!!!!!!}
end;
procedure do_open(var f;p:pchar;flags:longint);
{
filerec and textrec have both handle and mode as the first items so
they could use the same routine for opening/creating.
when (flags and $100) the file will be append
when (flags and $1000) the file will be truncate/rewritten
when (flags and $10000) there is no check for close (needed for textfiles)
}
var
i : word;
oflags: longint;
begin
DoDirSeparators(p);
{ close first if opened }
if ((flags and $10000)=0) then
begin
case filerec(f).mode of
fminput,fmoutput,fminout : Do_Close(filerec(f).handle);
fmclosed : ;
else
begin
inoutres:=102; {not assigned}
exit;
end;
end;
end;
{ reset file handle }
filerec(f).handle:=UnusedHandle;
oflags:=$02; { read/write mode }
{ convert filemode to filerec modes }
case (flags and 3) of
0 : begin
filerec(f).mode:=fminput;
oflags:=$00; { read mode only }
end;
1 : filerec(f).mode:=fmoutput;
2 : filerec(f).mode:=fminout;
end;
if (flags and $1000)<>0 then
begin
filerec(f).mode:=fmoutput;
oflags:=$04; { read/write with create }
end
else
if (flags and $100)<>0 then
begin
filerec(f).mode:=fmoutput;
oflags:=$02; { read/write }
end;
{ empty name is special }
if p[0]=#0 then
begin
case filerec(f).mode of
fminput : filerec(f).handle:=StdInputHandle;
fmappend,
fmoutput : begin
filerec(f).handle:=StdOutputHandle;
filerec(f).mode:=fmoutput; {fool fmappend}
end;
end;
exit;
end;
asm
movem.l d2/d3/a2/a3,-(sp) { save used registers }
cmp.l #4,oflags { check if rewrite mode ... }
bne @opencont2
{ rewrite mode - create new file }
move.w #0,-(sp)
move.l p,-(sp)
move.w #$3c,-(sp)
trap #1
add.l #8,sp { restore stack of os call }
bra @end
{ reset - open existing files }
@opencont2:
move.l oflags,d0 { use flag as source ... }
@opencont1:
move.w d0,-(sp)
move.l p,-(sp)
move.w #$3d,-(sp)
trap #1
add.l #8,sp { restore stack of os call }
@end:
movem.l (sp)+,d2/d3/a2/a3
tst.w d0
bpl @opennoerr { if positive return values then ok }
cmp.w #-1,d0 { if handle is -1 CON: }
beq @opennoerr
cmp.w #-2,d0 { if handle is -2 AUX: }
beq @opennoerr
cmp.w #-3,d0 { if handle is -3 PRN: }
beq @opennoerr
move.w d0,errno { otherwise normal error }
@opennoerr:
move.w d0,i { get handle as SIGNED VALUE... }
end;
if errno <> 0 then
Error2InOut;
filerec(f).handle:=i;
if ((flags and $100) <> 0) and
(FileRec (F).Handle <> UnusedHandle) then
do_seekend(filerec(f).handle);
end;

29
rtl/atari/sysheap.inc Normal file
View File

@ -0,0 +1,29 @@
{
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: ptruint): pointer;
begin
Result:=nil;
end;
{$define HAS_SYSOSFREE}
procedure SysOSFree(p: pointer; size: ptruint);
begin
end;

14
rtl/atari/os.inc → rtl/atari/sysos.inc
View File

@ -1,6 +1,10 @@
{
This file is part of the Free Pascal run time library.
Copyright (c) 1999-2000 by the Free Pascal development team.
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.
@ -10,11 +14,3 @@
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
**********************************************************************}
{$define atari}
{$undef go32v2}
{$undef os2}
{$undef linux}
{$undef win32}
{$undef amiga}
{$undef macos}

33
rtl/atari/sysosh.inc Normal file
View File

@ -0,0 +1,33 @@
{
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
{$ifdef CPU64}
THandle = Int64;
{$else CPU64}
THandle = Longint;
{$endif CPU64}
TThreadID = THandle;
PRTLCriticalSection = ^TRTLCriticalSection;
TRTLCriticalSection = record
Locked: boolean
end;

352
rtl/atari/system.pas → rtl/atari/system.pp
View File

@ -11,7 +11,6 @@
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
**********************************************************************}
{$define ATARI}
unit system;
{--------------------------------------------------------------------}
@ -23,17 +22,10 @@ unit system;
{--------------------------------------------------------------------}
{$I os.inc}
interface
{$I systemh.inc}
type
THandle = longint;
{$I heaph.inc}
{Platform specific information}
const
LineEnding = #10;
@ -61,10 +53,37 @@ const
StdOutputHandle = 1;
StdErrorHandle = $ffff;
{$if defined(CPUARM) or defined(CPUM68K) or defined(CPUSPARC) or defined(CPUMIPS)}
{$define fpc_softfpu_interface}
{$i softfpu.pp}
{$undef fpc_softfpu_interface}
{$endif defined(CPUARM) or defined(CPUM68K) or defined(CPUSPARC) or defined(CPUMIPS)}
implementation
{$if defined(CPUARM) or defined(CPUM68K) or defined(CPUSPARC) or defined(CPUMIPS)}
{$define fpc_softfpu_implementation}
{$i softfpu.pp}
{$undef fpc_softfpu_implementation}
{ we get these functions and types from the softfpu code }
{$define FPC_SYSTEM_HAS_float64}
{$define FPC_SYSTEM_HAS_float32}
{$define FPC_SYSTEM_HAS_flag}
{$define FPC_SYSTEM_HAS_extractFloat64Frac0}
{$define FPC_SYSTEM_HAS_extractFloat64Frac1}
{$define FPC_SYSTEM_HAS_extractFloat64Exp}
{$define FPC_SYSTEM_HAS_extractFloat64Sign}
{$define FPC_SYSTEM_HAS_ExtractFloat32Frac}
{$define FPC_SYSTEM_HAS_extractFloat32Exp}
{$define FPC_SYSTEM_HAS_extractFloat32Sign}
{$endif defined(CPUARM) or defined(CPUM68K) or defined(CPUSPARC) or defined(CPUMIPS)}
{$I system.inc}
{$I lowmath.inc}
@ -283,323 +302,6 @@ end ['D0'];
{$I heap.inc}
{****************************************************************************
Low Level File Routines
****************************************************************************}
procedure DoDirSeparators(p:pchar);
var
i : longint;
begin
{ allow slash as backslash }
for i:=0 to strlen(p) do
if p[i] in AllowDirectorySeparators then p[i]:=DirectorySeparator;
end;
procedure do_close(h : longint);
begin
asm
movem.l d2/d3/a2/a3,-(sp)
move.l h,d0
move.w d0,-(sp)
move.w #$3e,-(sp)
trap #1
add.l #4,sp { restore stack ... }
movem.l (sp)+,d2/d3/a2/a3
end;
end;
procedure do_erase(p : pchar);
begin
DoDirSeparators(p);
asm
move.l d2,d6 { save d2 }
movem.l d3/a2/a3,-(sp) { save regs }
move.l p,-(sp)
move.w #$41,-(sp)
trap #1
add.l #6,sp
move.l d6,d2 { restore d2 }
movem.l (sp)+,d3/a2/a3
tst.w d0
beq @doserend
move.w d0,errno
@doserend:
end;
if errno <> 0 then
Error2InOut;
end;
procedure do_rename(p1,p2 : pchar);
begin
DoDirSeparators(p1);
DoDirSeparators(p2);
asm
move.l d2,d6 { save d2 }
movem.l d3/a2/a3,-(sp)
move.l p1,-(sp)
move.l p2,-(sp)
clr.w -(sp)
move.w #$56,-(sp)
trap #1
lea 12(sp),sp
move.l d6,d2 { restore d2 }
movem.l (sp)+,d3/a2/a3
tst.w d0
beq @dosreend
move.w d0,errno { error ... }
@dosreend:
end;
if errno <> 0 then
Error2InOut;
end;
function do_isdevice(handle:word):boolean;
begin
if (handle=stdoutputhandle) or (handle=stdinputhandle) or
(handle=stderrorhandle) then
do_isdevice:=FALSE
else
do_isdevice:=TRUE;
end;
function do_write(h,addr,len : longint) : longint;
begin
asm
move.l d2,d6 { save d2 }
movem.l d3/a2/a3,-(sp)
move.l addr,-(sp)
move.l len,-(sp)
move.l h,d0
move.w d0,-(sp)
move.w #$40,-(sp)
trap #1
lea 12(sp),sp
move.l d6,d2 { restore d2 }
movem.l (sp)+,d3/a2/a3
tst.l d0
bpl @doswrend
move.w d0,errno { error ... }
@doswrend:
move.l d0,@RESULT
end;
if errno <> 0 then
Error2InOut;
end;
function do_read(h,addr,len : longint) : longint;
begin
asm
move.l d2,d6 { save d2 }
movem.l d3/a2/a3,-(sp)
move.l addr,-(sp)
move.l len,-(sp)
move.l h,d0
move.w d0,-(sp)
move.w #$3f,-(sp)
trap #1
lea 12(sp),sp
move.l d6,d2 { restore d2 }
movem.l (sp)+,d3/a2/a3
tst.l d0
bpl @dosrdend
move.w d0,errno { error ... }
@dosrdend:
move.l d0,@Result
end;
if errno <> 0 then
Error2InOut;
end;
function do_filepos(handle : longint) : longint;
begin
asm
move.l d2,d6 { save d2 }
movem.l d3/a2/a3,-(sp)
move.w #1,-(sp) { seek from current position }
move.l handle,d0
move.w d0,-(sp)
move.l #0,-(sp) { with a seek offset of zero }
move.w #$42,-(sp)
trap #1
lea 10(sp),sp
move.l d6,d2 { restore d2 }
movem.l (sp)+,d3/a2/a3
move.l d0,@Result
end;
end;
procedure do_seek(handle,pos : longint);
begin
asm
move.l d2,d6 { save d2 }
movem.l d3/a2/a3,-(sp)
move.w #0,-(sp) { seek from start of file }
move.l handle,d0
move.w d0,-(sp)
move.l pos,-(sp)
move.w #$42,-(sp)
trap #1
lea 10(sp),sp
move.l d6,d2 { restore d2 }
movem.l (sp)+,d3/a2/a3
end;
end;
function do_seekend(handle:longint):longint;
var
t: longint;
begin
asm
move.l d2,d6 { save d2 }
movem.l d3/a2/a3,-(sp)
move.w #2,-(sp) { seek from end of file }
move.l handle,d0
move.w d0,-(sp)
move.l #0,-(sp) { with an offset of 0 from end }
move.w #$42,-(sp)
trap #1
lea 10(sp),sp
move.l d6,d2 { restore d2 }
movem.l (sp)+,d3/a2/a3
move.l d0,t
end;
do_seekend:=t;
end;
function do_filesize(handle : longint) : longint;
var
aktfilepos : longint;
begin
aktfilepos:=do_filepos(handle);
do_filesize:=do_seekend(handle);
do_seek(handle,aktfilepos);
end;
procedure do_truncate (handle,pos:longint);
begin
do_seek(handle,pos);
{!!!!!!!!!!!!}
end;
procedure do_open(var f;p:pchar;flags:longint);
{
filerec and textrec have both handle and mode as the first items so
they could use the same routine for opening/creating.
when (flags and $100) the file will be append
when (flags and $1000) the file will be truncate/rewritten
when (flags and $10000) there is no check for close (needed for textfiles)
}
var
i : word;
oflags: longint;
begin
DoDirSeparators(p);
{ close first if opened }
if ((flags and $10000)=0) then
begin
case filerec(f).mode of
fminput,fmoutput,fminout : Do_Close(filerec(f).handle);
fmclosed : ;
else
begin
inoutres:=102; {not assigned}
exit;
end;
end;
end;
{ reset file handle }
filerec(f).handle:=UnusedHandle;
oflags:=$02; { read/write mode }
{ convert filemode to filerec modes }
case (flags and 3) of
0 : begin
filerec(f).mode:=fminput;
oflags:=$00; { read mode only }
end;
1 : filerec(f).mode:=fmoutput;
2 : filerec(f).mode:=fminout;
end;
if (flags and $1000)<>0 then
begin
filerec(f).mode:=fmoutput;
oflags:=$04; { read/write with create }
end
else
if (flags and $100)<>0 then
begin
filerec(f).mode:=fmoutput;
oflags:=$02; { read/write }
end;
{ empty name is special }
if p[0]=#0 then
begin
case filerec(f).mode of
fminput : filerec(f).handle:=StdInputHandle;
fmappend,
fmoutput : begin
filerec(f).handle:=StdOutputHandle;
filerec(f).mode:=fmoutput; {fool fmappend}
end;
end;
exit;
end;
asm
movem.l d2/d3/a2/a3,-(sp) { save used registers }
cmp.l #4,oflags { check if rewrite mode ... }
bne @opencont2
{ rewrite mode - create new file }
move.w #0,-(sp)
move.l p,-(sp)
move.w #$3c,-(sp)
trap #1
add.l #8,sp { restore stack of os call }
bra @end
{ reset - open existing files }
@opencont2:
move.l oflags,d0 { use flag as source ... }
@opencont1:
move.w d0,-(sp)
move.l p,-(sp)
move.w #$3d,-(sp)
trap #1
add.l #8,sp { restore stack of os call }
@end:
movem.l (sp)+,d2/d3/a2/a3
tst.w d0
bpl @opennoerr { if positive return values then ok }
cmp.w #-1,d0 { if handle is -1 CON: }
beq @opennoerr
cmp.w #-2,d0 { if handle is -2 AUX: }
beq @opennoerr
cmp.w #-3,d0 { if handle is -3 PRN: }
beq @opennoerr
move.w d0,errno { otherwise normal error }
@opennoerr:
move.w d0,i { get handle as SIGNED VALUE... }
end;
if errno <> 0 then
Error2InOut;
filerec(f).handle:=i;
if ((flags and $100) <> 0) and
(FileRec (F).Handle <> UnusedHandle) then
do_seekend(filerec(f).handle);
end;
{*****************************************************************************
UnTyped File Handling
*****************************************************************************}