rc2014: unify SD Card driver

Now more low/high layers.

blk/001

@@ -7,7 +7,7 @@ MASTER INDEX
 200 Z80 assembler             260 Cross compilation
 280 Z80 boot code             350 ACIA driver
 370 SD Card driver            390 Cross-compiled core
-420 Core words                480 AT28 Driver
+428 Core words                480 AT28 Driver
 490 TRS-80 Recipe             520 Fonts
 550 TI-84+ Recipe
 

blk/263

@@ -5,7 +5,11 @@ VARIABLE XCURRENT
 
 : (xentry) XCON (entry) XCOFF ;
 : XCREATE (xentry) 11 C, ;
-
 : XCODE XCON CODE XCOFF ;
-
 : XIMM XCON IMMEDIATE XCOFF ;
+: _xapply ( a -- a-off )
+    DUP ORG @ > IF ORG @ - BIN( @ + THEN ;
+: XCOMPILE
+    XCON ' _xapply LITA
+    LIT< , (find) DROP _xapply , XCOFF ;
+: X[COMPILE] XCON ' _xapply , XCOFF ;

blk/265

@@ -4,7 +4,7 @@
     XCURRENT @ SWAP ( xcur w ) _find ( a f )
     IF   ( a )
         DUP IMMED? IF ABORT THEN
-        DUP ORG @ > IF ORG @ - BIN( @ + THEN ,
+        _xapply ,
     ELSE ( w )
         0x02 RAM+ @ SWAP ( cur w ) _find ( a f )
         IF DUP IMMED? NOT IF ABORT THEN EXECUTE

blk/288

@@ -1,4 +1,4 @@
-PC ORG @ 0x22 + ! ( litWord, 0xf7, very tight on the 0x100 limit )
+PC ORG @ 0x22 + ! ( litWord, 0xf7, tight on the 0x100 limit )
 ( Like numberWord, but instead of being followed by a 2 bytes
   number, it's followed by a null-terminated string. When
   called, puts the string's address on PS )

blk/370

@@ -1,4 +1,3 @@
 SD Card driver
 
-Load the z80 part with "372 LOAD", the Forth part with
-"374 LOAD".
+Load range: 372-381

blk/372

@@ -10,5 +10,3 @@ CODE _sdcSR  ( n -- n )
     L A LDrr,
     HL PUSHqq,
 ;CODE
-
-373 LOAD

blk/391

@@ -9,8 +9,8 @@ unusable directly. For the same reason, any reference to a word
 in the host system will obviously be wrong in the target
 system. More details in B260.
 
-These rules result in some practicals do's and dont's:
 
-1. No LEAVE in DO..LOOP
+
+
 
                                                         (cont.)

blk/412

@@ -13,3 +13,4 @@
 
 : ALLOT HERE +! ;
 : CREATE (entry) 11 ( 11 == cellWord ) C, ;
+: LEAVE R> R> DROP I 1- >R >R ;

blk/415

@@ -1 +1 @@
-1 2 LOADR+
+1 4 LOADR+

blk/416

@@ -1,14 +1,14 @@
-( LITN has to be defined after the last immediate usage of
-  it to avoid bootstrapping issues )
-: LITN 32 , , ( 32 == NUMBER ) ;
+: EMIT
+    ( 0x53==(emit) override )
+    0x53 RAM+ @ DUP IF EXECUTE ELSE DROP (emit) THEN ;
 
-: IMMED? 1- C@ 0x80 AND ;
+: (print)
+    BEGIN
+        C@+      ( a+1 c )
+        ( exit if null or 0xd )
+        DUP 0xd = OVER NOT OR IF 2DROP EXIT THEN
+        EMIT     ( a )
+    AGAIN
+;
 
-( ';' can't have its name right away because, when created, it
-  is not an IMMEDIATE yet and will not be treated properly by
-  xcomp. )
-: _
-    ['] EXIT ,
-    R> DROP     ( exit : )
-; IMMEDIATE
 

blk/417

@@ -1,16 +1,13 @@
-XCURRENT @ ( to PSP )
-: :
-    (entry)
-    ( We cannot use LITN as IMMEDIATE because of bootstrapping
-      issues. Same thing for ",".
-      32 == NUMBER 14 == compiledWord )
-    [ 32 H@ ! 2 ALLOT 14 H@ ! 2 ALLOT ] C,
+: ,"
     BEGIN
-        WORD
-        (find)
-        ( is word )
-        IF DUP IMMED? IF EXECUTE ELSE , THEN
-        ( maybe number )
-        ELSE (parse) LITN THEN
+        C<
+        ( 34 is ASCII for " )
+        DUP 34 = IF DROP EXIT THEN C,
     AGAIN ;
-( from PSP ) ';' SWAP 4 - C!
+
+: ."
+    34 , ( 34 == litWord ) ," 0 C,
+    COMPILE (print)
+; IMMEDIATE
+
+: ABORT" [COMPILE] ." COMPILE ABORT ; IMMEDIATE

blk/418

@@ -0,0 +1,14 @@
+( LITN has to be defined after the last immediate usage of
+  it to avoid bootstrapping issues )
+: LITN 32 , , ( 32 == NUMBER ) ;
+
+: IMMED? 1- C@ 0x80 AND ;
+
+( ';' can't have its name right away because, when created, it
+  is not an IMMEDIATE yet and will not be treated properly by
+  xcomp. )
+: _
+    ['] EXIT ,
+    R> DROP     ( exit : )
+; IMMEDIATE
+

blk/419

@@ -0,0 +1,16 @@
+XCURRENT @ ( to PSP )
+: :
+    (entry)
+    ( We cannot use LITN as IMMEDIATE because of bootstrapping
+      issues. Same thing for ",".
+      32 == NUMBER 14 == compiledWord )
+    [ 32 H@ ! 2 ALLOT 14 H@ ! 2 ALLOT ] C,
+    BEGIN
+        WORD
+        (find)
+        ( is word )
+        IF DUP IMMED? IF EXECUTE ELSE , THEN
+        ( maybe number )
+        ELSE (parse) LITN THEN
+    AGAIN ;
+( from PSP ) ';' SWAP 4 - C!

blk/422

@@ -1,10 +0,0 @@
-: [ INTERPRET ; IMMEDIATE
-: ] R> DROP ;
-: LIT< WORD 34 , SCPY 0 C, ; IMMEDIATE
-: LITA 36 , , ;
-: '? WORD (find) ;
-: '
-    '? (?br) [ 4 , ] EXIT
-    LIT< (wnf) (find) DROP EXECUTE
-;
-: ['] ' LITA ; IMMEDIATE

blk/423

@@ -1,5 +0,0 @@
-: COMPILE ' LITA ['] , , ; IMMEDIATE
-: [COMPILE] ' , ; IMMEDIATE
-: BEGIN H@ ; IMMEDIATE
-: AGAIN COMPILE (br) H@ - , ; IMMEDIATE
-: UNTIL COMPILE (?br) H@ - , ; IMMEDIATE

blk/424

@@ -1,13 +0,0 @@
-: _ BEGIN LIT< ) WORD S= UNTIL ; IMMEDIATE
-40 CURRENT @ 4 - C!
-( Hello, hello, krkrkrkr... do you hear me?
-  Ah, voice at last! Some lines above need comments
-  BTW: Forth lines limited to 64 cols because of default
-  input buffer size in Collapse OS
-
-  40 is ASCII for '('. We do this to simplify XPACK's task of
-  not mistakenly consider '(' definition as a comment.
-  LIT<: 34 == litWord
-  LITA: 36 == addrWord
-  COMPILE: Tough one. Get addr of caller word (example above
-  (br)) and then call LITA on it. )

blk/426

@@ -1,12 +0,0 @@
-: ELSE              ( a1 -- a2 | a1: IF cell a2: ELSE cell )
-    COMPILE (br)
-    2 ALLOT
-    DUP H@ -^ SWAP  ( a-H a )
-    !
-    H@ 2-          ( push a. -2 for allot offset )
-; IMMEDIATE
-
-: [IF]
-    IF EXIT THEN
-    LIT< [THEN] BEGIN DUP WORD S= UNTIL DROP ;
-: [THEN] ;

blk/428

@@ -8,6 +8,5 @@ itself to a full intepreter, which can then be relinked with
 the Relinker. There is no loader for these libraries because
 you will typically XPACK (B267) them.
 
-422 core                       438 print
-442 fmt                        447 readln
-453 blk
+430 core                       442 fmt
+447 readln                     453 blk

blk/430

@@ -1,14 +1,15 @@
-: DOES>
-    ( Overwrite cellWord in CURRENT )
-    ( 43 == doesWord )
-    43 CURRENT @ C!
-    ( When we have a DOES>, we forcefully place HERE to 4
-      bytes after CURRENT. This allows a DOES word to use ","
-      and "C," without messing everything up. )
-    CURRENT @ 3 + HERE !
-    ( HERE points to where we should write R> )
-    R> ,
-    ( We're done. Because we've popped RS, we'll exit parent
-      definition )
+: [ INTERPRET ; IMMEDIATE
+: ] R> DROP ;
+: LIT< WORD 34 , SCPY 0 C, ; IMMEDIATE
+: LITA 36 , , ;
+: '? WORD (find) ;
+: '
+    '? (?br) [ 4 , ] EXIT
+    LIT< (wnf) (find) DROP EXECUTE
 ;
-
+: ['] ' LITA ; IMMEDIATE
+: COMPILE ' LITA ['] , , ; IMMEDIATE
+: [COMPILE] ' , ; IMMEDIATE
+: BEGIN H@ ; IMMEDIATE
+: AGAIN COMPILE (br) H@ - , ; IMMEDIATE
+: UNTIL COMPILE (?br) H@ - , ; IMMEDIATE

blk/431

@@ -1,8 +1,13 @@
-: VARIABLE CREATE 2 ALLOT ;
-: CONSTANT CREATE , DOES> @ ;
+: _ BEGIN LIT< ) WORD S= UNTIL ; IMMEDIATE
+40 CURRENT @ 4 - C!
+( Hello, hello, krkrkrkr... do you hear me?
+  Ah, voice at last! Some lines above need comments
+  BTW: Forth lines limited to 64 cols because of default
+  input buffer size in Collapse OS
 
-( In addition to pushing H@ this compiles 2>R so that loop
-  variables are sent to PS at runtime )
-: DO COMPILE 2>R H@ ; IMMEDIATE
-: LOOP COMPILE (loop) H@ - , ; IMMEDIATE
-: LEAVE R> R> DROP I 1- >R >R ;
+  40 is ASCII for '('. We do this to simplify XPACK's task of
+  not mistakenly consider '(' definition as a comment.
+  LIT<: 34 == litWord
+  LITA: 36 == addrWord
+  COMPILE: Tough one. Get addr of caller word (example above
+  (br)) and then call LITA on it. )

blk/433

@@ -1,11 +1,12 @@
-: ROLL
-    DUP NOT IF EXIT THEN
-    1+ DUP PICK          ( n val )
-    SWAP 2 * (roll)      ( val )
-    SWAP DROP
-;
-
-: 2OVER 3 PICK 3 PICK ;
-: 2SWAP 3 ROLL 3 ROLL ;
-
+: ELSE              ( a1 -- a2 | a1: IF cell a2: ELSE cell )
+    COMPILE (br)
+    2 ALLOT
+    DUP H@ -^ SWAP  ( a-H a )
+    !
+    H@ 2-          ( push a. -2 for allot offset )
+; IMMEDIATE
 
+: [IF]
+    IF EXIT THEN
+    LIT< [THEN] BEGIN DUP WORD S= UNTIL DROP ;
+: [THEN] ;

blk/434

@@ -1,13 +1,14 @@
-: MOVE ( a1 a2 u -- )
-    ( u ) 0 DO ( a1 a2 )
-        SWAP C@+ ( a2 a1+1 x )
-        ROT C!+ ( a1+1 a2+1 )
-    LOOP 2DROP ;
-: MOVE- ( a1 a2 u -- )
-    SWAP OVER + 1- ( a1 u a2+u-1 )
-    ROT 2 PICK + 1- ( u a2+u-1 a1+u-1 )
-    ROT ( u ) 0 DO ( a2 a1 )
-        C@- ( a2 a1-1 x )
-        ROT C!- ( a1-1 a2-1 ) SWAP ( a2 a1 )
-    LOOP 2DROP ;
-: PREV 3 - DUP @ - ;
+: DOES>
+    ( Overwrite cellWord in CURRENT )
+    ( 43 == doesWord )
+    43 CURRENT @ C!
+    ( When we have a DOES>, we forcefully place HERE to 4
+      bytes after CURRENT. This allows a DOES word to use ","
+      and "C," without messing everything up. )
+    CURRENT @ 3 + HERE !
+    ( HERE points to where we should write R> )
+    R> ,
+    ( We're done. Because we've popped RS, we'll exit parent
+      definition )
+;
+

blk/435

@@ -1,13 +1,8 @@
-: 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. )
-    WORD( HERE !  ( w )
-    PREV CURRENT !
-;
+: VARIABLE CREATE 2 ALLOT ;
+: CONSTANT CREATE , DOES> @ ;
+
+( In addition to pushing H@ this compiles 2>R so that loop
+  variables are sent to PS at runtime )
+: DO COMPILE 2>R H@ ; IMMEDIATE
+: LOOP COMPILE (loop) H@ - , ; IMMEDIATE
+( LEAVE is implemented in xcomp )

blk/436

@@ -1,10 +1,11 @@
-( Drop RSP until I-2 == INTERPRET. )
-: EXIT!
-    ['] INTERPRET       ( I )
-    BEGIN               ( I )
-    DUP                 ( I I )
-    R> DROP I 2- @     ( I I a )
-    = UNTIL
-    DROP
+: ROLL
+    DUP NOT IF EXIT THEN
+    1+ DUP PICK          ( n val )
+    SWAP 2 * (roll)      ( val )
+    SWAP DROP
 ;
 
+: 2OVER 3 PICK 3 PICK ;
+: 2SWAP 3 ROLL 3 ROLL ;
+
+

blk/437

@@ -0,0 +1,13 @@
+: MOVE ( a1 a2 u -- )
+    ( u ) 0 DO ( a1 a2 )
+        SWAP C@+ ( a2 a1+1 x )
+        ROT C!+ ( a1+1 a2+1 )
+    LOOP 2DROP ;
+: MOVE- ( a1 a2 u -- )
+    SWAP OVER + 1- ( a1 u a2+u-1 )
+    ROT 2 PICK + 1- ( u a2+u-1 a1+u-1 )
+    ROT ( u ) 0 DO ( a2 a1 )
+        C@- ( a2 a1-1 x )
+        ROT C!- ( a1-1 a2-1 ) SWAP ( a2 a1 )
+    LOOP 2DROP ;
+: PREV 3 - DUP @ - ;

blk/438

@@ -1,13 +1,13 @@
-: EMIT
-    ( 0x53==(emit) override )
-    83 RAM+ @ DUP IF EXECUTE ELSE DROP (emit) THEN ;
-
-: (print)
-    BEGIN
-        C@+      ( a+1 c )
-        ( exit if null or 0xd )
-        DUP 13 = OVER NOT OR IF 2DROP EXIT THEN
-        EMIT     ( a )
-    AGAIN
+: 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. )
+    WORD( HERE !  ( w )
+    PREV CURRENT !
 ;
-

blk/439

@@ -1,16 +1,10 @@
-: ,"
-    BEGIN
-        C<
-        ( 34 is ASCII for " )
-        DUP 34 = IF DROP EXIT THEN C,
-    AGAIN ;
-
-: ."
-    34 , ( 34 == litWord ) ," 0 C,
-    COMPILE (print)
-; IMMEDIATE
-
-: ABORT" [COMPILE] ." COMPILE ABORT ; IMMEDIATE
-
-: (uflw) ABORT" stack underflow" ;
+( Drop RSP until I-2 == INTERPRET. )
+: EXIT!
+    ['] INTERPRET       ( I )
+    BEGIN               ( I )
+    DUP                 ( I I )
+    R> DROP I 2- @     ( I I a )
+    = UNTIL
+    DROP
+;
 

blk/440

@@ -1,3 +1,4 @@
+: (uflw) ABORT" stack underflow" ;
 : BS 8 EMIT ;
 : LF 10 EMIT ;
 : CR 13 EMIT ;

emul/xcomp.fs

@@ -4,6 +4,8 @@
 212 LOAD  ( z80 assembler )
 262 LOAD  ( xcomp )
 : CODE XCODE ;
+: COMPILE XCOMPILE ; IMMEDIATE
+: [COMPILE] X[COMPILE] ; IMMEDIATE
 : IMMEDIATE XIMM ;
 : (entry) (xentry) ;
 : : [ ' X: , ] ;
@@ -19,7 +21,7 @@ CURRENT @ XCURRENT !
 ( Update LATEST )
 PC ORG @ 8 + !
 ," CURRENT @ HERE ! "
-422 459 XPACKR
+430 459 XPACKR
 ," ' (key) 12 RAM+ ! "
 ORG @ 256 /MOD 2 PC! 2 PC!
 H@ 256 /MOD 2 PC! 2 PC!

recipes/rc2014/sdcard/README.md

@@ -72,10 +72,9 @@ instead.
 ## Building your stage 3
 
 Using the same technique as you used in the `eeprom` recipe, you can append
-required words to your boot binary. Required units `blk` (B464) and the SD Card
-driver (B370). You only need the Forth part. You of course actually need
-Z80 SDC words but to save you the troubles of rebuilding from stage 1 for this
-recipe, we took the liberty of already having included it in the base recipe.
+required words to your boot binary. There's only one required unit: `blk` from
+core words (B453). The SD card driver was already included in the base recipe
+to save you the troubles of rebuilding from stage 1 for this recipe.
 
 ## Testing in the emulator
 

recipes/rc2014/xcomp.fs

@@ -10,6 +10,8 @@ RAMSTART 0x70 + CONSTANT ACIA_MEM
 212 LOAD  ( z80 assembler )
 262 LOAD  ( xcomp )
 : CODE XCODE ;
+: COMPILE XCOMPILE ; IMMEDIATE
+: [COMPILE] X[COMPILE] ; IMMEDIATE
 : IMMEDIATE XIMM ;
 : (entry) (xentry) ;
 : CREATE XCREATE ;
@@ -20,12 +22,12 @@ CURRENT @ XCURRENT !
 282 LOAD  ( boot.z80 )
 393 LOAD  ( icore low )
 352 LOAD  ( acia )
-372 LOAD  ( sdc.z80 )
+372 381 LOADR  ( sdc )
 415 LOAD  ( icore high )
 (entry) _
 ( Update LATEST )
 PC ORG @ 8 + !
-422 452 XPACKR ( core print fmt readln )
+430 452 XPACKR ( core fmt readln )
 123 132 XPACKR ( linker )
 ," : _ ACIA$ RDLN$ (ok) ; _ "
 ORG @ 256 /MOD 2 PC! 2 PC!

recipes/ti84/xcomp.fs

@@ -9,6 +9,8 @@ RAMSTART 0x72 + CONSTANT KBD_MEM
 262 LOAD  ( xcomp )
 522 LOAD  ( font compiler )
 : CODE XCODE ;
+: COMPILE XCOMPILE ; IMMEDIATE
+: [COMPILE] X[COMPILE] ; IMMEDIATE
 : IMMEDIATE XIMM ;
 : (entry) (xentry) ;
 : CREATE XCREATE ; ( for KBD tbls )
@@ -72,7 +74,7 @@ CREATE ~FNT CPFNT3x5
 (entry) _
 ( Update LATEST )
 PC ORG @ 8 + !
-422 451 XPACKR ( core print fmt readln )
+430 451 XPACKR ( core fmt readln )
 ," : _ LCD$ KBD$ (ok) RDLN$ ; _ "
 ORG @ 0x100 - 256 /MOD 2 PC! 2 PC!
 H@ 256 /MOD 2 PC! 2 PC!

recipes/trs80/xcomp.fs

@@ -4,6 +4,8 @@ RS_ADDR 0x80 - CONSTANT RAMSTART
 212 LOAD  ( z80 assembler )
 262 LOAD  ( xcomp )
 : CODE XCODE ;
+: COMPILE XCOMPILE ; IMMEDIATE
+: [COMPILE] X[COMPILE] ; IMMEDIATE
 : IMMEDIATE XIMM ;
 : (entry) (xentry) ;
 : : [ ' X: , ] ;
@@ -19,7 +21,7 @@ CURRENT @ XCURRENT !
 ( Update LATEST )
 PC ORG @ 8 + !
 ," CURRENT @ HERE ! "
-422 459 XPACKR ( core print readln fmt blk )
+430 459 XPACKR ( core readln fmt blk )
 499 500 XPACKR ( trs80.fs )
 ( 0x0a == NLPTR. TRS-80 wants CR-only newlines )
 ," : _ ['] CR 0x0a RAM+ ! BLK$ FD$ (ok) RDLN$ ; _ "