So, having been dragged off kicking and screaming, to take next door's dog (Dexter the beagle) for a long walk yesterday (my wife thinks exercise is important!) I managed to get back to messing about in Free Pascal again.
My test fix of adding the Erase Pascal function to the QL version of Free Pascal worked! The test program is this:
Code: Select all
{ Program to demonstrate the Erase function. }
Var F : Text;
begin
Writeln('The file, "ram1_test.txt" will be deleted.');
Assign(F, 'ram1_test.txt');
Erase(F);
end.
- Defaults are ignored - datad$ and progd$ are not used;
- The full filename has to be given in the Assign() function.
- It actually works!
- Testing shows that we get a runtime error 103 when attempting to call rewrite() or writeln() on the test file. I guess I better look there next!
Code: Select all
Index: qdos.inc
===================================================================
--- qdos.inc (revision 48994)
+++ qdos.inc (working copy)
@@ -98,6 +98,7 @@
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,7 +137,34 @@
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;
_IO_FLINE = $02;
Index: qdosfuncs.inc
===================================================================
--- qdosfuncs.inc (revision 48994)
+++ qdosfuncs.inc (working copy)
@@ -32,6 +32,7 @@
function io_fstrg(chan: Tchanid; timeout: Ttimeout; buf: pointer; len: word): longint; external name '_io_fstrg';
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 io_delet(name: pchar): longint; external name '_io_delet';
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';
Index: sysfile.inc
===================================================================
--- sysfile.inc (revision 48994)
+++ sysfile.inc (working copy)
@@ -25,9 +25,10 @@
Error2InOutRes(io_close(handle));
end;
-
+{ delete a file, given its name }
procedure do_erase(p : pchar; pchangeable: boolean);
begin
+ Error2InOutRes(io_delet(p));
end;
Norm.