sinclairql: implemented some OS trap wrappers, to be used by the RTL

git-svn-id: trunk@47348 -

.gitattributes

@@ -11902,6 +11902,9 @@ rtl/riscv64/strings.inc svneol=native#text/plain
 rtl/riscv64/stringss.inc svneol=native#text/plain
 rtl/sinclairql/Makefile.fpc svneol=native#text/plain
 rtl/sinclairql/buildrtl.pp svneol=native#text/plain
+rtl/sinclairql/qdos.inc svneol=native#text/plain
+rtl/sinclairql/qdosfuncs.inc svneol=native#text/plain
+rtl/sinclairql/qdosh.inc svneol=native#text/plain
 rtl/sinclairql/rtl.cfg svneol=native#text/plain
 rtl/sinclairql/rtldefs.inc svneol=native#text/plain
 rtl/sinclairql/si_prc.pp svneol=native#text/plain

rtl/sinclairql/qdos.inc

@@ -0,0 +1,91 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2020 by Karoly Balogh
+
+    Interface QDOS OS functions used by the Sinclair QL RTL
+
+    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.
+
+ **********************************************************************}
+
+{$i qdosh.inc}
+
+const
+  _MT_ALCHP = $18;
+  _MT_RECHP = $19;
+
+function mt_alchp(size: dword; sizegot: pdword; jobid: Tjobid): pointer; assembler; nostackframe; public name '_mt_alchp';
+asm
+  movem.l d2-d3/a2-a3,-(sp)
+  move.l sizegot,-(sp)
+  move.l jobid,d2
+  move.l size,d1
+  moveq.l #_MT_ALCHP,d0
+  trap #1
+  move.l (sp)+,d2 // sizegot ptr
+  tst d0
+  bne @quit
+  move.l d2,a1
+  beq @nosizegot
+  move.l d1,(a1)
+@nosizegot:
+  move.l a0,d0
+@quit:
+  movem.l (sp)+,d2-d3/a2-a3
+end;
+
+procedure mt_rechp(area: pointer); assembler; nostackframe; public name '_mt_rechp';
+asm
+  movem.l d2-d3/a2-a3,-(sp)
+  move.l area,a0
+  moveq.l #_MT_RECHP,d0
+  trap #1
+  movem.l (sp)+,d2-d3/a2-a3
+end;
+
+
+const
+  _IO_SBYTE = $05;
+  _IO_SSTRG = $07;
+
+function io_sbyte(chan: Tchanid; timeout: Ttimeout; c: char): longint; assembler; public name '_io_sbyte';
+asm
+  move.l d3,-(sp)
+  move.w timeout,d3
+  clr.l d1
+  move.b c,d1
+  move.l chan,a0
+  moveq.l #_IO_SBYTE,d0
+  trap #3
+  move.l (sp)+,d3
+end;
+
+function io_sstrg(chan: Tchanid; timeout: Ttimeout; buf: pointer; len: smallint): smallint; assembler; public name '_io_sstrg';
+asm
+  movem.l d2-d3,-(sp)
+  move.w len,d2
+  move.l buf,a1
+  move.w timeout,d3
+  move.l chan,a0
+  moveq.l #_IO_SSTRG,d0
+  trap #3
+  tst.l d0
+  beq @ok
+  cmp.w	#ERR_EF,d0
+  beq @eof
+  cmp.w #ERR_NC,d0
+  bne @quit
+@eof:
+  tst.w d1
+  beq @quit
+@ok:
+  clr.l d0
+  move.w d1,d0
+@quit:
+  movem.l (sp)+,d2-d3
+end;

rtl/sinclairql/qdosfuncs.inc

@@ -0,0 +1,22 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2020 by Karoly Balogh
+
+    Headers to QDOS OS functions used by the Sinclair QL RTL
+
+    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.
+
+ **********************************************************************}
+
+{$i qdosh.inc}
+
+function mt_alchp(size: dword; sizegot: pdword; jobid: Tjobid): pointer; external name '_mt_alchp';
+procedure mt_rechp(area: pointer); external name '_mt_rechp';
+
+function io_sbyte(chan: Tchanid; timeout: Ttimeout; c: char): longint; external name '_io_sbyte';
+function io_sstrg(chan: Tchanid; timeout: Ttimeout; buf: pointer; len: smallint): smallint; external name '_io_sstrg';

rtl/sinclairql/qdosh.inc

@@ -0,0 +1,43 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2020 by Karoly Balogh
+
+    Types and Constants used by QDOS OS functions in the Sinclair QL RTL
+
+    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.
+
+ **********************************************************************}
+
+type
+  Tchanid = longint;
+  Tjobid = longint;
+  Ttimeout = smallint;
+
+
+const
+  ERR_NC = -1;   { Operation not complete }
+  ERR_NJ = -2;   { Not a (valid) job. }
+  ERR_OM = -3;   { Out of memory. }
+  ERR_OR = -4;   { Out of range. }
+  ERR_BO = -5;   { Buffer overflow. }
+  ERR_NO = -6;   { Channel not open. }
+  ERR_NF = -7;   { File or device not found. }
+  ERR_FX = -8;   { File already exists. }
+  ERR_IU = -9;   { File or device already in use. }
+  ERR_EF = -10;  { End of file. }
+  ERR_DF = -11;  { Drive full. }
+  ERR_BN = -12;  { Bad device. }
+  ERR_TE = -13;  { Transmission error. }
+  ERR_FF = -14;  { Format failed. }
+  ERR_BP = -15;  { Bad parameter. }
+  ERR_FE = -16;  { File error. }
+  ERR_EX = -17;  { Expression error. }
+  ERR_OV = -18;  { Arithmetic overflow. }
+  ERR_NI = -19;  { Not implemented. }
+  ERR_RO = -20;	 { Read only. }
+  ERR_BL = -21;  { Bad line of Basic. }