sinclairql: add a few more QDOS function wrappers which are useful at early stage

git-svn-id: trunk@47420 -

rtl/sinclairql/qdos.inc

@@ -16,9 +16,25 @@
 {$i qdosh.inc}
 
 const
+  _MT_INF   = $00;
   _MT_ALCHP = $18;
   _MT_RECHP = $19;
 
+function mt_inf(sys_vars: ppchar; ver_ascii: plongint): Tjobid; assembler; nostackframe; public name '_mt_inf';
+asm
+  move.l  d2,-(sp)
+  move.l  sys_vars,-(sp)
+  move.l  ver_ascii,-(sp)
+  moveq.l #_MT_INF,d0
+  trap #1
+  move.l  (sp)+,a1
+  move.l  d2,(a1)   { ver_ascii }
+  move.l  (sp)+,a1
+  move.l  a0,(a1)   { sys_vars }
+  move.l  (sp)+,d2
+  move.l  d1,d0     { jobid }
+end;
+
 function mt_alchp(size: dword; sizegot: pdword; jobid: Tjobid): pointer; assembler; nostackframe; public name '_mt_alchp';
 asm
   movem.l d2-d3/a2-a3,-(sp)
@@ -49,6 +65,47 @@ asm
 end;
 
 
+const
+  _IO_OPEN = $01;
+  _IO_CLOSE = $02;
+
+function io_open_qlstr(name_qlstr: pointer; mode: longint): Tchanid; assembler; nostackframe; public name '_io_open_qlstr';
+asm
+  movem.l d2-d3,-(sp)
+  move.l name_qlstr,a0
+  moveq.l #-1,d1
+  move.l mode,d3
+  moveq.l #_IO_OPEN,d0
+  trap #2
+  bne @quit
+  move.l a0,d0
+@quit:
+  movem.l (sp)+,d2-d3
+end;
+
+function io_open(name: pchar; mode: longint): Tchanid; public name '_io_open';
+var
+  len: longint;
+  name_qlstr: array[0..63] of char;
+begin
+  len:=length(name);
+  if len > length(name_qlstr)-2 then
+    len:=length(name_qlstr)-2;
+
+  PWord(@name_qlstr)[0]:=len;
+  Move(name^,name_qlstr[2],len);
+
+  result:=io_open_qlstr(@name_qlstr,mode);
+end;
+
+function io_close(chan: Tchanid): longint; assembler; nostackframe; public name '_io_close';
+asm
+  move.l chan,a0
+  moveq.l #_IO_CLOSE,d0
+  trap #2
+end;
+
+
 const
   _IO_SBYTE = $05;
   _IO_SSTRG = $07;
@@ -89,3 +146,32 @@ asm
 @quit:
   movem.l (sp)+,d2-d3
 end;
+
+
+const
+  _UT_CON = $c6;
+  _UT_SCR = $c8;
+
+function ut_con(params: PConScrParams): Tchanid; assembler; nostackframe; public name '_ut_con';
+asm
+  movem.l d2-d3/a2-a3,-(sp)
+  move.l params,a1
+  move.w _UT_CON,a2
+  jsr (a2)
+  bne @quit
+  move.l a0,d0
+@quit:
+  movem.l (sp)+,d2-d3/a2-a3
+end;
+
+function ut_scr(params: PConScrParams): Tchanid; assembler; nostackframe; public name '_ut_scr';
+asm
+  movem.l d2-d3/a2-a3,-(sp)
+  move.l params,a1
+  move.w _UT_SCR,a2
+  jsr (a2)
+  bne @quit
+  move.l a0,d0
+@quit:
+  movem.l (sp)+,d2-d3/a2-a3
+end;

rtl/sinclairql/qdosfuncs.inc

@@ -15,8 +15,17 @@
 
 {$i qdosh.inc}
 
+function mt_inf(sys_vars: ppchar; ver_ascii: plongint): Tjobid; external name '_mt_inf';
+
 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_open_qlstr(name_qlstr: pointer; mode: longint): Tchanid; external name '_io_open_qlstr';
+function io_open(name: pchar; mode: longint): Tchanid; external name '_io_open';
+function io_close(chan: Tchanid): longint; external name '_io_close';
+
 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';
+
+function ut_con(params: PConScrParams): Tchanid; external name '_ut_con';
+function ut_scr(params: PConScrParams): Tchanid; external name '_ut_scr';

rtl/sinclairql/qdosh.inc

@@ -39,5 +39,24 @@ const
   ERR_EX = -17;  { Expression error. }
   ERR_OV = -18;  { Arithmetic overflow. }
   ERR_NI = -19;  { Not implemented. }
-  ERR_RO = -20;	 { Read only. }
+  ERR_RO = -20;  { Read only. }
   ERR_BL = -21;  { Bad line of Basic. }
+
+const
+  Q_OPEN = 0;
+  Q_OPEN_IN = 1;
+  Q_OPEN_NEW = 2;
+  Q_OPEN_OVER = 3;  { Not available on microdrives. }
+  Q_OPEN_DIR = 4;
+
+
+type
+  TConScrParams = record
+    bordercolor:  byte;
+    bordersize:   byte;
+    papercolor:   byte;
+    inkcolor:     byte;
+    width,height: word;
+    x,y:          word;
+  end;
+  PConScrParams = ^TConScrParams;