From 1c0a370ce24fdfc3608ffe3fafa7198ff4158c19 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?K=C3=A1roly=20Balogh?= Date: Sat, 8 Oct 2016 12:48:23 +0000 Subject: [PATCH] atari: rewrote system file functions. no inline assembly, updated to current standards and RTL internals git-svn-id: trunk@34658 - --- rtl/atari/sysfile.inc | 440 +++++++++++++++++------------------------- 1 file changed, 177 insertions(+), 263 deletions(-) diff --git a/rtl/atari/sysfile.inc b/rtl/atari/sysfile.inc index 961bd35666..14f6541c0b 100644 --- a/rtl/atari/sysfile.inc +++ b/rtl/atari/sysfile.inc @@ -1,8 +1,8 @@ { This file is part of the Free Pascal run time library. - Copyright (c) 2005 by Free Pascal development team + Copyright (c) 2016 by Free Pascal development team - Low level file functions + Low level file functions for Atari TOS See the file COPYING.FPC, included in this distribution, for details about the copyright. @@ -13,219 +13,157 @@ **********************************************************************} -{$asmmode motorola} {**************************************************************************** - Low Level File Routines - ****************************************************************************} + Low level File Routines + All these functions can set InOutRes on errors +****************************************************************************} -procedure DoDirSeparators(p:pchar); +{ close a file from the handle value } +procedure do_close(handle : longint); var - i : longint; + dosResult: longint; begin -{ allow slash as backslash } - for i:=0 to strlen(p) do - if p[i] in AllowDirectorySeparators then p[i]:=DirectorySeparator; + dosResult:=gemdos_fclose(handle); + if dosResult < 0 then + Error2InOutRes(dosResult); end; -procedure do_close(h : longint); +procedure do_erase(p : pchar; pchangeable: boolean); +var + oldp: pchar; + dosResult: 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; + oldp:=p; + DoDirSeparators(p,pchangeable); + dosResult:=gemdos_fdelete(p); + if dosResult <0 then + Error2InOutRes(dosResult); + if oldp<>p then + FreeMem(p); end; -procedure do_erase(p : pchar); +procedure do_rename(p1,p2 : pchar; p1changeable, p2changeable: boolean); +var + oldp1, oldp2 : pchar; + dosResult: longint; 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; + oldp1:=p1; + oldp2:=p2; + DoDirSeparators(p1,p1changeable); + DoDirSeparators(p2,p2changeable); + + dosResult:=gemdos_frename(p1,p2); + if dosResult < 0 then + Error2InOutRes(dosResult); + + if oldp1<>p1 then + FreeMem(p1); + if oldp2<>p2 then + FreeMem(p2); end; -procedure do_rename(p1,p2 : pchar); +function do_write(h: longint; addr: pointer; len: longint) : longint; +var + dosResult: longint; 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; + do_write:=0; + if (len<=0) or (h=-1) then + exit; -function do_isdevice(handle:word):boolean; -begin - if (handle=stdoutputhandle) or (handle=stdinputhandle) or - (handle=stderrorhandle) then - do_isdevice:=FALSE + dosResult:=gemdos_fwrite(h, len, addr); + if dosResult < 0 then + begin + Error2InOutRes(dosResult); + end else - do_isdevice:=TRUE; + do_write:=dosResult; 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; +function do_read(h: longint; addr: pointer; len: longint) : longint; var - t: longint; + dosResult: 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; + do_read:=0; + if (len<=0) or (h=-1) then exit; + + dosResult:=gemdos_fread(h, len, addr); + if dosResult<0 then + begin + Error2InOutRes(dosResult); + end + else + do_read:=dosResult; end; -function do_filesize(handle : longint) : longint; +function do_filepos(handle: longint) : longint; var - aktfilepos : longint; + dosResult: longint; begin - aktfilepos:=do_filepos(handle); - do_filesize:=do_seekend(handle); - do_seek(handle,aktfilepos); + do_filepos:=-1; + dosResult:=gemdos_fseek(0, handle, SEEK_FROM_CURRENT); + if dosResult < 0 then + begin + Error2InOutRes(dosResult); + end + else + do_filepos:=dosResult; end; -procedure do_truncate (handle,pos:longint); +procedure do_seek(handle, pos: longint); +var + dosResult: longint; begin - do_seek(handle,pos); - {!!!!!!!!!!!!} + dosResult:=gemdos_fseek(pos, handle, SEEK_FROM_START); + if dosResult < 0 then + Error2InOutRes(dosResult); end; -procedure do_open(var f;p:pchar;flags:longint); +function do_seekend(handle: longint):longint; +var + dosResult: longint; +begin + do_seekend:=-1; + + dosResult:=gemdos_fseek(0, handle, SEEK_FROM_END); + if dosResult < 0 then + begin + Error2InOutRes(dosResult); + end + else + do_seekend:=dosResult; +end; + + +function do_filesize(handle : THandle) : longint; +var + currfilepos: longint; +begin + do_filesize:=-1; + currfilepos:=do_filepos(handle); + if currfilepos >= 0 then + begin + do_filesize:=do_seekend(handle); + end; + do_seek(handle,currfilepos); +end; + + +{ truncate at a given position } +procedure do_truncate(handle, pos: longint); +begin + { TODO: } +end; + + +procedure do_open(var f;p:pchar;flags:longint; pchangeable: boolean); { filerec and textrec have both handle and mode as the first items so they could use the same routine for opening/creating. @@ -234,102 +172,78 @@ procedure do_open(var f;p:pchar;flags:longint); when (flags and $10000) there is no check for close (needed for textfiles) } var - i : word; - oflags: longint; + oldp : pchar; + handle : longint; + dosResult: longint; begin - DoDirSeparators(p); - { close first if opened } +{ 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 : ; + fmInput, fmOutput, fmInout: + do_close(filerec(f).handle); + fmClosed: ; else - begin - inoutres:=102; {not assigned} - exit; - end; + 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 } + + { 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; + 0 : filerec(f).mode:=fmInput; + 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; + + { 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... } + filerec(f).handle:=StdOutputHandle; + filerec(f).mode:=fmOutput; {fool fmappend} + end; end; - if errno <> 0 then - begin - Error2InOut; - FileRec(f).mode:=fmclosed; - end; - filerec(f).handle:=i; - if ((flags and $100) <> 0) and - (FileRec (F).Handle <> UnusedHandle) then - do_seekend(filerec(f).handle); + exit; + end; + + oldp:=p; + DoDirSeparators(p); + + { rewrite (create a new file) } + if (flags and $1000)<>0 then + dosResult:=gemdos_fcreate(p,0) + else + dosResult:=gemdos_fopen(p,filerec(f).mode); + + if oldp<>p then + freemem(p); + + if dosResult < 0 then + Error2InOutRes(dosResult); + + { append mode } + if ((Flags and $100)<>0) and + (FileRec(F).Handle<>UnusedHandle) then begin + do_seekend(filerec(f).handle); + filerec(f).mode:=fmOutput; {fool fmappend} + end; +end; + + +function do_isdevice(handle: thandle): boolean; +begin + if (handle=StdOutputHandle) or (handle=StdInputHandle) or + (handle=StdErrorHandle) then + do_isdevice:=True + else + do_isdevice:=False; end;