Move most of the high layer of comp core into the low one

With KEY and EMIT being switch words, most of the high layer can
be defined before drivers.

In addition to this change, I've compacted core blocks which were
becoming quite sparse.

blk/001

@@ -6,6 +6,7 @@ MASTER INDEX
 160 AVR SPI programmer
 170-259 unused                260 Cross compilation
 280 Z80 boot code             350 Core words
+400-410 unused
 410 PS/2 keyboard subsystem   418 Z80 SPI Relay driver
 420 SD Card subsystem         440 8086 boot code
 470-519 unused                520 Fonts

blk/352

@@ -6,4 +6,4 @@ impossible.
 
 The gap between these 2 parts is the ideal place to put device
 driver code. Load the low part with "353 LOAD", the high part
-with "380 LOAD"
+with "390 LOAD"

blk/353

@@ -11,4 +11,4 @@
     (resRS) 0 0x08 RAM+ ! ( C<* override ) (infl)
     LIT" (main)" FIND DROP EXECUTE
 ;
-1 25 LOADR+ ( xcomp core low )
+1 33 LOADR+

blk/357

@@ -0,0 +1,14 @@
+( r c -- r f )
+( Parse digit c and accumulate into result r.
+  Flag f is 0 when c was a valid digit, 1 when c was WS,
+  -1 when c was an invalid digit. )
+: _pdacc
+    DUP 0x21 < IF DROP 1 EXIT THEN
+    ( parse char )
+    ( if bad, return "r -1" )
+    '0' -
+    DUP 10 < NOT IF DROP -1 EXIT THEN
+    ( good, add to running result )
+    SWAP 10 * +                    ( r*10+n )
+    0                              ( good )
+;

blk/358

@@ -1,14 +1,14 @@
-( r c -- r f )
-( Parse digit c and accumulate into result r.
-  Flag f is 0 when c was a valid digit, 1 when c was WS,
-  -1 when c was an invalid digit. )
-: _pdacc
-    DUP 0x21 < IF DROP 1 EXIT THEN
-    ( parse char )
-    ( if bad, return "r -1" )
-    '0' -
-    DUP 10 < NOT IF DROP -1 EXIT THEN
-    ( good, add to running result )
-    SWAP 10 * +                    ( r*10+n )
-    0                              ( good )
-;
+: _pd ( a -- n f, parse decimal )
+( We read the first char outside of the loop because it *has*
+  to be nonzero, which means _pdacc *has* to return 0. )
+    C@+ OVER C@ 0 ( a len firstchar startat )
+( if we have '-', we only advance. more processing later. )
+    SWAP '-' = IF 1+ THEN ( a len startat )
+( We loop until _pdacc is nonzero, which means either WS or
+  non-digit. 1 means WS, which means parsing was a success.
+  -1 means non-digit, which means we have a non-decimal. )
+    0 ROT ROT ( len ) ( startat ) DO ( a r )
+        OVER I + C@ ( a r c ) _pdacc ( a r f )
+        IF DROP 1- 0 UNLOOP EXIT THEN LOOP ( a r )
+( if we had '-', we need to invert result. )
+    SWAP C@ '-' = IF 0 -^ THEN 1 ( r 1 ) ;

blk/359

@@ -1,14 +1,10 @@
-: _pd ( a -- n f, parse decimal )
-( We read the first char outside of the loop because it *has*
-  to be nonzero, which means _pdacc *has* to return 0. )
-    C@+ OVER C@ 0 ( a len firstchar startat )
-( if we have '-', we only advance. more processing later. )
-    SWAP '-' = IF 1+ THEN ( a len startat )
-( We loop until _pdacc is nonzero, which means either WS or
-  non-digit. 1 means WS, which means parsing was a success.
-  -1 means non-digit, which means we have a non-decimal. )
-    0 ROT ROT ( len ) ( startat ) DO ( a r )
-        OVER I + C@ ( a r c ) _pdacc ( a r f )
-        IF DROP 1- 0 UNLOOP EXIT THEN LOOP ( a r )
-( if we had '-', we need to invert result. )
-    SWAP C@ '-' = IF 0 -^ THEN 1 ( r 1 ) ;
+( strings being sent to parse routines are always null
+  terminated )
+
+: _pc ( a -- n f, parse character )
+    ( apostrophe is ASCII 39 )
+    DUP 1+ C@ 39 = OVER 3 + C@ 39 = AND  ( a f )
+    NOT IF 0 EXIT THEN   ( a 0 )
+    ( surrounded by apos, good, return )
+    2+ C@ 1                             ( n 1 )
+;

blk/360

@@ -1,10 +1,16 @@
-( strings being sent to parse routines are always null
-  terminated )
-
-: _pc ( a -- n f, parse character )
-    ( apostrophe is ASCII 39 )
-    DUP 1+ C@ 39 = OVER 3 + C@ 39 = AND  ( a f )
-    NOT IF 0 EXIT THEN   ( a 0 )
-    ( surrounded by apos, good, return )
-    2+ C@ 1                             ( n 1 )
+( returns negative value on error )
+: _            ( c -- n )
+    DUP '0' '9' =><= IF '0' - EXIT THEN
+    DUP 'a' 'f' =><= IF 0x57 ( 'a' - 10 ) - EXIT THEN
+    DROP -1 ( bad )
 ;
