recipes/trs80: making progress on floppy drivers

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".

blk/492

@@ -1,16 +1 @@
-CODE KEY
+493 496 LOADR
-    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,

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,

blk/494

@@ -0,0 +1,7 @@
+CODE DCSTAT ( drv -- f )
+    BC POPqq,
+    chkPS,
+    A 0x28 LDrn, ( @DCSTAT )
+    0x28 RSTn,
+    PUSHZ,
+;CODE

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
+

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
+
+

blk/498

@@ -0,0 +1 @@
+499 500 LOADR

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 ;

blk/500

@@ -0,0 +1,4 @@
+: FD@ ['] RDSEC SWAP FD@! ;
+: FD! ['] WRSEC SWAP FD@! ;
+: FD$ ['] FD@ BLK@* ! ['] FD! BLK!* ! ;
+

blk/501

@@ -0,0 +1 @@
+

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 )
+422 470 XPACKR ( core cmp print parse readln fmt blk )
-," : _ RDLN$ (ok) ; _ "
+499 500 XPACKR ( trs80.fs )
+," : _ BLK$ FD$ (ok) RDLN$ ; _ "
 H@ 256 /MOD 2 PC! 2 PC!