QL / PASCAL

Anything QL Software or Programming Related.
User avatar
NormanDunbar
Forum Moderator
Posts: 2251
Joined: Tue Dec 14, 2010 9:04 am
Location: Leeds, West Yorkshire, UK
Contact:

Re: QL / PASCAL

Post by NormanDunbar »

Yippee! :D

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.
I have found that:
  • 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!
My code isn't available yet, but here's an svn diff:

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;
Cheers,
Norm.


Why do they put lightning conductors on churches?
Author of Arduino Software Internals
Author of Arduino Interrupts

No longer on Twitter, find me on https://mastodon.scot/@NormanDunbar.
User avatar
mk79
QL Wafer Drive
Posts: 1349
Joined: Sun Feb 02, 2014 10:54 am
Location: Esslingen/Germany
Contact:

Re: QL / PASCAL

Post by mk79 »

NormanDunbar wrote:[*] Defaults are ignored - datad$ and progd$ are not used;
If you think about it, the defaults were introduced in TK2. TK2 extends the basic commands, but cannot change Trap #2 in ROM. Sooooo...
[*] 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!
After the delete? 103 is "file not open".

Anyway, thanks for playing! Don't stop until the QL can host the compiler :-P

Cheers, Marcel


User avatar
NormanDunbar
Forum Moderator
Posts: 2251
Joined: Tue Dec 14, 2010 9:04 am
Location: Leeds, West Yorkshire, UK
Contact:

Re: QL / PASCAL

Post by NormanDunbar »

Morning Marcel,

Aye laddie! ;)

I knew about the defaults being introduced in TK2 originally, but I was reporting my observations found during testing. I probably typed/phrased it badly, as I usually do.

The 103 error came at the rewrite() call in this code:

Code: Select all

{ Program to demonstrate the Erase function. }

Var F : Text;

begin
  Assign(F, 'test.txt');
  Rewrite(F);
  Writeln('The file, "test.txt" will be deleted.');
  Writeln(F, 'Try and find this when I''m finished !');
  Close(F);
  Erase(F);
end.
I've got some more info from Chain-Q on the FPC mailing list on the matter, so I've got a (slightly) better idea of where to look. It appears to be as simple as just implementing all the do_XXXX functions/procedures in the system.pp file. We shall see.

I assume that once all that is sorted and tested, the cross compiler can compile itself and thus be hosted on the QL. That should be fun!

Cheers,
Norm.


Why do they put lightning conductors on churches?
Author of Arduino Software Internals
Author of Arduino Interrupts

No longer on Twitter, find me on https://mastodon.scot/@NormanDunbar.
User avatar
NormanDunbar
Forum Moderator
Posts: 2251
Joined: Tue Dec 14, 2010 9:04 am
Location: Leeds, West Yorkshire, UK
Contact:

Re: QL / PASCAL

Post by NormanDunbar »

Fixed error 103!

The existing code in "sysfile.inc" in the function "do_open()" has this comment:

Code: Select all

  { rewrite (create a new file) }
  { FIX ME: this will just create a new file, actual overwriting
    seems to be a more complex endeavor... }
  if (flags and $1000)<>0 then openMode:=Q_OPEN_NEW;
I changed it to Q_OPEN_OVER as that will truncate an existing file and start writing from the beginning, or will create a new file if none exists. My test code now works fine. I've got no idea what will happen if anyone tries writing to an MDV device though! ;)

I feel the need to get some more complicated examples tested now.

Cheers,
Norm.


Why do they put lightning conductors on churches?
Author of Arduino Software Internals
Author of Arduino Interrupts

No longer on Twitter, find me on https://mastodon.scot/@NormanDunbar.
User avatar
NormanDunbar
Forum Moderator
Posts: 2251
Joined: Tue Dec 14, 2010 9:04 am
Location: Leeds, West Yorkshire, UK
Contact:

Re: QL / PASCAL

Post by NormanDunbar »

Another Pascal distraction form what I should be doing!

The "Randomize" function now works. It originally just set the "randseed" to 0 and issued a warning message that randomisation was not initialised. I've fixed it to call MT_RCLCK to get the date/time in seconds, and to use that as the "randseed". Now programs calling "Randomize" and "Random" do generate random numbers which are different each time it runs.