+: _ph          ( a -- n f, parse hex )
+    ( '0': ASCII 0x30 'x': 0x78 0x7830 )
+    DUP 1+ @ 0x7830 = NOT IF 0 EXIT THEN ( a 0 )
+    ( We have "0x" prefix )
+    DUP C@ ( a len )
+    0 SWAP 1+ ( len+1 ) 3 DO ( a r )
+        OVER I + C@ ( a r c ) _ ( a r n )
+        DUP 0< IF 2DROP 0 UNLOOP EXIT THEN
+        SWAP 4 LSHIFT + ( a r*16+n ) LOOP
+    NIP 1 ;

blk/361

@@ -1,16 +1,15 @@
 ( returns negative value on error )
 : _            ( c -- n )
-    DUP '0' '9' =><= IF '0' - EXIT THEN
-    DUP 'a' 'f' =><= IF 0x57 ( 'a' - 10 ) - EXIT THEN
+    DUP '0' '1' =><= IF '0' - EXIT THEN
     DROP -1 ( bad )
 ;
-: _ph          ( a -- n f, parse hex )
-    ( '0': ASCII 0x30 'x': 0x78 0x7830 )
-    DUP 1+ @ 0x7830 = NOT IF 0 EXIT THEN ( a 0 )
-    ( We have "0x" prefix )
+: _pb          ( a -- n f, parse binary )
+    ( '0': ASCII 0x30 'b': 0x62 0x6230 )
+    DUP 1+ @ 0x6230 = NOT IF 0 EXIT THEN ( a 0 )
+    ( We have "0b" prefix )
     DUP C@ ( a len )
     0 SWAP 1+ ( len+1 ) 3 DO ( a r )
         OVER I + C@ ( a r c ) _ ( a r n )
         DUP 0< IF 2DROP 0 UNLOOP EXIT THEN
-        SWAP 4 LSHIFT + ( a r*16+n ) LOOP
+        SWAP 1 LSHIFT + ( a r*2+n ) LOOP
     NIP 1 ;

blk/362

@@ -1,15 +1,8 @@
-( returns negative value on error )
-: _            ( c -- n )
-    DUP '0' '1' =><= IF '0' - EXIT THEN
-    DROP -1 ( bad )
+: (parse)           ( a -- n )
+    _pc IF EXIT THEN
+    _ph IF EXIT THEN
+    _pb IF EXIT THEN
+    _pd IF EXIT THEN
+    ( nothing works )
+    (wnf)
 ;
-: _pb          ( a -- n f, parse binary )
-    ( '0': ASCII 0x30 'b': 0x62 0x6230 )
-    DUP 1+ @ 0x6230 = NOT IF 0 EXIT THEN ( a 0 )
-    ( We have "0b" prefix )
-    DUP C@ ( a len )
-    0 SWAP 1+ ( len+1 ) 3 DO ( a r )
-        OVER I + C@ ( a r c ) _ ( a r n )
-        DUP 0< IF 2DROP 0 UNLOOP EXIT THEN
-        SWAP 1 LSHIFT + ( a r*2+n ) LOOP
-    NIP 1 ;

blk/363

