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 )
+: _pd ( a -- n f, parse decimal )
-( Parse digit c and accumulate into result r.
+( We read the first char outside of the loop because it *has*
-  Flag f is 0 when c was a valid digit, 1 when c was WS,
+  to be nonzero, which means _pdacc *has* to return 0. )
-  -1 when c was an invalid digit. )
+    C@+ OVER C@ 0 ( a len firstchar startat )
-: _pdacc
+( if we have '-', we only advance. more processing later. )
-    DUP 0x21 < IF DROP 1 EXIT THEN
+    SWAP '-' = IF 1+ THEN ( a len startat )
-    ( parse char )
+( We loop until _pdacc is nonzero, which means either WS or
-    ( if bad, return "r -1" )
+  non-digit. 1 means WS, which means parsing was a success.
-    '0' -
+  -1 means non-digit, which means we have a non-decimal. )
-    DUP 10 < NOT IF DROP -1 EXIT THEN
+    0 ROT ROT ( len ) ( startat ) DO ( a r )
-    ( good, add to running result )
+        OVER I + C@ ( a r c ) _pdacc ( a r f )
-    SWAP 10 * +                    ( r*10+n )
+        IF DROP 1- 0 UNLOOP EXIT THEN LOOP ( a r )
-    0                              ( good )
+( 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 )
+( strings being sent to parse routines are always null
-( We read the first char outside of the loop because it *has*
+  terminated )
-  to be nonzero, which means _pdacc *has* to return 0. )
+
-    C@+ OVER C@ 0 ( a len firstchar startat )
+: _pc ( a -- n f, parse character )
-( if we have '-', we only advance. more processing later. )
+    ( apostrophe is ASCII 39 )
-    SWAP '-' = IF 1+ THEN ( a len startat )
+    DUP 1+ C@ 39 = OVER 3 + C@ 39 = AND  ( a f )
-( We loop until _pdacc is nonzero, which means either WS or
+    NOT IF 0 EXIT THEN   ( a 0 )
-  non-digit. 1 means WS, which means parsing was a success.
+    ( surrounded by apos, good, return )
-  -1 means non-digit, which means we have a non-decimal. )
+    2+ C@ 1                             ( n 1 )
-    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/360

@@ -1,10 +1,16 @@
-( strings being sent to parse routines are always null
+( returns negative value on error )
-  terminated )
+: _            ( c -- n )
-
+    DUP '0' '9' =><= IF '0' - EXIT THEN
-: _pc ( a -- n f, parse character )
+    DUP 'a' 'f' =><= IF 0x57 ( 'a' - 10 ) - EXIT THEN
-    ( apostrophe is ASCII 39 )
+    DROP -1 ( bad )
-    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 )
 ;
+: _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 '0' '1' =><= IF '0' - EXIT THEN
-    DUP 'a' 'f' =><= IF 0x57 ( 'a' - 10 ) - EXIT THEN
     DROP -1 ( bad )
 ;
