fpc/rtl/sinclairql/qdos.inc

{
    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_INF   = $00;
  _MT_FRJOB = $05;
  _MT_DMODE = $10;
  _MT_ALCHP = $18;
  _MT_RECHP = $19;

procedure mt_frjob(jobID: Tjobid; exitCode: longint); assembler; nostackframe; public name '_mt_frjob';
asm
  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/a2-a3
end;

function mt_inf(sys_vars: PPAnsiChar; 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)+,d0
  beq.s   @skip_vars
  move.l  d0,a1
  move.l  d2,(a1)   { ver_ascii }
@skip_vars:
  move.l  (sp)+,d0
  beq.s   @skip_ver
  move.l  d0,a1
  move.l  a0,(a1)   { sys_vars }
@skip_ver:
  move.l  (sp)+,d2
  move.l  d1,d0     { jobid }
end;

procedure mt_dmode(s_mode: pword; d_type: pword); assembler; nostackframe; public name '_mt_dmode';
asm
  movem.l d2/a3-a4,-(sp)
  move.w (a0),d1
  move.w (a1),d2
  moveq.l #_MT_DMODE,d0
  trap #1
  move.w d1,(a0)
  move.w d2,(a1)
  movem.l (sp)+,d2/a3-a4
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)
  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_OPEN = $01;
  _IO_CLOSE = $02;
  _IO_DELET = $04;

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
  tst.l d0
  bne.s @quit
  move.l a0,d0
@quit:
  movem.l (sp)+,d2-d3
end;

function io_open(name: PAnsiChar; mode: longint): Tchanid; public name '_io_open';
var
  len: longint;
  name_qlstr: array[0..63] of AnsiChar;
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;

function io_delet_qlstr(name_qlstr: pointer): longint; assembler; nostackframe; public name '_io_delet_qlstr';
asm
  movem.l d2-d3,-(sp)
  move.l name_qlstr,a0
  moveq.l #-1,d1
  moveq.l #_IO_DELET,d0
  trap #2
  tst.l d0
@quit:
  movem.l (sp)+,d2-d3
end;

function io_delet(name: PAnsiChar): Tchanid; public name '_io_delet';
var
  len: longint;
  name_qlstr: array[0..63] of AnsiChar;
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_delet_qlstr(@name_qlstr);
end;

const
  _IO_FBYTE = $01;
  _IO_FLINE = $02;
  _IO_FSTRG = $03;
  _IO_SBYTE = $05;
  _IO_SSTRG = $07;
  _SD_WDEF = $0D;
  _SD_CLEAR = $20;
  _FS_POSAB = $42;
  _FS_POSRE = $43;
  _FS_HEADR = $47;
  _FS_RENAME = $4A;
  _FS_TRUNCATE = $4B;

function io_fbyte(chan: Tchanid; timeout: Ttimeout): longint; assembler; nostackframe; public name '_io_fbyte';
asm
  move.l d3,-(sp)
  move.w timeout,d3
  clr.l d1
  move.l chan,a0
  moveq.l #_IO_FBYTE,d0
  trap #3
  tst.l d0
  bne @quit
  move.l d1,d0
@quit:
  move.l (sp)+,d3
end;

function io_fetch(chan: Tchanid; timeout: Ttimeout; buf: pointer; len: word; trap_no: longint): longint; assembler;
asm
  movem.l d2-d3,-(sp)
  move.w len,d2
  move.l buf,a1
  move.w timeout,d3
  move.l chan,a0
  move.l trap_no,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;

function io_fline(chan: Tchanid; timeout: Ttimeout; buf: pointer; len: word): longint; public name '_io_fline';
begin
  io_fline := io_fetch(chan, timeout, buf, len, _IO_FLINE);
end;

function io_fstrg(chan: Tchanid; timeout: Ttimeout; buf: pointer; len: word): longint; public name '_io_fstrg';
begin
  io_fstrg := io_fetch(chan, timeout, buf, len, _IO_FSTRG);
end;