@@ -1,8 +1,11 @@
-: (parse)           ( a -- n )
-    _pc IF EXIT THEN
-    _ph IF EXIT THEN
-    _pb IF EXIT THEN
-    _pd IF EXIT THEN
-    ( nothing works )
-    (wnf)
-;
+: C<? 0x06 RAM+ @ ;
+SYSVARS 0x0c + :** C<*
+: C<
+    0x08 RAM+ ( C<* override ) @
+    ?DUP NOT IF C<* ELSE EXECUTE THEN ;
+: , H@ ! H@ 2+ HERE ! ;
+: C, H@ C! H@ 1+ HERE ! ;
+: ,"
+    BEGIN
+        C< DUP 34 ( ASCII " ) = IF DROP EXIT THEN C,
+    AGAIN ;

blk/364

@@ -1,11 +1,8 @@
-: C<? 0x06 RAM+ @ ;
-SYSVARS 0x0c + :** C<*
-: C<
-    0x08 RAM+ ( C<* override ) @
-    ?DUP NOT IF C<* ELSE EXECUTE THEN ;
-: , H@ ! H@ 2+ HERE ! ;
-: C, H@ C! H@ 1+ HERE ! ;
-: ,"
-    BEGIN
-        C< DUP 34 ( ASCII " ) = IF DROP EXIT THEN C,
-    AGAIN ;
+: WS? 33 < ;
+: EOT? 4 = ; ( 4 == ASCII EOT, CTRL+D )
+: EOT, 4 C, ;
+
+: TOWORD
+    0 ( dummy ) BEGIN
+        DROP C< DUP WS? NOT OVER EOT? OR
+    UNTIL ;

blk/365

@@ -1,8 +1,13 @@
-: WS? 33 < ;
-: EOT? 4 = ; ( 4 == ASCII EOT, CTRL+D )
-: EOT, 4 C, ;
-
-: TOWORD
-    0 ( dummy ) BEGIN
-        DROP C< DUP WS? NOT OVER EOT? OR
-    UNTIL ;
+( Read word from C<, copy to WORDBUF, null-terminate, and
+  return WORDBUF. )
+: _wb 0x0e RAM+ ;
+: _eot 0x0401 _wb ! _wb ;
+: WORD
+    _wb 1+ TOWORD ( a c )
+    DUP EOT? IF 2DROP _eot EXIT THEN
+    BEGIN
+        OVER C! 1+ C< ( a c )
+        OVER 0x2e RAM+ = OVER WS? OR
+    UNTIL ( a c )
+    SWAP _wb - 1- ( ws len ) _wb C!
+    EOT? IF _eot ELSE _wb THEN ;

blk/366

@@ -1,13 +1,13 @@
-( Read word from C<, copy to WORDBUF, null-terminate, and
-  return WORDBUF. )
-: _wb 0x0e RAM+ ;
-: _eot 0x0401 _wb ! _wb ;
-: WORD
-    _wb 1+ TOWORD ( a c )
-    DUP EOT? IF 2DROP _eot EXIT THEN
-    BEGIN
-        OVER C! 1+ C< ( a c )
-        OVER 0x2e RAM+ = OVER WS? OR
-    UNTIL ( a c )
-    SWAP _wb - 1- ( ws len ) _wb C!
-    EOT? IF _eot ELSE _wb THEN ;
+: IMMEDIATE
+    CURRENT @ 1-
+    DUP C@ 128 OR SWAP C! ;
+: IMMED? 1- C@ 0x80 AND ;
+: '? WORD FIND ;
+: ' '? NOT IF (wnf) THEN ;
+: ROLL
+    ?DUP NOT IF EXIT THEN
+    1+ DUP PICK          ( n val )
+    SWAP 2 * (roll)      ( val )
+    NIP ;
+: 2OVER 3 PICK 3 PICK ;
+: 2SWAP 3 ROLL 3 ROLL ;

blk/367

@@ -0,0 +1,14 @@
+: MOVE ( a1 a2 u -- )
+    ?DUP IF ( u ) 0 DO ( a1 a2 )
+        SWAP C@+ ( a2 a1+1 x )
+        ROT C!+ ( a1+1 a2+1 )
+    LOOP THEN 2DROP ;
+: MOVE- ( a1 a2 u -- )
+    ?DUP IF TUCK + 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 THEN 2DROP ;
+: MOVE, ( a u -- ) H@ OVER ALLOT SWAP MOVE ;
+: PREV 3 - DUP @ - ;

blk/368

@@ -0,0 +1,10 @@
+: [entry] ( w -- )
+    C@+ ( w+1 len ) TUCK MOVE, ( len )
+    ( write prev value )
+    H@ CURRENT @ - ,
+    C, ( write size )
+    H@ CURRENT !
+;
+: (entry) WORD [entry] ;
+: CREATE (entry) 2 ( cellWord ) C, ;
+: VARIABLE CREATE 2 ALLOT ;

blk/369

@@ -1,13 +1,14 @@
-: IMMEDIATE
-    CURRENT @ 1-
-    DUP C@ 128 OR SWAP C! ;
-: IMMED? 1- C@ 0x80 AND ;
-: '? WORD FIND ;
-: ' '? NOT IF (wnf) THEN ;
-: ROLL
-    ?DUP NOT IF EXIT THEN
-    1+ DUP PICK          ( n val )
-    SWAP 2 * (roll)      ( val )
-    NIP ;
-: 2OVER 3 PICK 3 PICK ;
-: 2SWAP 3 ROLL 3 ROLL ;
+: 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 !
+;
+: EMPTY LIT" _sys" FIND IF DUP HERE ! CURRENT ! THEN ;

blk/370

@@ -1,14 +1,13 @@
-: MOVE ( a1 a2 u -- )
-    ?DUP IF ( u ) 0 DO ( a1 a2 )
-        SWAP C@+ ( a2 a1+1 x )
-        ROT C!+ ( a1+1 a2+1 )
-    LOOP THEN 2DROP ;
-: MOVE- ( a1 a2 u -- )
-    ?DUP IF TUCK + 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 THEN 2DROP ;
-: MOVE, ( a u -- ) H@ OVER ALLOT SWAP MOVE ;
-: PREV 3 - DUP @ - ;
+: DOES>
+    ( Overwrite cellWord in CURRENT )
+    3 ( does ) 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 )
+;
+: CONSTANT CREATE , DOES> @ ;

blk/371

@@ -1,10 +1,4 @@
-: [entry] ( w -- )
-    C@+ ( w+1 len ) TUCK MOVE, ( len )
-    ( write prev value )
-    H@ CURRENT @ - ,
-    C, ( write size )
-    H@ CURRENT !
-;
-: (entry) WORD [entry] ;
-: CREATE (entry) 2 ( cellWord ) C, ;
-: VARIABLE CREATE 2 ALLOT ;
+: [IF]
+    IF EXIT THEN
+    LIT" [THEN]" BEGIN DUP WORD S= UNTIL DROP ;
+: [THEN] ;

blk/372

@@ -1,14 +1,10 @@
-: 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 !
-;
-: EMPTY LIT" _sys" FIND IF DUP HERE ! CURRENT ! THEN ;
+( n -- Fetches block n and write it to BLK( )
+: BLK@* 0x34 RAM+ ;
+( n -- Write back BLK( to storage at block n )
+: BLK!* 0x36 RAM+ ;
+( Current blk pointer in ( )
+: BLK> 0x38 RAM+ ;
+( Whether buffer is dirty )
+: BLKDTY 0x3a RAM+ ;
+: BLK( 0x3c RAM+ @ ;
+: BLK) BLK( 1024 + ;

blk/373

@@ -1,13 +1,9 @@
-: DOES>
-    ( Overwrite cellWord in CURRENT )
-    3 ( does ) 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$
+    H@ 0x3c ( BLK(* ) RAM+ !
+    1024 ALLOT
+    ( LOAD detects end of block with ASCII EOT. This is why
+      we write it there. )
+    EOT,
+    0 BLKDTY !
+    -1 BLK> !
 ;
-: CONSTANT CREATE , DOES> @ ;

blk/374

@@ -1,4 +1,14 @@
-: [IF]
-    IF EXIT THEN
-    LIT" [THEN]" BEGIN DUP WORD S= UNTIL DROP ;
-: [THEN] ;
+: BLK! ( -- )
+    BLK> @ BLK!* @ EXECUTE
+    0 BLKDTY ! ;
+: FLUSH BLKDTY @ IF BLK! THEN ;
+: BLK@ ( n -- )
+    DUP BLK> @ = IF DROP EXIT THEN
+    FLUSH DUP BLK> ! BLK@* @ EXECUTE ;
+: BLK!! 1 BLKDTY ! ;
+: WIPE BLK( 1024 0 FILL BLK!! ;
+: WIPED? ( -- f )
+    1 ( f ) BLK) BLK( DO
+        I C@ IF DROP 0 ( f ) LEAVE THEN LOOP ;
+: COPY ( src dst -- )
+    FLUSH SWAP BLK@ BLK> ! BLK! ;

blk/375

@@ -0,0 +1,16 @@
+: _
+    999 SWAP        ( stop indicator )
+    BEGIN
+        ?DUP NOT IF EXIT THEN
+        10 /MOD         ( r q )
+        SWAP '0' + SWAP ( d q )
+    AGAIN ;
+: . ( n -- )
+    ?DUP NOT IF '0' EMIT EXIT THEN ( 0 is a special case )
+    ( handle negative )
+    DUP 0< IF '-' EMIT -1 * THEN
+    _
+    BEGIN
+        DUP '9' > IF DROP EXIT THEN  ( stop indicator )
+        EMIT
+    AGAIN ;

blk/376

@@ -1,10 +1,16 @@
-( n -- Fetches block n and write it to BLK( )
-: BLK@* 0x34 RAM+ ;
-( n -- Write back BLK( to storage at block n )
-: BLK!* 0x36 RAM+ ;
-( Current blk pointer in ( )
-: BLK> 0x38 RAM+ ;
-( Whether buffer is dirty )
-: BLKDTY 0x3a RAM+ ;
-: BLK( 0x3c RAM+ @ ;
-: BLK) BLK( 1024 + ;
+: ? @ . ;
+: _
+    DUP 9 > IF 10 - 'a' +
+    ELSE '0' + THEN
+;
+( For hex display, there are no negatives )
+: .x
+    256 MOD     ( ensure < 0x100 )
+    16 /MOD     ( l h )
+    _ EMIT      ( l )
+    _ EMIT
+;
+: .X
+    256 /MOD    ( l h )
+    .x .x
+;

blk/377

@@ -1,9 +1,13 @@
-: BLK$
-    H@ 0x3c ( BLK(* ) RAM+ !
-    1024 ALLOT
-    ( LOAD detects end of block with ASCII EOT. This is why
-      we write it there. )
-    EOT,
-    0 BLKDTY !
-    -1 BLK> !
+: _ ( a -- a+8 )
+    DUP ( a a )
+    ':' EMIT DUP .x SPC
+    4 0 DO DUP @ 256 /MOD SWAP .x .x SPC 2+ LOOP
+    DROP ( a )
+    8 0 DO
+        C@+ DUP 0x20 0x7e =><= NOT IF DROP '.' THEN EMIT
+    LOOP NL ;
+: DUMP ( n a -- )
+    LF
+    SWAP 8 /MOD SWAP IF 1+ THEN
+    0 DO _ LOOP
 ;

blk/378

@@ -1,14 +1,13 @@
-: BLK! ( -- )
-    BLK> @ BLK!* @ EXECUTE
-    0 BLKDTY ! ;
-: FLUSH BLKDTY @ IF BLK! THEN ;
-: BLK@ ( n -- )
-    DUP BLK> @ = IF DROP EXIT THEN
-    FLUSH DUP BLK> ! BLK@* @ EXECUTE ;
-: BLK!! 1 BLKDTY ! ;
-: WIPE BLK( 1024 0 FILL BLK!! ;
-: WIPED? ( -- f )
-    1 ( f ) BLK) BLK( DO
-        I C@ IF DROP 0 ( f ) LEAVE THEN LOOP ;
-: COPY ( src dst -- )
-    FLUSH SWAP BLK@ BLK> ! BLK! ;
+( handle backspace: go back one char in IN>, if possible, then
+  emit BS + SPC + BS )
+: _bs
+    ( already at IN( ? )
+    IN> @ IN( = IF EXIT THEN
+    IN> @ 1- IN> !
+    BS SPC BS
+;
+( del is same as backspace )
+: BS? DUP 0x7f = SWAP 0x8 = OR ;
+SYSVARS 0x55 + :** KEY
+( cont.: read one char into input buffer and returns whether we
+  should continue, that is, whether CR was not met. )

blk/380

@@ -1 +1,16 @@
-1 20 LOADR+ ( xcomp core high )
+( Read one line in input buffer and make IN> point to it )
+: (rdln)
+    ( EOT or less triggers line flush )
+    (infl) BEGIN (rdlnc) 5 < UNTIL
+    LF IN( IN> ! ;
+( And finally, implement C<* )
+: RDLN<
+    IN> @ C@
+    DUP IF ( not EOL? good, inc and return )
+        1 IN> +!
+    ELSE ( EOL ? readline. we still return null though )
+        (rdln)
+    THEN
+    ( update C<? flag )
+    IN> @ C@ 0 > 0x06 RAM+ !  ( 06 == C<? )
+;

blk/381

@@ -0,0 +1,10 @@
+( Initializes the readln subsystem )
+: RDLN$
+    H@ 0x32 ( IN(* ) RAM+ !
+    ( plus 2 for extra bytes after buffer: 1 for
+      the last typed 0x0a and one for the following NULL. )
+    IN) IN( - ALLOT
+    (infl)
+    ['] RDLN< ['] C<* **!
+    1 0x06 RAM+ !  ( 06 == C<? )
+;

blk/382

@@ -0,0 +1,11 @@
+: .2 DUP 10 < IF SPC THEN . ;
+: LIST
+    BLK@
+    16 0 DO
+        I 1+ .2 SPC
+        64 I * BLK( + DUP 64 + SWAP DO
+            I C@ 0x20 MAX EMIT
+        LOOP
+        NL
+    LOOP
+;

blk/383

@@ -1,16 +1,15 @@
-: _
-    999 SWAP        ( stop indicator )
+: INTERPRET
     BEGIN
-        ?DUP NOT IF EXIT THEN
-        10 /MOD         ( r q )
-        SWAP '0' + SWAP ( d q )
-    AGAIN ;
-: . ( n -- )
-    ?DUP NOT IF '0' EMIT EXIT THEN ( 0 is a special case )
-    ( handle negative )
-    DUP 0< IF '-' EMIT -1 * THEN
-    _
-    BEGIN
-        DUP '9' > IF DROP EXIT THEN  ( stop indicator )
-        EMIT
+    WORD DUP @ 0x0401 = ( EOT ) IF DROP EXIT THEN
+    FIND NOT IF (parse) ELSE EXECUTE THEN
+    C<? NOT IF SPC LIT" ok" (print) NL THEN
     AGAIN ;
+( Read from BOOT C< PTR and inc it. )
+: (boot<)
+    ( 2e == BOOT C< PTR )
+    0x2e ( BOOT C< PTR ) RAM+ @ DUP C@ ( a c )
+    SWAP 1 + 0x2e RAM+ ! ( c ) ;
+( pre-comment for tight LOAD: The 0x08==I check after INTERPRET
+  is to check whether we're restoring to "_", the word above.
+  if yes, then we're in a nested load. Also, the 1 in 0x06 is
+  to avoid tons of "ok" displays. )

blk/384

@@ -1,16 +1,16 @@
-: ? @ . ;
-: _
-    DUP 9 > IF 10 - 'a' +
-    ELSE '0' + THEN
-;
-( For hex display, there are no negatives )
-: .x
-    256 MOD     ( ensure < 0x100 )
-    16 /MOD     ( l h )
-    _ EMIT      ( l )
-    _ EMIT
-;
-: .X
-    256 /MOD    ( l h )
-    .x .x
-;
+: LOAD
+    BLK> @ >R ( save restorable variables to RSP )
+    0x08 RAM+ @ >R  ( 08 == C<* override )
+    0x06 RAM+ @ >R  ( C<? )
+    0x2e RAM+ @ >R  ( boot ptr )
+    BLK@
+    BLK( 0x2e RAM+ ! ( Point to beginning of BLK )
+    ['] (boot<) 0x08 RAM+ !
+    1 0x06 RAM+ !  ( 06 == C<? )
+    INTERPRET
+    R> 0x2e RAM+ ! R> 0x06 RAM+ !
+    I 0x08 RAM+ @ = IF ( nested load )
+        R> DROP ( C<* ) R> BLK@
+    ELSE ( not nested )
+        R> 0x08 RAM+ ! R> DROP ( BLK> )
+    THEN ;

blk/385

@@ -1,13 +1,15 @@
-: _ ( a -- a+8 )
-    DUP ( a a )
-    ':' EMIT DUP .x SPC
-    4 0 DO DUP @ 256 /MOD SWAP .x .x SPC 2+ LOOP
-    DROP ( a )
-    8 0 DO
-        C@+ DUP 0x20 0x7e =><= NOT IF DROP '.' THEN EMIT
-    LOOP NL ;
-: DUMP ( n a -- )
-    LF
-    SWAP 8 /MOD SWAP IF 1+ THEN
-    0 DO _ LOOP
-;
+: LOAD+ BLK> @ + LOAD ;
+( b1 b2 -- )
+: LOADR 1+ SWAP DO I DUP . NL LOAD LOOP ;
+: LOADR+ BLK> @ + SWAP BLK> @ + SWAP LOADR ;
+( Now, adev stuff )
+SYSVARS 0x3e + :** A@
+SYSVARS 0x40 + :** A!
+
+( src dst u -- )
+: AMOVE
+    ( u ) 0 DO
+        SWAP DUP I + A@   ( dst src x )
+        ROT TUCK I +      ( src dst x dst )
+        A!                ( src dst )
+    LOOP 2DROP ;

blk/387

@@ -1,13 +0,0 @@
-( handle backspace: go back one char in IN>, if possible, then
-  emit BS + SPC + BS )
-: _bs
-    ( already at IN( ? )
-    IN> @ IN( = IF EXIT THEN
-    IN> @ 1- IN> !
-    BS SPC BS
-;
-( del is same as backspace )
-: BS? DUP 0x7f = SWAP 0x8 = OR ;
-SYSVARS 0x55 + :** KEY
-( cont.: read one char into input buffer and returns whether we
-  should continue, that is, whether CR was not met. )

blk/389

@@ -1,16 +0,0 @@
-( Read one line in input buffer and make IN> point to it )
-: (rdln)
-    ( EOT or less triggers line flush )
-    (infl) BEGIN (rdlnc) 5 < UNTIL
-    LF IN( IN> ! ;
-( And finally, implement C<* )
-: RDLN<
-    IN> @ C@
-    DUP IF ( not EOL? good, inc and return )
-        1 IN> +!
-    ELSE ( EOL ? readline. we still return null though )
-        (rdln)
-    THEN
-    ( update C<? flag )
-    IN> @ C@ 0 > 0x06 RAM+ !  ( 06 == C<? )
-;

blk/390

@@ -1,10 +1,16 @@
-( Initializes the readln subsystem )
-: RDLN$
-    H@ 0x32 ( IN(* ) RAM+ !
-    ( plus 2 for extra bytes after buffer: 1 for
-      the last typed 0x0a and one for the following NULL. )
-    IN) IN( - ALLOT
-    (infl)
-    ['] RDLN< ['] C<* **!
-    1 0x06 RAM+ !  ( 06 == C<? )
-;
+( xcomp core high )
+: (main) INTERPRET BYE ;
+: BOOT
+    0x02 RAM+ CURRENT* !
+    CURRENT @ 0x2e RAM+ ! ( 2e == BOOT C< PTR )
+    0 0x08 RAM+ !  ( 08 == C<* override )
+    ['] (emit) ['] EMIT **! ['] (key) ['] KEY **!
+    ['] CRLF ['] NL **!
+    ['] (boot<) ['] C<* **!
+    ['] C@ ['] A@ **! ['] C! ['] A! **!
+    ( boot< always has a char waiting. 06 == C<?* )
+    1 0x06 RAM+ ! INTERPRET
+    RDLN$ LIT" _sys" [entry]
+    LIT" Collapse OS" (print) NL (main) ;
+XCURRENT @ _xapply ORG @ 0x04 ( stable ABI BOOT ) + !
+1 4 LOADR+

blk/391

@@ -1,11 +1,4 @@
-: .2 DUP 10 < IF SPC THEN . ;
-: LIST
-    BLK@
-    16 0 DO
-        I 1+ .2 SPC
-        64 I * BLK( + DUP 64 + SWAP DO
-            I C@ 0x20 MAX EMIT
-        LOOP
-        NL
-    LOOP
-;
+( Now we have "as late as possible" stuff. See bootstrap doc. )
+: :* ( addr -- ) (entry) 4 ( alias ) C, , ;
+: :** ( addr -- ) (entry) 5 ( switch ) C, , ;
+

blk/392

@@ -1,15 +1,14 @@
-: INTERPRET
+: _bchk DUP 0x7f + 0xff > IF LIT" br ovfl" (print) ABORT THEN ;
+: DO COMPILE 2>R H@ ; IMMEDIATE
+: LOOP COMPILE (loop) H@ - _bchk C, ; IMMEDIATE
+( LEAVE is implemented in low xcomp )
+: LITN COMPILE (n) , ;
+( gets its name at the very end. can't comment afterwards )
+: _ BEGIN LIT" )" WORD S= UNTIL ; IMMEDIATE
+: _ ( : will get its name almost at the very end )
+    (entry) 1 ( compiled ) C,
     BEGIN
-    WORD DUP @ 0x0401 = ( EOT ) IF DROP EXIT THEN
-    FIND NOT IF (parse) ELSE EXECUTE THEN
-    C<? NOT IF SPC LIT" ok" (print) NL THEN
+        WORD DUP LIT" ;" S= IF DROP COMPILE EXIT EXIT THEN
+        FIND IF ( is word ) DUP IMMED? IF EXECUTE ELSE , THEN
+        ELSE ( maybe number ) (parse) LITN THEN
     AGAIN ;
-( Read from BOOT C< PTR and inc it. )
-: (boot<)
-    ( 2e == BOOT C< PTR )
-    0x2e ( BOOT C< PTR ) RAM+ @ DUP C@ ( a c )
-    SWAP 1 + 0x2e RAM+ ! ( c ) ;
-( pre-comment for tight LOAD: The 0x08==I check after INTERPRET
-  is to check whether we're restoring to "_", the word above.
-  if yes, then we're in a nested load. Also, the 1 in 0x06 is
-  to avoid tons of "ok" displays. )

blk/393

@@ -1,16 +1,16 @@
-: LOAD
-    BLK> @ >R ( save restorable variables to RSP )
-    0x08 RAM+ @ >R  ( 08 == C<* override )
-    0x06 RAM+ @ >R  ( C<? )
-    0x2e RAM+ @ >R  ( boot ptr )
-    BLK@
-    BLK( 0x2e RAM+ ! ( Point to beginning of BLK )
-    ['] (boot<) 0x08 RAM+ !
-    1 0x06 RAM+ !  ( 06 == C<? )
-    INTERPRET
-    R> 0x2e RAM+ ! R> 0x06 RAM+ !
-    I 0x08 RAM+ @ = IF ( nested load )
-        R> DROP ( C<* ) R> BLK@
-    ELSE ( not nested )
-        R> 0x08 RAM+ ! R> DROP ( BLK> )
-    THEN ;
+: IF ( -- a | a: br cell addr )
+    COMPILE (?br) H@ 1 ALLOT ( br cell allot )
+; IMMEDIATE
+: THEN ( a -- | a: br cell addr )
+    DUP H@ -^ _bchk SWAP ( a-H a ) C!
+; IMMEDIATE
+: ELSE ( a1 -- a2 | a1: IF cell a2: ELSE cell )
+    COMPILE (br)
+    1 ALLOT
+    [COMPILE] THEN
+    H@ 1- ( push a. 1- for allot offset )
+; IMMEDIATE
+: LIT"
+    COMPILE (s) H@ 0 C, ,"
+    DUP H@ -^ 1- ( a len ) SWAP C!
+; IMMEDIATE

blk/394

@@ -1,15 +1,13 @@
-: LOAD+ BLK> @ + LOAD ;
-( b1 b2 -- )
-: LOADR 1+ SWAP DO I DUP . NL LOAD LOOP ;
-: LOADR+ BLK> @ + SWAP BLK> @ + SWAP LOADR ;
-( Now, adev stuff )
-SYSVARS 0x3e + :** A@
-SYSVARS 0x40 + :** A!
-
-( src dst u -- )
-: AMOVE
-    ( u ) 0 DO
-        SWAP DUP I + A@   ( dst src x )
-        ROT TUCK I +      ( src dst x dst )
-        A!                ( src dst )
-    LOOP 2DROP ;
+( We don't use ." and ABORT in core, they're not xcomp-ed )
+: ." [COMPILE] LIT" COMPILE (print) ; IMMEDIATE
+: ABORT" [COMPILE] ." COMPILE ABORT ; IMMEDIATE
+: BEGIN H@ ; IMMEDIATE
+: AGAIN COMPILE (br) H@ - _bchk C, ; IMMEDIATE
+: UNTIL COMPILE (?br) H@ - _bchk C, ; IMMEDIATE
+: [ INTERPRET ; IMMEDIATE
+: ] R> DROP ;
+: COMPILE ' LITN ['] , , ; IMMEDIATE
+: [COMPILE] ' , ; IMMEDIATE
+: ['] ' LITN ; IMMEDIATE
+':' X' _ 4 - C! ( give : its name )
+'(' X' _ 4 - C!

blk/396

@@ -1,16 +0,0 @@
-: (main) INTERPRET BYE ;
-: BOOT
-    0x02 RAM+ CURRENT* !
-    CURRENT @ 0x2e RAM+ ! ( 2e == BOOT C< PTR )
-    0 0x08 RAM+ !  ( 08 == C<* override )
-    ['] (emit) ['] EMIT **!
-    ['] (key) ['] KEY **!
-    ['] CRLF ['] NL **!
-    ( 0c == C<* )
-    ['] (boot<) ['] C<* **!
-    ['] C@ ['] A@ ! ['] C! ['] A! **!
-    ( boot< always has a char waiting. 06 == C<?* )
-    1 0x06 RAM+ ! INTERPRET
-    RDLN$ LIT" _sys" [entry]
-    LIT" Collapse OS" (print) NL (main) ;
-XCURRENT @ _xapply ORG @ 0x04 ( stable ABI BOOT ) + !

blk/397

@@ -1,4 +0,0 @@
-( Now we have "as late as possible" stuff. See bootstrap doc. )
-: :* ( addr -- ) (entry) 4 ( alias ) C, , ;
-: :** ( addr -- ) (entry) 5 ( switch ) C, , ;
-

blk/398

@@ -1,14 +0,0 @@
-: _bchk DUP 0x7f + 0xff > IF LIT" br ovfl" (print) ABORT THEN ;
-: DO COMPILE 2>R H@ ; IMMEDIATE
-: LOOP COMPILE (loop) H@ - _bchk C, ; IMMEDIATE
-( LEAVE is implemented in low xcomp )
-: LITN COMPILE (n) , ;
-( gets its name at the very end. can't comment afterwards )
-: _ BEGIN LIT" )" WORD S= UNTIL ; IMMEDIATE
-: _ ( : will get its name almost at the very end )
-    (entry) 1 ( compiled ) C,
-    BEGIN
-        WORD DUP LIT" ;" S= IF DROP COMPILE EXIT EXIT THEN
-        FIND IF ( is word ) DUP IMMED? IF EXECUTE ELSE , THEN
-        ELSE ( maybe number ) (parse) LITN THEN
-    AGAIN ;

blk/399

@@ -1,16 +0,0 @@
-: IF ( -- a | a: br cell addr )
-    COMPILE (?br) H@ 1 ALLOT ( br cell allot )
-; IMMEDIATE
-: THEN ( a -- | a: br cell addr )
-    DUP H@ -^ _bchk SWAP ( a-H a ) C!
-; IMMEDIATE
-: ELSE ( a1 -- a2 | a1: IF cell a2: ELSE cell )
-    COMPILE (br)
-    1 ALLOT
-    [COMPILE] THEN
-    H@ 1- ( push a. 1- for allot offset )
-; IMMEDIATE
-: LIT"
-    COMPILE (s) H@ 0 C, ,"
-    DUP H@ -^ 1- ( a len ) SWAP C!
-; IMMEDIATE

blk/400

@@ -1,13 +0,0 @@
-( We don't use ." and ABORT in core, they're not xcomp-ed )
-: ." [COMPILE] LIT" COMPILE (print) ; IMMEDIATE
-: ABORT" [COMPILE] ." COMPILE ABORT ; IMMEDIATE
-: BEGIN H@ ; IMMEDIATE
-: AGAIN COMPILE (br) H@ - _bchk C, ; IMMEDIATE
-: UNTIL COMPILE (?br) H@ - _bchk C, ; IMMEDIATE
-: [ INTERPRET ; IMMEDIATE
-: ] R> DROP ;
-: COMPILE ' LITN ['] , , ; IMMEDIATE
-: [COMPILE] ' , ; IMMEDIATE
-: ['] ' LITN ; IMMEDIATE
-':' X' _ 4 - C! ( give : its name )
-'(' X' _ 4 - C!

cvm/xcomp.fs

@@ -69,7 +69,7 @@ H@ 4 + XCURRENT ! ( make next CODE have 0 prev field )
 0x35 CODE RSHIFT
 0x36 CODE LSHIFT
 0x37 CODE TICKS
-353 LOAD  ( xcomp core low )
+353 LOAD ( xcomp core )
 : (emit) 0 PC! ;
 : (key) 0 PC@ ;
 : EFS@
@@ -85,7 +85,7 @@ H@ 4 + XCURRENT ! ( make next CODE have 0 prev field )
 : COLS 80 ; : LINES 32 ;
 : AT-XY 6 PC! ( y ) 5 PC! ( x ) ;
 
-380 LOAD  ( xcomp core high )
+390 LOAD  ( xcomp core high )
 (entry) _
 ( Update LATEST )
 PC ORG @ 8 + !

emul/8086/xcomp.fs

@@ -16,7 +16,7 @@ CODE _ BX POPx, AX POPx, 5 INT, ;CODE
 ( 8086 port doesn't define PC@ and PC!, but test harness uses
   it. Our forth binary uses INT 6 for retcode. )
 CODE PC! AX POPx, ( discard ) AX POPx, 6 INT, ;CODE
-380 LOAD  ( xcomp core high )
+390 LOAD  ( xcomp core high )
 (entry) _ ( Update LATEST ) PC ORG @ 8 + !
 ," BLK$ "
 ," ' EFS@ BLK@* ! "

emul/z80/xcomp.fs

@@ -23,7 +23,7 @@ RS_ADDR 0x80 - CONSTANT SYSVARS
 : COLS 80 ; : LINES 32 ;
 : AT-XY 6 PC! ( y ) 5 PC! ( x ) ;
 
-380 LOAD  ( xcomp core high )
+390 LOAD  ( xcomp core high )
 (entry) _
 ( Update LATEST )
 PC ORG @ 8 + !

recipes/pcat/blk/612

@@ -8,6 +8,6 @@ RS_ADDR 0x80 - CONSTANT SYSVARS
 604 LOAD  ( KEY/EMIT drivers )
 606 608 LOADR  ( BLK drivers )
 610 LOAD  ( AT-XY drivers )
-380 LOAD  ( xcomp core high )
+390 LOAD  ( xcomp core high )
 (entry) _ ( Update LATEST ) PC ORG @ 8 + !
 ," BLK$ FD$ ' FD@ BLK@* ! ' FD! BLK!* ! " EOT,

recipes/rc2014/blk/619

@@ -6,7 +6,7 @@ RS_ADDR 0x80 - CONSTANT SYSVARS
 262 LOAD  ( xcomp )            282 LOAD  ( boot.z80.decl )
 270 LOAD  ( xcomp overrides )  283 335 LOADR ( boot.z80 )
 353 LOAD  ( xcomp core low )   603 605 LOADR ( acia )
-380 LOAD  ( xcomp core high )
+390 LOAD  ( xcomp core high )
 (entry) _
 ( Update LATEST )
 PC ORG @ 8 + !

recipes/sms/xcomp.fs

@@ -29,7 +29,7 @@ CURRENT @ XCURRENT !
 CREATE ~FNT CPFNT7x7
 603 608 LOADR ( VDP )
 612 617 LOADR ( PAD )
-380 LOAD  ( xcomp core high )
+390 LOAD  ( xcomp core high )
 (entry) _
 ( Update LATEST )
 PC ORG @ 8 + !

recipes/ti84/xcomp.fs

@@ -66,7 +66,7 @@ CURRENT @ XCURRENT !
 CREATE ~FNT CPFNT3x5
 605 610 LOADR ( LCD low )
 616 620 LOADR ( KBD low )
-380 LOAD  ( xcomp core high )
+390 LOAD  ( xcomp core high )
 (entry) _
 ( Update LATEST )
 PC ORG @ 8 + !

recipes/trs80/xcomp.fs

@@ -10,7 +10,7 @@ RS_ADDR 0x80 - CONSTANT SYSVARS
 283 335 LOADR ( boot.z80 )
 353 LOAD ( xcomp core low )
 602 LOAD ( trs80 )
-380 LOAD ( xcomp core high )
+390 LOAD ( xcomp core high )
 (entry) _
 ( Update LATEST )
 PC ORG @ 8 + !

recipes/z80mbc2/xcomp.fs

@@ -34,7 +34,7 @@ CODE (key)
 : FD$ ( select disk 0 )
     0x09 ( seldisk ) 1 PC! 0 0 PC! ( sel disk 0 )
 ;
-380 LOAD  ( xcomp core high )
+390 LOAD  ( xcomp core high )
 (entry) _
 ( Update LATEST )
 PC ORG @ 8 + !