-: _ph          ( a -- n f, parse hex )
+: _pb          ( a -- n f, parse binary )
-    ( '0': ASCII 0x30 'x': 0x78 0x7830 )
+    ( '0': ASCII 0x30 'b': 0x62 0x6230 )
-    DUP 1+ @ 0x7830 = NOT IF 0 EXIT THEN ( a 0 )
+    DUP 1+ @ 0x6230 = NOT IF 0 EXIT THEN ( a 0 )
-    ( We have "0x" prefix )
+    ( 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 )
+: (parse)           ( a -- n )
-: _            ( c -- n )
+    _pc IF EXIT THEN
-    DUP '0' '1' =><= IF '0' - EXIT THEN
+    _ph IF EXIT THEN
-    DROP -1 ( bad )
+    _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 )
+: C<? 0x06 RAM+ @ ;
-    _pc IF EXIT THEN
+SYSVARS 0x0c + :** C<*
-    _ph IF EXIT THEN
+: C<
-    _pb IF EXIT THEN
+    0x08 RAM+ ( C<* override ) @
-    _pd IF EXIT THEN
+    ?DUP NOT IF C<* ELSE EXECUTE THEN ;
-    ( nothing works )
+: , H@ ! H@ 2+ HERE ! ;
-    (wnf)
+: 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+ @ ;
+: WS? 33 < ;
-SYSVARS 0x0c + :** C<*
+: EOT? 4 = ; ( 4 == ASCII EOT, CTRL+D )
-: C<
+: EOT, 4 C, ;
-    0x08 RAM+ ( C<* override ) @
+
-    ?DUP NOT IF C<* ELSE EXECUTE THEN ;
+: TOWORD
-: , H@ ! H@ 2+ HERE ! ;
+    0 ( dummy ) BEGIN
-: C, H@ C! H@ 1+ HERE ! ;
+        DROP C< DUP WS? NOT OVER EOT? OR
-: ,"
+    UNTIL ;
-    BEGIN
-        C< DUP 34 ( ASCII " ) = IF DROP EXIT THEN C,
-    AGAIN ;

blk/365

@@ -1,8 +1,13 @@
-: WS? 33 < ;
+( Read word from C<, copy to WORDBUF, null-terminate, and
-: EOT? 4 = ; ( 4 == ASCII EOT, CTRL+D )
+  return WORDBUF. )
-: EOT, 4 C, ;
+: _wb 0x0e RAM+ ;
-
+: _eot 0x0401 _wb ! _wb ;
-: TOWORD
+: WORD
-    0 ( dummy ) BEGIN
+    _wb 1+ TOWORD ( a c )
-        DROP C< DUP WS? NOT OVER EOT? OR
+    DUP EOT? IF 2DROP _eot EXIT THEN
-    UNTIL ;
+    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
+: IMMEDIATE
-  return WORDBUF. )
+    CURRENT @ 1-
-: _wb 0x0e RAM+ ;
+    DUP C@ 128 OR SWAP C! ;
-: _eot 0x0401 _wb ! _wb ;
+: IMMED? 1- C@ 0x80 AND ;
-: WORD
+: '? WORD FIND ;
-    _wb 1+ TOWORD ( a c )
+: ' '? NOT IF (wnf) THEN ;
-    DUP EOT? IF 2DROP _eot EXIT THEN
+: ROLL
-    BEGIN
+    ?DUP NOT IF EXIT THEN
-        OVER C! 1+ C< ( a c )
+    1+ DUP PICK          ( n val )
-        OVER 0x2e RAM+ = OVER WS? OR
+    SWAP 2 * (roll)      ( val )
-    UNTIL ( a c )
+    NIP ;
-    SWAP _wb - 1- ( ws len ) _wb C!
+: 2OVER 3 PICK 3 PICK ;
-    EOT? IF _eot ELSE _wb THEN ;
+: 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
+: WORD(
-    CURRENT @ 1-
+    DUP 1- C@   ( name len field )
-    DUP C@ 128 OR SWAP C! ;
+    127 AND     ( 0x7f. remove IMMEDIATE flag )
-: IMMED? 1- C@ 0x80 AND ;
+    3 +         ( fixed header len )
-: '? WORD FIND ;
+    -
-: ' '? NOT IF (wnf) THEN ;
+;
-: ROLL
+: FORGET
-    ?DUP NOT IF EXIT THEN
+    ' DUP               ( w w )
-    1+ DUP PICK          ( n val )
+    ( HERE must be at the end of prev's word, that is, at the
-    SWAP 2 * (roll)      ( val )
+      beginning of w. )
-    NIP ;
+    WORD( HERE !  ( w )
-: 2OVER 3 PICK 3 PICK ;
+    PREV CURRENT !
-: 2SWAP 3 ROLL 3 ROLL ;
+;
+: EMPTY LIT" _sys" FIND IF DUP HERE ! CURRENT ! THEN ;

blk/370

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

blk/371

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

blk/372

@@ -1,14 +1,10 @@
-: WORD(
+( n -- Fetches block n and write it to BLK( )
-    DUP 1- C@   ( name len field )
+: BLK@* 0x34 RAM+ ;
-    127 AND     ( 0x7f. remove IMMEDIATE flag )
+( n -- Write back BLK( to storage at block n )
-    3 +         ( fixed header len )
+: BLK!* 0x36 RAM+ ;
-    -
+( Current blk pointer in ( )
-;
+: BLK> 0x38 RAM+ ;
-: FORGET
+( Whether buffer is dirty )
-    ' DUP               ( w w )
+: BLKDTY 0x3a RAM+ ;
-    ( HERE must be at the end of prev's word, that is, at the
+: BLK( 0x3c RAM+ @ ;
-      beginning of w. )
+: BLK) BLK( 1024 + ;
-    WORD( HERE !  ( w )
-    PREV CURRENT !
-;
-: EMPTY LIT" _sys" FIND IF DUP HERE ! CURRENT ! THEN ;

blk/373

@@ -1,13 +1,9 @@
-: DOES>
+: BLK$
-    ( Overwrite cellWord in CURRENT )
+    H@ 0x3c ( BLK(* ) RAM+ !
-    3 ( does ) CURRENT @ C!
+    1024 ALLOT
-    ( When we have a DOES>, we forcefully place HERE to 4
+    ( LOAD detects end of block with ASCII EOT. This is why
-      bytes after CURRENT. This allows a DOES word to use ","
+      we write it there. )
-      and "C," without messing everything up. )
+    EOT,
-    CURRENT @ 3 + HERE !
+    0 BLKDTY !
-    ( HERE points to where we should write R> )
+    -1 BLK> !
-    R> ,
-    ( We're done. Because we've popped RS, we'll exit parent
-      definition )
 ;
-: CONSTANT CREATE , DOES> @ ;

blk/374

@@ -1,4 +1,14 @@
-: [IF]
+: BLK! ( -- )
-    IF EXIT THEN
+    BLK> @ BLK!* @ EXECUTE
-    LIT" [THEN]" BEGIN DUP WORD S= UNTIL DROP ;
+    0 BLKDTY ! ;
-: [THEN] ;
+: 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 )
+    DUP 9 > IF 10 - 'a' +
-: BLK!* 0x36 RAM+ ;
+    ELSE '0' + THEN
-( Current blk pointer in ( )
+;
-: BLK> 0x38 RAM+ ;
+( For hex display, there are no negatives )
-( Whether buffer is dirty )
+: .x
-: BLKDTY 0x3a RAM+ ;
+    256 MOD     ( ensure < 0x100 )
-: BLK( 0x3c RAM+ @ ;
+    16 /MOD     ( l h )
-: BLK) BLK( 1024 + ;
+    _ EMIT      ( l )
+    _ EMIT
+;
+: .X
+    256 /MOD    ( l h )
+    .x .x
+;

blk/377

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

blk/378

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

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 @@
-: _
+: INTERPRET
-    999 SWAP        ( stop indicator )
     BEGIN
-        ?DUP NOT IF EXIT THEN
+    WORD DUP @ 0x0401 = ( EOT ) IF DROP EXIT THEN
-        10 /MOD         ( r q )
+    FIND NOT IF (parse) ELSE EXECUTE THEN
-        SWAP '0' + SWAP ( d q )
+    C<? NOT IF SPC LIT" ok" (print) NL THEN
-    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 ;
+( 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 @@
-: ? @ . ;
+: LOAD
-: _
+    BLK> @ >R ( save restorable variables to RSP )
-    DUP 9 > IF 10 - 'a' +
+    0x08 RAM+ @ >R  ( 08 == C<* override )
-    ELSE '0' + THEN
+    0x06 RAM+ @ >R  ( C<? )
-;
+    0x2e RAM+ @ >R  ( boot ptr )
-( For hex display, there are no negatives )
+    BLK@
-: .x
+    BLK( 0x2e RAM+ ! ( Point to beginning of BLK )
-    256 MOD     ( ensure < 0x100 )
+    ['] (boot<) 0x08 RAM+ !
-    16 /MOD     ( l h )
+    1 0x06 RAM+ !  ( 06 == C<? )
-    _ EMIT      ( l )
+    INTERPRET
-    _ EMIT
+    R> 0x2e RAM+ ! R> 0x06 RAM+ !
-;
+    I 0x08 RAM+ @ = IF ( nested load )
-: .X
+        R> DROP ( C<* ) R> BLK@
-    256 /MOD    ( l h )
+    ELSE ( not nested )
-    .x .x
+        R> 0x08 RAM+ ! R> DROP ( BLK> )
-;
+    THEN ;

blk/385

@@ -1,13 +1,15 @@
-: _ ( a -- a+8 )
+: LOAD+ BLK> @ + LOAD ;
-    DUP ( a a )
+( b1 b2 -- )
-    ':' EMIT DUP .x SPC
+: LOADR 1+ SWAP DO I DUP . NL LOAD LOOP ;
-    4 0 DO DUP @ 256 /MOD SWAP .x .x SPC 2+ LOOP
+: LOADR+ BLK> @ + SWAP BLK> @ + SWAP LOADR ;
-    DROP ( a )
+( Now, adev stuff )
-    8 0 DO
+SYSVARS 0x3e + :** A@
-        C@+ DUP 0x20 0x7e =><= NOT IF DROP '.' THEN EMIT
+SYSVARS 0x40 + :** A!
-    LOOP NL ;
+
-: DUMP ( n a -- )
+( src dst u -- )
-    LF
+: AMOVE
-    SWAP 8 /MOD SWAP IF 1+ THEN
+    ( u ) 0 DO
-    0 DO _ LOOP
+        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 )
+( xcomp core high )
-: RDLN$
+: (main) INTERPRET BYE ;
-    H@ 0x32 ( IN(* ) RAM+ !
+: BOOT
-    ( plus 2 for extra bytes after buffer: 1 for
+    0x02 RAM+ CURRENT* !
-      the last typed 0x0a and one for the following NULL. )
+    CURRENT @ 0x2e RAM+ ! ( 2e == BOOT C< PTR )
-    IN) IN( - ALLOT
+    0 0x08 RAM+ !  ( 08 == C<* override )
-    (infl)
+    ['] (emit) ['] EMIT **! ['] (key) ['] KEY **!
-    ['] RDLN< ['] C<* **!
+    ['] CRLF ['] NL **!
-    1 0x06 RAM+ !  ( 06 == 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 ) + !
+1 4 LOADR+

blk/391

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

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
+        WORD DUP LIT" ;" S= IF DROP COMPILE EXIT EXIT THEN
-    FIND NOT IF (parse) ELSE EXECUTE THEN
+        FIND IF ( is word ) DUP IMMED? IF EXECUTE ELSE , THEN
-    C<? NOT IF SPC LIT" ok" (print) NL 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
+: IF ( -- a | a: br cell addr )
-    BLK> @ >R ( save restorable variables to RSP )
+    COMPILE (?br) H@ 1 ALLOT ( br cell allot )
-    0x08 RAM+ @ >R  ( 08 == C<* override )
+; IMMEDIATE
-    0x06 RAM+ @ >R  ( C<? )
+: THEN ( a -- | a: br cell addr )
-    0x2e RAM+ @ >R  ( boot ptr )
+    DUP H@ -^ _bchk SWAP ( a-H a ) C!
-    BLK@
+; IMMEDIATE
-    BLK( 0x2e RAM+ ! ( Point to beginning of BLK )
+: ELSE ( a1 -- a2 | a1: IF cell a2: ELSE cell )
-    ['] (boot<) 0x08 RAM+ !
+    COMPILE (br)
-    1 0x06 RAM+ !  ( 06 == C<? )
+    1 ALLOT
-    INTERPRET
+    [COMPILE] THEN
-    R> 0x2e RAM+ ! R> 0x06 RAM+ !
+    H@ 1- ( push a. 1- for allot offset )
-    I 0x08 RAM+ @ = IF ( nested load )
+; IMMEDIATE
-        R> DROP ( C<* ) R> BLK@
+: LIT"
-    ELSE ( not nested )
+    COMPILE (s) H@ 0 C, ,"
-        R> 0x08 RAM+ ! R> DROP ( BLK> )
+    DUP H@ -^ 1- ( a len ) SWAP C!
-    THEN ;
+; IMMEDIATE

blk/394

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

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