core: fix PSP leak in CASE..ENDCASE

In addition to making the driver significantly faster, it allows us
to make SDC port configuration opaque to sdc.fs.

blk/038

@@ -2,8 +2,8 @@
 FORGET x --       Rewind the dictionary (both CURRENT and HERE)
                   up to x's previous entry.             
 PREV   a -- a     Return a wordref's previous entry.
-WHLEN  a -- n     Get word header length from wordref. That is,
-                  name length + 3. a is a wordref
+WORD(  a -- a     Get wordref's beginning addr.
+
 
 
 

drv/sdc.fs

@@ -1,12 +1,3 @@
-: SDC_CSHIGH 6 ;
-: SDC_CSLOW 5 ;
-: SDC_SPI 4 ;
-
-: _sdcSR SDC_SPI PC! SDC_SPI PC@ ;
-
-: _sel 0 SDC_CSLOW PC! ;
-: _desel 0 SDC_CSHIGH PC! ;
-
 ( -- n )
 : _idle 0xff _sdcSR ;
 
@@ -87,38 +78,39 @@
     ( send CRC )
     0x01 OR        ( ensure stop bit )
     _sdcSR DROP
-	( And now we just have to wait for a valid response... )
+    ( And now we just have to wait for a valid response... )
     _wait
 ;
 
 ( cmd arg1 arg2 -- r )
 ( Send a command that expects a R1 response, handling CS. )
-: SDCMDR1 _sel _cmd _desel ;
+: SDCMDR1 _sdcSel _cmd _sdcDesel ;
 
 ( cmd arg1 arg2 -- r arg1 arg2 )
 ( Send a command that expects a R7 response, handling CS. A R7
   is a R1 followed by 4 bytes. arg1 contains bytes 0:1, arg2
   has 2:3 )
 : SDCMDR7
-    _sel
+    _sdcSel
     _cmd        ( r )
     _idle 256 * ( r h )
     _idle +     ( r arg1 )
     _idle 256 * ( r arg1 h )
     _idle +     ( r arg1 arg2 )
-    _desel
+    _sdcDesel
 ;
 
+: _err _sdcDesel ABORT" SDerr" ;
+
 ( Initialize a SD card. This should be called at least 1ms
-  after the powering up of the card. r is result.
-  Zero means success, non-zero means error. )
+  after the powering up of the card. )
 : SDC$
     ( Wake the SD card up. After power up, a SD card has to
       receive at least 74 dummy clocks with CS and DI high. We
       send 80. )
-    10 0 DO 0xff SDC_SPI PC! LOOP
+    10 0 DO _idle DROP LOOP
 
