Pack core words a bit

This leaves space for xcomp-core which is growing.

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/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                       440 print
+430 core                       442 fmt
-442 fmt                        447 readln
+447 readln                     453 blk
-453 blk

blk/430

@@ -1,14 +1,15 @@
-: DOES>
+: [ INTERPRET ; IMMEDIATE
-    ( Overwrite cellWord in CURRENT )
+: ] R> DROP ;
-    ( 43 == doesWord )
+: LIT< WORD 34 , SCPY 0 C, ; IMMEDIATE
-    43 CURRENT @ C!
+: LITA 36 , , ;
-    ( When we have a DOES>, we forcefully place HERE to 4
+: '? WORD (find) ;
-      bytes after CURRENT. This allows a DOES word to use ","
+: '
-      and "C," without messing everything up. )
+    '? (?br) [ 4 , ] EXIT
-    CURRENT @ 3 + HERE !
+    LIT< (wnf) (find) DROP EXECUTE
-    ( HERE points to where we should write R> )
-    R> ,
-    ( We're done. Because we've popped RS, we'll exit parent
-      definition )
 ;
-
+: ['] ' 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 ;
+: _ BEGIN LIT< ) WORD S= UNTIL ; IMMEDIATE
-: CONSTANT CREATE , DOES> @ ;
+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
+  40 is ASCII for '('. We do this to simplify XPACK's task of
-  variables are sent to PS at runtime )
+  not mistakenly consider '(' definition as a comment.
-: DO COMPILE 2>R H@ ; IMMEDIATE
+  LIT<: 34 == litWord
-: LOOP COMPILE (loop) H@ - , ; IMMEDIATE
+  LITA: 36 == addrWord
-: LEAVE R> R> DROP I 1- >R >R ;
+  COMPILE: Tough one. Get addr of caller word (example above
+  (br)) and then call LITA on it. )

blk/433

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

blk/434

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

blk/435

@@ -1,13 +1,8 @@
-: WORD(
+: VARIABLE CREATE 2 ALLOT ;
-    DUP 1- C@   ( name len field )
+: CONSTANT CREATE , DOES> @ ;
-    127 AND     ( 0x7f. remove IMMEDIATE flag )
+
-    3 +         ( fixed header len )
+( 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
-: FORGET
+: LOOP COMPILE (loop) H@ - , ; IMMEDIATE
-    ' DUP               ( w w )
+: LEAVE R> R> DROP I 1- >R >R ;
-    ( HERE must be at the end of prev's word, that is, at the
-      beginning of w. )
-    WORD( HERE !  ( w )
-    PREV CURRENT !
-;

blk/436

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

@@ -0,0 +1,13 @@
+: 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

@@ -0,0 +1,10 @@
+( Drop RSP until I-2 == INTERPRET. )
+: EXIT!
+    ['] INTERPRET       ( I )
+    BEGIN               ( I )
+    DUP                 ( I I )
+    R> DROP I 2- @     ( I I a )
+    = UNTIL
+    DROP
+;
+

emul/xcomp.fs

@@ -21,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/xcomp.fs

@@ -27,7 +27,7 @@ CURRENT @ XCURRENT !
 (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

@@ -74,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

@@ -21,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$ ; _ "