From 07f807edee043496d6c956c72fc3bf5be1dd8651 Mon Sep 17 00:00:00 2001
From: Virgil Dupras <hsoft@hardcoded.net>
Date: Thu, 30 Apr 2020 16:10:35 -0400
Subject: [PATCH] recipes/trs80: making progress on floppy drivers

---
 blk/490                |  2 +-
 blk/492                | 17 +----------------
 blk/493                | 16 ++++++++++++++++
 blk/494                |  7 +++++++
 blk/495                | 10 ++++++++++
 blk/496                | 11 +++++++++++
 blk/498                |  1 +
 blk/499                | 16 ++++++++++++++++
 blk/500                |  4 ++++
 blk/501                |  1 +
 recipes/trs80/xcomp.fs |  5 +++--
 11 files changed, 71 insertions(+), 19 deletions(-)
 create mode 100644 blk/493
 create mode 100644 blk/494
 create mode 100644 blk/495
 create mode 100644 blk/496
 create mode 100644 blk/498
 create mode 100644 blk/499
 create mode 100644 blk/500
 create mode 100644 blk/501

diff --git a/blk/490 b/blk/490
index b65566e..2dc4319 100644
--- a/blk/490
+++ b/blk/490
@@ -5,4 +5,4 @@ moment, they are thin layer over the drivers provided by
 TRSDOS' SVC.
 
 Load the Z80 words with "492 LOAD" and the high level part
-with "494 LOAD".
+with "498 LOAD".
diff --git a/blk/492 b/blk/492
index b264dbb..63f74b3 100644
--- a/blk/492
+++ b/blk/492
@@ -1,16 +1 @@
-CODE KEY
-    A 0x01 LDrn, ( @KEY )
-    0x28 RSTn,
-    L A LDrr, H 0 LDrn,
-    HL PUSHqq,
-;CODE
-CODE EMIT
-    BC POPqq, ( c == @DSP arg )
-    chkPS,
-    A 0x02 LDrn, ( @DSP )
-    0x28 RSTn,
-;CODE
-CODE BYE
-    HL 0 LDddnn,
-    A 0x16 LDrn, ( @EXIT )
-    0x28 RSTn,
+493 496 LOADR
diff --git a/blk/493 b/blk/493
new file mode 100644
index 0000000..b264dbb
--- /dev/null
+++ b/blk/493
@@ -0,0 +1,16 @@
+CODE KEY
+    A 0x01 LDrn, ( @KEY )
+    0x28 RSTn,
+    L A LDrr, H 0 LDrn,
+    HL PUSHqq,
+;CODE
+CODE EMIT
+    BC POPqq, ( c == @DSP arg )
+    chkPS,
+    A 0x02 LDrn, ( @DSP )
+    0x28 RSTn,
+;CODE
+CODE BYE
+    HL 0 LDddnn,
+    A 0x16 LDrn, ( @EXIT )
+    0x28 RSTn,
diff --git a/blk/494 b/blk/494
new file mode 100644
index 0000000..4cbca34
--- /dev/null
+++ b/blk/494
@@ -0,0 +1,7 @@
+CODE DCSTAT ( drv -- f )
+    BC POPqq,
+    chkPS,
+    A 0x28 LDrn, ( @DCSTAT )
+    0x28 RSTn,
+    PUSHZ,
+;CODE
diff --git a/blk/495 b/blk/495
new file mode 100644
index 0000000..fe778dd
--- /dev/null
+++ b/blk/495
@@ -0,0 +1,10 @@
+CODE RDSEC ( drv cylsec addr -- f )
+    HL POPqq,
+    DE POPqq,
+    BC POPqq,
+    chkPS,
+    A 0x31 LDrn, ( @RDSEC )
+    0x28 RSTn,
+    PUSHZ,
+;CODE
+
diff --git a/blk/496 b/blk/496
new file mode 100644
index 0000000..2c25794
--- /dev/null
+++ b/blk/496
@@ -0,0 +1,11 @@
+CODE WRSEC ( drv cylsec addr -- f )
+    HL POPqq,
+    DE POPqq,
+    BC POPqq,
+    chkPS,
+    A 0x35 LDrn, ( @WRSEC )
+    0x28 RSTn,
+    PUSHZ,
+;CODE
+
+
diff --git a/blk/498 b/blk/498
new file mode 100644
index 0000000..17c50dd
--- /dev/null
+++ b/blk/498
@@ -0,0 +1 @@
+499 500 LOADR
diff --git a/blk/499 b/blk/499
new file mode 100644
index 0000000..e1439d5
--- /dev/null
+++ b/blk/499
@@ -0,0 +1,16 @@
+: _err ABORT" FDerr" ;
+: _cylsec ( sec -- cs, return sector/cylinder for given secid )
+    ( 4 256b sectors per block, 10 sec per cyl, 40 cyl max )
+    10 /MOD ( sec cyl )
+    DUP 39 > IF _err THEN
+    256 * + ( cylsec )
+;
+: FD@! ( wref blk -- )
+    1 DCSTAT NOT IF _err THEN
+    4 * ( wr sec )
+    4 0 DO ( wr sec )
+        DUP I + _cylsec ( wr sec cs )
+        I 256 * BLK( + ( wr sec cs addr )
+        1 ROT ROT ( wr sec drv cs addr )
+        4 PICK EXECUTE NOT IF _err THEN
+    LOOP 2DROP ;
diff --git a/blk/500 b/blk/500
new file mode 100644
index 0000000..d774b56
--- /dev/null
+++ b/blk/500
@@ -0,0 +1,4 @@
+: FD@ ['] RDSEC SWAP FD@! ;
+: FD! ['] WRSEC SWAP FD@! ;
+: FD$ ['] FD@ BLK@* ! ['] FD! BLK!* ! ;
+
diff --git a/blk/501 b/blk/501
new file mode 100644
index 0000000..8b13789
--- /dev/null
+++ b/blk/501
@@ -0,0 +1 @@
+
diff --git a/recipes/trs80/xcomp.fs b/recipes/trs80/xcomp.fs
index e65ab0d..e76d983 100644
--- a/recipes/trs80/xcomp.fs
+++ b/recipes/trs80/xcomp.fs
@@ -18,6 +18,7 @@ H@ 256 /MOD 2 PC! 2 PC!
 ( Update LATEST )
 PC ORG @ 8 + !
 ," CURRENT @ HERE ! "
-422 463 XPACKR ( core cmp print parse readln fmt )
-," : _ RDLN$ (ok) ; _ "
+422 470 XPACKR ( core cmp print parse readln fmt blk )
+499 500 XPACKR ( trs80.fs )
+," : _ BLK$ FD$ (ok) RDLN$ ; _ "
 H@ 256 /MOD 2 PC! 2 PC!