-	( call cmd0 and expect a 0x01 response (card idle)
+    ( call cmd0 and expect a 0x01 response (card idle)
 	  this should be called multiple times. we're actually
       expected to. let's call this for a maximum of 10 times. )
     0  ( dummy )
@@ -128,18 +120,18 @@
         SDCMDR1
         DUP 0x01 = IF LEAVE THEN
     LOOP
-    0x01 = NOT IF 1 EXIT THEN
+    0x01 = NOT IF _err THEN
 
-	( Then comes the CMD8. We send it with a 0x01aa argument
+    ( Then comes the CMD8. We send it with a 0x01aa argument
       and expect a 0x01aa argument back, along with a 0x01 R1
       response. )
     0b01001000 0 0x1aa  ( CMD8 )
     SDCMDR7                     ( r arg1 arg2 )
-    0x1aa = NOT IF 2 EXIT THEN  ( arg2 check )
-    0 = NOT IF 3 EXIT THEN      ( arg1 check )
-    0x01 = NOT IF 4 EXIT THEN   ( r check )
+    0x1aa = NOT IF _err THEN    ( arg2 check )
+    0 = NOT IF _err THEN        ( arg1 check )
+    0x01 = NOT IF _err THEN     ( r check )
 
-	( Now we need to repeatedly run CMD55+CMD41 (0x40000000)
+    ( Now we need to repeatedly run CMD55+CMD41 (0x40000000)
       until the card goes out of idle mode, that is, when
       it stops sending us 0x01 response and send us 0x00
       instead. Any other response means that initialization
@@ -147,24 +139,23 @@
     BEGIN
         0b01110111 0 0  ( CMD55 )
         SDCMDR1
-        0x01 = NOT IF 5 EXIT THEN
+        0x01 = NOT IF _err THEN
         0b01101001 0x4000 0x0000  ( CMD41 )
         SDCMDR1
-        DUP 0x01 > IF DROP 6 EXIT THEN
+        DUP 0x01 > IF _err THEN
     NOT UNTIL
     ( Out of idle mode! Success! )
-    0
 ;
 
-( dstaddr blkno -- f )
-: SDC@
-    _sel
+( dstaddr blkno -- )
+: _sdc@
+    _sdcSel
     0x51    ( CMD17 )
     0 ROT   ( a cmd 0 blkno )
     _cmd
-    IF _desel 0 EXIT THEN
+    IF _err THEN
     _wait
-    0xfe = NOT IF _desel 0 EXIT THEN
+    0xfe = NOT IF _err THEN
     0 SWAP           ( crc a )
     512 0 DO         ( crc a )
         DUP          ( crc a a )
@@ -179,6 +170,46 @@
     _idle 256 *
     _idle +          ( crc2 )
     _wait DROP
-    _desel
-    =   ( success if crc1 == crc2 )
+    _sdcDesel
+    = NOT IF _err THEN
+;
+
+: SDC@
+    2 * DUP BLK( SWAP    ( b a b )
+    _sdc@
+    1+ BLK( 512 + SWAP
+    _sdc@
+;
+
+( srcaddr blkno -- )
+: _sdc!
+    _sdcSel
+    0x58    ( CMD24 )
+    0 ROT   ( a cmd 0 blkno )
+    _cmd
+    IF _err THEN
+    _idle DROP
+    0xfe _sdcSR DROP
+    0 SWAP           ( crc a )
+    512 0 DO         ( crc a )
+        C@+          ( crc a+1 n )
+        ROT OVER     ( a n crc n )
+        _crc16       ( a n crc )
+        SWAP         ( a crc n )
+        _sdcSR DROP  ( a crc )
+        SWAP         ( crc a )
+    LOOP
+    DROP             ( crc )
+    256 /MOD         ( lsb msb )
+    _sdcSR DROP      ( lsb )
+    _sdcSR DROP
+    _wait DROP
+    _sdcDesel
+;
+
+: SDC!
+    2 * DUP BLK( SWAP    ( b a b )
+    _sdc!
+    1+ BLK( 512 + SWAP
+    _sdc!
 ;

drv/sdc.z80

@@ -0,0 +1,21 @@
+( n -- n )
+( Initiate SPI exchange with the SD card. n is the data to
+  send. )
+CODE _sdcSR
+    HL POPqq,
+    chkPS,
+    A L LDrr,
+    SDC_SPI OUTnA,
+    NOP, NOP,
+    SDC_SPI INAn,
+    L A LDrr,
+    HL PUSHqq,
+;CODE
+
+CODE _sdcSel
+    SDC_CSLOW OUTnA,
+;CODE
+
+CODE _sdcDesel
+    SDC_CSHIGH OUTnA,
+;CODE

emul/hw/rc2014/sdc.c

@@ -183,7 +183,6 @@ void sdc_spi_wr(SDC *sdc, uint8_t val)
         return;
     }
     if (cmd == 24) {
-        fprintf(stderr, "cmd24\n");
         if (sdc->fp) {
             fseek(sdc->fp, arg2*512, SEEK_SET);
         }

forth/core.fs

@@ -58,9 +58,9 @@
 ( During a CASE, the stack grows by 1 at each ENDOF so that
   we can fill all those ENDOF branching addrs. So that we
   know when to stop, we put a 0 on PSP. That's our stopgap. )
-: CASE 0 ; IMMEDIATE
+: CASE 0 COMPILE >R ; IMMEDIATE
 : OF
-    COMPILE OVER COMPILE =
+    COMPILE I COMPILE =
     [COMPILE] IF
 ; IMMEDIATE
 : ENDOF [COMPILE] ELSE ; IMMEDIATE
@@ -70,10 +70,11 @@
   hit 0. )
 : ENDCASE
     BEGIN
-        DUP NOT IF DROP EXIT THEN
+        DUP NOT IF
+            DROP COMPILE R> COMPILE DROP EXIT
+        THEN
         [COMPILE] THEN
     AGAIN
-    COMPILE DROP
 ; IMMEDIATE
 
 : CREATE
@@ -154,17 +155,18 @@
     -                           ( a-o )
 ;
 
-: WHLEN
-    1- C@      ( name len field )
+: WORD(
+    DUP 1- C@   ( name len field )
     127 AND     ( 0x7f. remove IMMEDIATE flag )
     3 +         ( fixed header len )
+    -
 ;
 
 : FORGET
     ' DUP               ( w w )
     ( HERE must be at the end of prev's word, that is, at the
       beginning of w. )
-    DUP WHLEN - HERE !  ( w )
+    WORD( HERE !  ( w )
     PREV CURRENT !
 ;
 

forth/link.fs

@@ -39,9 +39,6 @@
     1+
 ;
 
-( Get word addr, starting at name's address )
-: '< ' DUP WHLEN - ;
-
 ( Relink atom at a, applying offset o with limit ol.
   Returns a, appropriately skipped.
 )
@@ -127,6 +124,10 @@
   The output of this word is 3 numbers: top copied address,
   top copied CURRENT, and then the beginning of the copied dict
   at the end to indicate that we're finished processing.
+
+  Note that the last word is always skipped because it's not
+  possible to reliably detect its end. If you need that last
+  word, define a dummy word before calling RLDICT.
 )
 ( target -- )
 : RLDICT
@@ -142,7 +143,7 @@
     ( H@+2 == offset )
     H@ 2+ !                     ( )
     ( We have our offset, now let's copy our memory chunk )
-    H@ @ DUP WHLEN -            ( src )
+    H@ @ WORD(                  ( src )
     DUP H@ -^                   ( src u )
     DUP ROT SWAP                ( u src u )
     H@ 4 +                      ( u src u dst )
@@ -154,9 +155,9 @@
       offset by u+4. +4 before, remember, we're using 4 bytes
       as variable space. )
     4 +                         ( u+4 )
-    DUP H@ +                    ( u we )
+    DUP CURRENT @ WORD( +       ( u we )
     DUP .X CRLF
-    SWAP CURRENT @ +            ( we wr )
+    SWAP CURRENT @ PREV +       ( we wr )
     DUP .X CRLF
     BEGIN                       ( we wr )
         DUP ROT                 ( wr wr we )
@@ -169,7 +170,7 @@
         DUP                     ( wr wr )
         PREV                    ( oldwr newwr )
         SWAP                    ( wr oldwr )
-        DUP WHLEN -             ( wr we )
+        WORD(                   ( wr we )
         SWAP                    ( we wr )
         ( Are we finished? We're finished if wr-4 <= H@ )
         DUP 4 - H@ <=

recipes/rc2014/Makefile

@@ -10,6 +10,7 @@ BOOTSRCS = conf.fs \
 	$(FDIR)/boot.fs \
 	$(FDIR)/z80c.fs \
 	$(BASEDIR)/drv/acia.z80 \
+	$(BASEDIR)/drv/sdc.z80 \
 	$(FDIR)/icore.fs \
 	$(EDIR)/xstop.fs
 

recipes/rc2014/conf.fs

@@ -2,5 +2,8 @@
 0xf000 CONSTANT RS_ADDR
 0x80   CONSTANT ACIA_CTL
 0x81   CONSTANT ACIA_IO
+4      CONSTANT SDC_SPI
+5      CONSTANT SDC_CSLOW
+6      CONSTANT SDC_CSHIGH
 RAMSTART 0x70 + CONSTANT ACIA_MEM