sinclairql: various seeking, FS_POSAB/FS_POSRE and ERR_EF related fixes

git-svn-id: https://svn.freepascal.org/svn/fpc/trunk@49169 3ad0048d-3df7-0310-abae-a5850022a9f2

3 files changed, 38 insertions, 27 deletions

diff --git a/rtl/sinclairql/qdos.inc b/rtl/sinclairql/qdos.inc
index fafcd78d66..8d05240791 100644
--- a/rtl/sinclairql/qdos.inc
+++ b/rtl/sinclairql/qdos.inc
@@ -24,12 +24,12 @@ const
 
 procedure mt_frjob(jobID: Tjobid; exitCode: longint); assembler; nostackframe; public name '_mt_frjob';
 asm
-  movem.l d2-d3,-(sp)
+  movem.l d2-d3/a2-a3,-(sp)
   move.l  exitCode,d3
   move.l  jobID,d1
   moveq   #_MT_FRJOB,d0
   trap    #1
-  movem.l (sp)+,d2-d3
+  movem.l (sp)+,d2-d3/a2-a3
 end;
 
 function mt_inf(sys_vars: ppchar; ver_ascii: plongint): Tjobid; assembler; nostackframe; public name '_mt_inf';
@@ -287,35 +287,28 @@ asm
   move.l (sp)+,d3
 end;
 
-
-function fs_posab(chan: Tchanid; new_pos: dword): longint; assembler; nostackframe; public name '_fs_posab';
+function fs_posab(chan: Tchanid; var new_pos: longint): longint; assembler; nostackframe; public name '_fs_posab';
 asm
-  move.l d3,-(sp)
+  movem.l d3/a0,-(sp) { a0 = new_pos }
+  move.l (a0),d1
   move.l chan,a0
-  move.l new_pos,d1
   moveq #-1,d3
   moveq #_FS_POSAB,d0
   trap #3
-  tst.l d0
-  bne.s  @quit
-  move.l d1,d0
-@quit:
-  move.l (sp)+,d3
+  movem.l (sp)+,d3/a0
+  move.l d1,(a0)
 end;
 
-function fs_posre(chan: Tchanid; new_pos: dword): longint; assembler; nostackframe; public name '_fs_posre';
+function fs_posre(chan: Tchanid; var new_pos: longint): longint; assembler; nostackframe; public name '_fs_posre';
 asm
-  move.l d3,-(sp)
+  movem.l d3/a0,-(sp) { a0 = new_pos }
+  move.l (a0),d1
   move.l chan,a0
-  move.l new_pos,d1
   moveq #-1,d3
   moveq #_FS_POSRE,d0
   trap #3
-  tst.l d0
-  bne.s  @quit
-  move.l d1,d0
-@quit:
-  move.l (sp)+,d3
+  movem.l (sp)+,d3/a0
+  move.l d1,(a0)
 end;
 
 function fs_headr(chan: Tchanid; buf: pointer; buf_size: word): longint; assembler; nostackframe; public name '_fs_headr';
diff --git a/rtl/sinclairql/qdosfuncs.inc b/rtl/sinclairql/qdosfuncs.inc
index 81b46dd7e3..d6840b3a08 100644
--- a/rtl/sinclairql/qdosfuncs.inc
+++ b/rtl/sinclairql/qdosfuncs.inc
@@ -34,8 +34,8 @@ function io_fstrg(chan: Tchanid; timeout: Ttimeout; buf: pointer; len: word): lo
 function io_sbyte(chan: Tchanid; timeout: Ttimeout; c: char): longint; external name '_io_sbyte';
 function io_sstrg(chan: Tchanid; timeout: Ttimeout; buf: pointer; len: word): longint; external name '_io_sstrg';
 
-function fs_posab(chan: Tchanid; new_pos: dword): longint; external name '_fs_posab';
-function fs_posre(chan: Tchanid; new_pos: dword): longint; external name '_fs_posre';
+function fs_posab(chan: Tchanid; var new_pos: longint): longint; external name '_fs_posab';
+function fs_posre(chan: Tchanid; var new_pos: longint): longint; external name '_fs_posre';
 function fs_headr(chan: Tchanid; buf: pointer; buf_size: word): longint; external name '_fs_headr';
 function fs_truncate(chan: Tchanid): longint; external name '_fs_truncate';
 
diff --git a/rtl/sinclairql/sysfile.inc b/rtl/sinclairql/sysfile.inc
index 1b87cac0ca..ecaf72c3f6 100644
--- a/rtl/sinclairql/sysfile.inc
+++ b/rtl/sinclairql/sysfile.inc
@@ -56,6 +56,8 @@ var
 begin
   do_read := 0;
   res := io_fline(h, -1, addr, len);
+  if res = ERR_EF then
+    res := 0;
   if res < 0 then
     Error2InOutRes(res)
   else
@@ -66,13 +68,17 @@ end;
 function do_filepos(handle: longint): longint;
 var
   res: longint;
+  pos: longint;
 begin
   do_filepos := 0;
-  res := fs_posre(handle, 0);
-  if (res < 0) and (res <> ERR_EF) then
+  pos := 0;
+  res := fs_posre(handle, pos);
+  if res = ERR_EF then
+    res := 0;
+  if (res < 0) then
     Error2InOutRes(res)
   else
-    do_filepos := res;
+    do_filepos := pos;
 end;
 
 
@@ -81,7 +87,9 @@ var
   res: longint;
 begin
   res := fs_posab(handle, pos);
-  if (res < 0) and (res <> ERR_EF) then
+  if res = ERR_EF then
+    res := 0;
+  if (res < 0) then
     Error2InOutRes(res);
 end;
 
@@ -93,9 +101,19 @@ const
   MAX_QL_FILE_LENGTH = $7FFFFFBF;
 
 function do_seekend(handle: longint): longint;
+var
+  res: longint;
+  pos: longint;
 begin
-  do_seek(handle, MAX_QL_FILE_LENGTH);
-  do_seekend := do_filepos(handle);
+  do_seekend:=-1;
+  pos:=MAX_QL_FILE_LENGTH;
+  res:=fs_posab(handle, pos);
+  if res = ERR_EF then
+    res := 0;
+  if res < 0 then
+    Error2InOutRes(res)
+  else
+    do_seekend := pos;
 end;