Changes are in the attached "patch compatible" patch file. Created in <SOURCEDIRECTORY>/rtl/sinclairql using "svn diff --patch-compatible", if anyone wants to play.

So far I've done:
  • Fixed MAXPATH to 41 characters from 255.
  • Implemented "do_erase()" to delete files on disc using the Pascal "Erase" function.
  • Fixed runtime error 103 in "rewrite(F)" when the file F existed.
  • Implemented a working "Randomize" procedure to correctly set the "randseed" variable.
FPC.patch.zip
Patch file for the SinclairQL RTL in Free Pascal.
(1.33 KiB) Downloaded 66 times
Cheers,
Norm.


Why do they put lightning conductors on churches?
Author of Arduino Software Internals
Author of Arduino Interrupts

No longer on Twitter, find me on https://mastodon.scot/@NormanDunbar.
User avatar
NormanDunbar
Forum Moderator
Posts: 2251
Joined: Tue Dec 14, 2010 9:04 am
Location: Leeds, West Yorkshire, UK
Contact:

Re: QL / PASCAL

Post by NormanDunbar »

More Pascal distractions!
  • "Error2InOutRes()" implemented. Now passes QDOS errors back to Pascal. I've had to manipulate the error codes from DOS to Pascal expected ones, and there's a good bit of leeway been taken advantage of!
  • "do_mkdir()" implemented. Can now create directories.
  • "do_rmdir()" implemented. Mostly working, I have a couple of foibles to work out before it's complete.
  • "do_rename()" implemented. In this, and "do_rmdir()" I think there's a problem in the existing "io_open()" code. See below.
As mentioned above, there's a bit of weirdness. If I call the "io_open()" function with a filename that doesn't exists, and an OPEN or OPEN_IN open mode, the file is always created if it doesn't exist. It shouldn't be. That's my next distractions! :D

The patch file attached is a fully up to date one to be run against the files in "rtl/sinclairql" -- if anyone is interested in keeping up to date.
FPC.patch.2.txt.zip
(2.5 KiB) Downloaded 62 times
Cheers,
Norm.


Why do they put lightning conductors on churches?
Author of Arduino Software Internals
Author of Arduino Interrupts

No longer on Twitter, find me on https://mastodon.scot/@NormanDunbar.
User avatar
NormanDunbar
Forum Moderator
Posts: 2251
Joined: Tue Dec 14, 2010 9:04 am
Location: Leeds, West Yorkshire, UK
Contact:

Re: QL / PASCAL

Post by NormanDunbar »

Interesting "bug" in the QL implementation of Free Pascal. Take a look at this code and tell me what you think is wrong. This was the code which calls the QDOSMSQ trap calls to set an absolute file position for a given channel. This is internal to Pascal and is found in rtl/sinclairql/qdos.inc.

Code: Select all

function fs_posab(chan: Tchanid; new_pos: dword):longint; assembler; nostackframe; public name '_fs_posab';
asm
  move.l d3,-(sp)
  moveq #_FS_POSAB,d0
  move.l new_pos,d1
  moveq #-1,d3
  move.l chan,a0
  trap #3
  tst.l d0
  bne.s  @quit
  move.l d1,d0
@quit:
  move.l (sp)+,d3
end;
Did you see two potential areas of problem? I didn't either. Thankfully inserting a TRAP #15 and using the QMON2 command TL 14 helped immensely. Here's a clue:

Code: Select all

function fs_posab(chan: Tchanid; new_pos: dword):longint; assembler; nostackframe; public name '_fs_posab';
asm
  ...
  moveq #_FS_POSAB,d0   <<<<<<<<<<<<<<<
  ...
  move.l chan,a0        <<<<<<<<<<<<<<<
Spotted it? It's a right b*gg*r if you don't know.

