paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-09 08:30:54 +02:00
Code Issues Packages Projects Releases Wiki Activity

sinclairql: implemented io_delet and mt_rclck QDOS functions, patch by Norman Dunbar

Browse Source 
git-svn-id: trunk@49148 -
This commit is contained in:
Károly Balogh 2021-04-09 04:24:06 +00:00
parent d480192477
commit e7681dfe5b
2 changed files with 42 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

39
rtl/sinclairql/qdos.inc
View File

@ -98,6 +98,7 @@ 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
@ -136,6 +137,32 @@ asm
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: pchar): Tchanid; public name '_io_delet';
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_delet_qlstr(@name_qlstr);
end;
const
_IO_FBYTE = $01;
@ -346,3 +373,15 @@ asm
@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;

3
rtl/sinclairql/qdosfuncs.inc
View File

@ -26,6 +26,7 @@ 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_delet(name: pchar): longint; external name '_io_delet';
function io_fbyte(chan: Tchanid; timeout: Ttimeout): longint; external name '_io_fbyte';
function io_fline(chan: Tchanid; timeout: Ttimeout; buf: pointer; len: word): longint; external name '_io_fline';
@ -43,3 +44,5 @@ function sd_clear(chan: Tchanid; timeout: Ttimeout): longint; external name '_sd
function ut_con(params: PWindowDef): Tchanid; external name '_ut_con';
function ut_scr(params: PWindowDef): Tchanid; external name '_ut_scr';
function mt_rclck: longint; external name '_mt_rclck';