mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-19 21:19:31 +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.
|
||||
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;
|
||||
|
||||
Loading…
Reference in New Issue
Block a user