It seems that the register calling convention, used by default, pass the first ordinal parameter in D0 and the second in D1, A0 and A1 are used to pass pointers, addresses or references. (See https://wiki.freepascal.org/m68k#Calling_Conventions). When calling the FS_POSAB() function, the chan parameter is passed in D0 and the new_pos is passed in D1. When stepping through the code in QMON2, the line in the source that is "move.l chan,a0" executes as "move.l d0,a0" and D0 has already been trashed by setting it to #FS_POSAB. A similar problem exists when "move.l new_pos,d1" which is actually "move.l d1,d1" in this case.

There are other bugs in the above code, when the trap returns, if the requested position is beyond EOF, the ERR_EF is in D0, so in my amended code, I've trapped that and cleared D0 if detected. Out of interest, does anyone know offhand what SMSQ does with D1 on return? It's supposed to be the new position in the file, which is fine if the requested position was within the limits of the file, what is it set to if it goes beyond EOF? In Pascal testing, I see it return zero -- which is not the actual position in the appropriate file. I could test this of course, but I'm a lazy b*gg*r! ;)

EDIT: Answering my own question. On QPC at least, the return value in D1 is not the new position in the file if it goes beyond EOF, it's the value zero, which it also is if the new positions is still within the bounds of the file and OPEN_OVER was used. It is correctly the new position if OPEN was used. I haven't bothered to try any other open modes. Pennel is incorrect as that documents D1 being the new position in the file but fails to mention EOF.

This code is being called from the Pascal Append() function to position an open file at the end, ready to be appended to. It should work (with my changes) but is giving a runtime error 103 when positioning at EOF. It should not be doing this as I've got the code working fine to set it to EOF and clear D0, so I'm hunting bugs in the Pascal source code now! :(


Cheers,
Norm.


Why do they put lightning conductors on churches?
Author of Arduino Software Internals
Author of Arduino Interrupts

No longer on Twitter, find me on https://mastodon.scot/@NormanDunbar.
User avatar
mk79
QL Wafer Drive
Posts: 1349
Joined: Sun Feb 02, 2014 10:54 am
Location: Esslingen/Germany
Contact:

Re: QL / PASCAL

Post by mk79 »

NormanDunbar wrote:Did you see two potential areas of problem? I didn't either. Thankfully inserting a TRAP #15 and using the QMON2 command TL 14 helped immensely.
Hmm yeah, that's on me, sorry :( I'm used to start with the trap-number and then the parameters... Chain-Q fixed it for mt_frjob, but left the others alone. So there is a whole bunch of the traps I implemented that will probably have the problem...

Cheers, Marcel


User avatar
NormanDunbar
Forum Moderator
Posts: 2251
Joined: Tue Dec 14, 2010 9:04 am
Location: Leeds, West Yorkshire, UK
Contact:

Re: QL / PASCAL

Post by NormanDunbar »

Ok Marcel, no worries, I did have a quick look through the rest of the code looking for similar stuff -- I'll have a proper look shortly when MrsD goes out for a walk. I thought it was Chain-q who did the code though.

EDIT: That wasn't too bad actually, fs_posab, fs_posre, fs_headr and fs_truncate were all that were affected. :) I'm inclined to set the registers up in order D0-D3 then A0-A3 then do the trap. Having to think about what's in which register when passed from Pascal makes life interesting!

Cheers,
Norm.


Why do they put lightning conductors on churches?
Author of Arduino Software Internals
Author of Arduino Interrupts

No longer on Twitter, find me on https://mastodon.scot/@NormanDunbar.
User avatar
NormanDunbar
Forum Moderator
Posts: 2251
Joined: Tue Dec 14, 2010 9:04 am
Location: Leeds, West Yorkshire, UK
Contact:

Re: QL / PASCAL

Post by NormanDunbar »

Hmm. Fixing one or other of the functions where the parameters passed were not retrieved in the correct order seems to have sorted the runtime error in the Append() function. Unfortunately, it seems that even thought the code for Append is requesting a new file position at the end of the file, and this is being done by SMSQ, the appended text is being written at the start of the file rather than at the end. It's almost as though the file is being opened in overwrite mode.

I'll have to see what io_open is getting passed now. :D

Cheers,
Norm.


Why do they put lightning conductors on churches?
Author of Arduino Software Internals
Author of Arduino Interrupts

No longer on Twitter, find me on https://mastodon.scot/@NormanDunbar.
Post Reply