mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-09-07 15:10:40 +02:00
atari: rewrote system file functions. no inline assembly, updated to current standards and RTL internals
git-svn-id: trunk@34658 -
This commit is contained in:
Károly Balogh
parent
8166002c8a
commit
1c0a370ce2
@ -1,8 +1,8 @@
|
|||||||
{
|
{
|
||||||
This file is part of the Free Pascal run time library.
|
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,
|
See the file COPYING.FPC, included in this distribution,
|
||||||
for details about the copyright.
|
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
|
var
|
||||||
i : longint;
|
dosResult: longint;
|
||||||
begin
|
begin
|
||||||
{ allow slash as backslash }
|
dosResult:=gemdos_fclose(handle);
|
||||||
for i:=0 to strlen(p) do
|
if dosResult < 0 then
|
||||||
if p[i] in AllowDirectorySeparators then p[i]:=DirectorySeparator;
|
Error2InOutRes(dosResult);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
procedure do_close(h : longint);
|
procedure do_erase(p : pchar; pchangeable: boolean);
|
||||||
|
var
|
||||||
|
oldp: pchar;
|
||||||
|
dosResult: longint;
|
||||||
begin
|
begin
|
||||||
asm
|
oldp:=p;
|
||||||
movem.l d2/d3/a2/a3,-(sp)
|
DoDirSeparators(p,pchangeable);
|
||||||
move.l h,d0
|
dosResult:=gemdos_fdelete(p);
|
||||||
move.w d0,-(sp)
|
if dosResult <0 then
|
||||||
move.w #$3e,-(sp)
|
Error2InOutRes(dosResult);
|
||||||
trap #1
|
if oldp<>p then
|
||||||
add.l #4,sp { restore stack ... }
|
FreeMem(p);
|
||||||
movem.l (sp)+,d2/d3/a2/a3
|
|
||||||
end;
|
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
procedure do_erase(p : pchar);
|
procedure do_rename(p1,p2 : pchar; p1changeable, p2changeable: boolean);
|
||||||
|
var
|
||||||
|
oldp1, oldp2 : pchar;
|
||||||
|
dosResult: longint;
|
||||||
begin
|
begin
|
||||||
DoDirSeparators(p);
|
oldp1:=p1;
|
||||||
asm
|
oldp2:=p2;
|
||||||
move.l d2,d6 { save d2 }
|
DoDirSeparators(p1,p1changeable);
|
||||||
movem.l d3/a2/a3,-(sp) { save regs }
|
DoDirSeparators(p2,p2changeable);
|
||||||
move.l p,-(sp)
|
|
||||||
move.w #$41,-(sp)
|
dosResult:=gemdos_frename(p1,p2);
|
||||||
trap #1
|
if dosResult < 0 then
|
||||||
add.l #6,sp
|
Error2InOutRes(dosResult);
|
||||||
move.l d6,d2 { restore d2 }
|
|
||||||
movem.l (sp)+,d3/a2/a3
|
if oldp1<>p1 then
|
||||||
tst.w d0
|
FreeMem(p1);
|
||||||
beq @doserend
|
if oldp2<>p2 then
|
||||||
move.w d0,errno
|
FreeMem(p2);
|
||||||
@doserend:
|
|
||||||
end;
|
|
||||||
if errno <> 0 then
|
|
||||||
Error2InOut;
|
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
procedure do_rename(p1,p2 : pchar);
|
function do_write(h: longint; addr: pointer; len: longint) : longint;
|
||||||
|
var
|
||||||
|
dosResult: longint;
|
||||||
begin
|
begin
|
||||||
DoDirSeparators(p1);
|
do_write:=0;
|
||||||
DoDirSeparators(p2);
|
if (len<=0) or (h=-1) then
|
||||||
asm
|
exit;
|
||||||
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;
|
dosResult:=gemdos_fwrite(h, len, addr);
|
||||||
begin
|
if dosResult < 0 then
|
||||||
if (handle=stdoutputhandle) or (handle=stdinputhandle) or
|
begin
|
||||||
(handle=stderrorhandle) then
|
Error2InOutRes(dosResult);
|
||||||
do_isdevice:=FALSE
|
end
|
||||||
else
|
else
|
||||||
do_isdevice:=TRUE;
|
do_write:=dosResult;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
function do_write(h,addr,len : longint) : longint;
|
function do_read(h: longint; addr: pointer; 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
|
var
|
||||||
t: longint;
|
dosResult: longint;
|
||||||
begin
|
begin
|
||||||
asm
|
do_read:=0;
|
||||||
move.l d2,d6 { save d2 }
|
if (len<=0) or (h=-1) then exit;
|
||||||
movem.l d3/a2/a3,-(sp)
|
|
||||||
move.w #2,-(sp) { seek from end of file }
|
dosResult:=gemdos_fread(h, len, addr);
|
||||||
move.l handle,d0
|
if dosResult<0 then
|
||||||
move.w d0,-(sp)
|
begin
|
||||||
move.l #0,-(sp) { with an offset of 0 from end }
|
Error2InOutRes(dosResult);
|
||||||
move.w #$42,-(sp)
|
end
|
||||||
trap #1
|
else
|
||||||
lea 10(sp),sp
|
do_read:=dosResult;
|
||||||
move.l d6,d2 { restore d2 }
|
|
||||||
movem.l (sp)+,d3/a2/a3
|
|
||||||
move.l d0,t
|
|
||||||
end;
|
|
||||||
do_seekend:=t;
|
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
function do_filesize(handle : longint) : longint;
|
function do_filepos(handle: longint) : longint;
|
||||||
var
|
var
|
||||||
aktfilepos : longint;
|
dosResult: longint;
|
||||||
begin
|
begin
|
||||||
aktfilepos:=do_filepos(handle);
|
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_seek(handle, pos: longint);
|
||||||
|
var
|
||||||
|
dosResult: longint;
|
||||||
|
begin
|
||||||
|
dosResult:=gemdos_fseek(pos, handle, SEEK_FROM_START);
|
||||||
|
if dosResult < 0 then
|
||||||
|
Error2InOutRes(dosResult);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
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);
|
do_filesize:=do_seekend(handle);
|
||||||
do_seek(handle,aktfilepos);
|
end;
|
||||||
|
do_seek(handle,currfilepos);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
procedure do_truncate (handle,pos:longint);
|
{ truncate at a given position }
|
||||||
|
procedure do_truncate(handle, pos: longint);
|
||||||
begin
|
begin
|
||||||
do_seek(handle,pos);
|
{ TODO: }
|
||||||
{!!!!!!!!!!!!}
|
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
procedure do_open(var f;p:pchar;flags:longint);
|
procedure do_open(var f;p:pchar;flags:longint; pchangeable: boolean);
|
||||||
{
|
{
|
||||||
filerec and textrec have both handle and mode as the first items so
|
filerec and textrec have both handle and mode as the first items so
|
||||||
they could use the same routine for opening/creating.
|
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)
|
when (flags and $10000) there is no check for close (needed for textfiles)
|
||||||
}
|
}
|
||||||
var
|
var
|
||||||
i : word;
|
oldp : pchar;
|
||||||
oflags: longint;
|
handle : longint;
|
||||||
|
dosResult: longint;
|
||||||
begin
|
begin
|
||||||
DoDirSeparators(p);
|
{ close first if opened }
|
||||||
{ close first if opened }
|
|
||||||
if ((flags and $10000)=0) then
|
if ((flags and $10000)=0) then
|
||||||
begin
|
begin
|
||||||
case filerec(f).mode of
|
case filerec(f).mode of
|
||||||
fminput,fmoutput,fminout : Do_Close(filerec(f).handle);
|
fmInput, fmOutput, fmInout:
|
||||||
fmclosed : ;
|
do_close(filerec(f).handle);
|
||||||
|
fmClosed: ;
|
||||||
else
|
else
|
||||||
begin
|
begin
|
||||||
inoutres:=102; {not assigned}
|
InOutRes:=102; {not assigned}
|
||||||
exit;
|
exit;
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
{ reset file handle }
|
{ reset file handle }
|
||||||
filerec(f).handle:=UnusedHandle;
|
filerec(f).handle:=UnusedHandle;
|
||||||
oflags:=$02; { read/write mode }
|
|
||||||
{ convert filemode to filerec modes }
|
{ convert filemode to filerec modes }
|
||||||
case (flags and 3) of
|
case (flags and 3) of
|
||||||
0 : begin
|
0 : filerec(f).mode:=fmInput;
|
||||||
filerec(f).mode:=fminput;
|
1 : filerec(f).mode:=fmOutput;
|
||||||
oflags:=$00; { read mode only }
|
2 : filerec(f).mode:=fmInout;
|
||||||
end;
|
end;
|
||||||
1 : filerec(f).mode:=fmoutput;
|
|
||||||
2 : filerec(f).mode:=fminout;
|
{ empty name is special }
|
||||||
end;
|
if p[0]=#0 then begin
|
||||||
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
|
case filerec(f).mode of
|
||||||
fminput : filerec(f).handle:=StdInputHandle;
|
fminput :
|
||||||
|
filerec(f).handle:=StdInputHandle;
|
||||||
fmappend,
|
fmappend,
|
||||||
fmoutput : begin
|
fmoutput : begin
|
||||||
filerec(f).handle:=StdOutputHandle;
|
filerec(f).handle:=StdOutputHandle;
|
||||||
filerec(f).mode:=fmoutput; {fool fmappend}
|
filerec(f).mode:=fmOutput; {fool fmappend}
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
exit;
|
exit;
|
||||||
end;
|
end;
|
||||||
asm
|
|
||||||
movem.l d2/d3/a2/a3,-(sp) { save used registers }
|
|
||||||
|
|
||||||
cmp.l #4,oflags { check if rewrite mode ... }
|
oldp:=p;
|
||||||
bne @opencont2
|
DoDirSeparators(p);
|
||||||
{ 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
|
{ rewrite (create a new file) }
|
||||||
bpl @opennoerr { if positive return values then ok }
|
if (flags and $1000)<>0 then
|
||||||
cmp.w #-1,d0 { if handle is -1 CON: }
|
dosResult:=gemdos_fcreate(p,0)
|
||||||
beq @opennoerr
|
else
|
||||||
cmp.w #-2,d0 { if handle is -2 AUX: }
|
dosResult:=gemdos_fopen(p,filerec(f).mode);
|
||||||
beq @opennoerr
|
|
||||||
cmp.w #-3,d0 { if handle is -3 PRN: }
|
if oldp<>p then
|
||||||
beq @opennoerr
|
freemem(p);
|
||||||
move.w d0,errno { otherwise normal error }
|
|
||||||
@opennoerr:
|
if dosResult < 0 then
|
||||||
move.w d0,i { get handle as SIGNED VALUE... }
|
Error2InOutRes(dosResult);
|
||||||
end;
|
|
||||||
if errno <> 0 then
|
{ append mode }
|
||||||
begin
|
if ((Flags and $100)<>0) and
|
||||||
Error2InOut;
|
(FileRec(F).Handle<>UnusedHandle) then begin
|
||||||
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);
|
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;
|
end;
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user