function io_sbyte(chan: Tchanid; timeout: Ttimeout; c: AnsiChar): 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: word): longint; 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;

function sd_wdef(chan: Tchanid; timeout: Ttimeout; border_colour: byte; border_width: word; window: PQLRect): longint; assembler; public name '_sd_wdef'; 
asm
  movem.l d2-d3,-(sp)
  move.l window,a1
  move.w timeout,d3
  move.w border_width,d2
  move.b border_colour,d1
  move.l chan,a0
  moveq.l #_SD_WDEF,d0
  trap #3
  movem.l (sp)+,d2-d3
end;

function sd_clear(chan: Tchanid; timeout: Ttimeout): longint; assembler; nostackframe; public name '_sd_clear';
asm
  move.l d3,-(sp)
  move.w timeout,d3
  move.l chan,a0
  moveq.l #_SD_CLEAR,d0
  trap #3
  move.l (sp)+,d3
end;

function fs_posab(chan: Tchanid; var new_pos: longint): longint; assembler; nostackframe; public name '_fs_posab';
asm
  movem.l d3/a0,-(sp) { a0 = new_pos }
  move.l (a0),d1
  move.l chan,a0
  moveq #-1,d3
  moveq #_FS_POSAB,d0
  trap #3
  movem.l (sp)+,d3/a0
  move.l d1,(a0)
end;

function fs_posre(chan: Tchanid; var new_pos: longint): longint; assembler; nostackframe; public name '_fs_posre';
asm
  movem.l d3/a0,-(sp) { a0 = new_pos }
  move.l (a0),d1
  move.l chan,a0
  moveq #-1,d3
  moveq #_FS_POSRE,d0
  trap #3
  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';
asm
  movem.l d2-d3,-(sp)
  move.l buf,a1
  move.l chan,a0
  move.l buf_size,d2
  moveq #-1,d3
  moveq #_FS_HEADR,d0
  trap #3
  tst.l d0
  bne.s  @quit
  move.l d1,d0
@quit:
  movem.l (sp)+,d2-d3
end;

function fs_rename_qlstr(chan: Tchanid; new_name_as_qlstr: pointer): longint; assembler; nostackframe; public name '_fs_rename_qlstr';
asm
  move.l d3,-(sp)
  move.l new_name_as_qlstr,a1
  move.l chan,a0
  moveq #-1,d3
  moveq #_FS_RENAME,d0
  trap #3
  move.l (sp)+,d3
end;

function fs_rename(chan: Tchanid; new_name: PAnsiChar): longint; public name '_fs_rename';
var
  len: longint;
  new_name_qlstr: array[0..63] of AnsiChar;
begin
  len:=length(new_name);
  if len > length(new_name_qlstr)-2 then
    len:=length(new_name_qlstr)-2;

  PWord(@new_name_qlstr)[0]:=len;
  Move(new_name^,new_name_qlstr[2],len);

  fs_rename:=fs_rename_qlstr(chan,@new_name_qlstr);
end;

function fs_truncate(chan: Tchanid): longint; assembler; nostackframe; public name '_fs_truncate';
asm
  move.l d3,-(sp)
  move.l chan, a0
  moveq #-1,d3
  moveq #_FS_TRUNCATE,d0
  trap #3
  move.l (sp)+,d3
end;

const
  _UT_CON = $c6;
  _UT_SCR = $c8;

function ut_con(params: PWindowDef): 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)
  tst.l d0
  bne @quit
  move.l a0,d0
@quit:
  movem.l (sp)+,d2-d3/a2-a3
end;

function ut_scr(params: PWindowDef): 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)
  tst.l d0
  bne @quit
  move.l a0,d0
@quit:
  movem.l (sp)+,d2-d3/a2-a3
end;

const
  _MT_RCLCK = $13;

function mt_rclck: longint; assembler; nostackframe; public name '_mt_rclck';
asm
  move.l d2,-(sp)
  moveq #_MT_RCLCK,d0
  trap #1
  move.l d1,d0
  move.l (sp)+,d2
end;