Pack core words blks a bit tighter

With all this recent movements, we had a bit of a fragmentation
issue.

blk/420

@@ -8,7 +8,6 @@ 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 cmp
+422 core                       438 print
-442 print                      446 parse
+442 fmt                        447 readln
-453 readln                     459 fmt
+453 blk
-464 blk

blk/438

@@ -0,0 +1,13 @@
+: EMIT
+    ( 0x53==(emit) override )
+    83 RAM+ @ DUP IF EXECUTE ELSE DROP (emit) THEN ;
+
+: (print)
+    BEGIN
+    C@+      ( a+1 c )
+    ( exit if null )
+    DUP NOT IF 2DROP EXIT THEN
+    EMIT     ( a )
+    AGAIN
+;
+

blk/439

@@ -0,0 +1,16 @@
+: ,"
+    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" ;
+

blk/440

@@ -0,0 +1,9 @@
+: BS 8 EMIT ;
+: LF 10 EMIT ;
+: CR 13 EMIT ;
+: CRLF CR LF ;
+: SPC 32 EMIT ;
+
+: (wnf) (print) SPC ABORT" word not found" ;
+: (ok) SPC ." ok" CRLF ;
+

blk/442

@@ -1,13 +1,16 @@
-: EMIT
+: _
-    ( 0x53==(emit) override )
+    999 SWAP        ( stop indicator )
-    83 RAM+ @ DUP IF EXECUTE ELSE DROP (emit) THEN ;
+    DUP 0 = IF '0' EXIT THEN    ( 0 is a special case )
-
-: (print)
     BEGIN
-    C@+      ( a+1 c )
+        DUP 0 = IF DROP EXIT THEN
-    ( exit if null )
+        10 /MOD         ( r q )
-    DUP NOT IF 2DROP EXIT THEN
+        SWAP '0' + SWAP ( d q )
-    EMIT     ( a )
+    AGAIN ;
-    AGAIN
+: . ( n -- )
-;
+    ( handle negative )
-
+    DUP 0< IF '-' EMIT -1 * THEN
+    _
+    BEGIN
+        DUP '9' > IF DROP EXIT THEN  ( stop indicator )
+        EMIT
+    AGAIN ;

blk/443

@@ -1,16 +1,16 @@
-: ,"
+: ? @ . ;
-    BEGIN
+: _
-        C<
+    DUP 9 > IF 10 - 'a' +
-        ( 34 is ASCII for " )
+    ELSE '0' + THEN
-        DUP 34 = IF DROP EXIT THEN C,
+;
-    AGAIN ;
+( For hex display, there are no negatives )
-
+: .x
-: ."
+    256 MOD     ( ensure < 0x100 )
-    34 , ( 34 == litWord ) ," 0 C,
+    16 /MOD     ( l h )
-    COMPILE (print)
+    _ EMIT      ( l )
-; IMMEDIATE
+    _ EMIT
-
+;
-: ABORT" [COMPILE] ." COMPILE ABORT ; IMMEDIATE
+: .X
-
+    256 /MOD    ( l h )
-: (uflw) ABORT" stack underflow" ;
+    .x .x
-
+;

blk/444

@@ -1,9 +1,16 @@
-: BS 8 EMIT ;
+: _ ( a -- a+8 )
-: LF 10 EMIT ;
+    DUP         ( save for 2nd loop )
-: CR 13 EMIT ;
+    ':' EMIT DUP .x SPC
-: CRLF CR LF ;
+    4 0 DO
-: SPC 32 EMIT ;
+        DUP @ 256 /MOD SWAP
-
+        .x .x SPC 2+
-: (wnf) (print) SPC ABORT" word not found" ;
+    LOOP
-: (ok) SPC ." ok" CRLF ;
+    DROP
-
+    8 0 DO
+        C@+
+        DUP 0x20 < OVER 0x7e > OR
+        IF DROP '.' THEN
+        EMIT
+    LOOP
+    CRLF
+;

blk/447

@@ -0,0 +1,13 @@
+64 CONSTANT INBUFSZ
+: RDLNMEM+ 0x57 RAM+ @ + ;
+( current position in INBUF )
+: IN> 0 RDLNMEM+ ;
+( points to INBUF )
+: IN( 2 RDLNMEM+ ;
+( points to INBUF's end )
+: IN) INBUFSZ 2+ RDLNMEM+ ;
+
+( flush input buffer )
+( set IN> to IN( and set IN> @ to null )
+: (infl) 0 IN( DUP IN> ! ! ;
+

blk/448

@@ -0,0 +1,16 @@
+( handle backspace: go back one char in IN>, if possible, then
+  emit SPC + BS )
+: (inbs)
+    ( already at IN( ? )
+    IN> @ IN( = IF EXIT THEN
+    IN> @ 1- IN> !
+    SPC BS
+;
+
+: KEY
+    85 RAM+ @ ( (key) override )
+    DUP IF EXECUTE ELSE DROP (key) THEN ;
+
+
+( cont.: read one char into input buffer and returns whether we
+  should continue, that is, whether CR was not met. )

blk/449

@@ -0,0 +1,16 @@
+: (rdlnc)                   ( -- f )
+    ( buffer overflow? same as if we typed a newline )
+    IN> @ IN) = IF 0x0a ELSE KEY THEN     ( c )
+    DUP 0x7f = IF DROP 0x8 THEN ( del? same as backspace )
+    DUP 0x0a = IF DROP 0xd THEN ( lf? same as cr )
+    ( echo back )
+    DUP EMIT                    ( c )
+    ( bacspace? handle and exit )
+    DUP 0x8 = IF (inbs) EXIT THEN
+    ( write and advance )
+    DUP     ( keep as result )  ( c c )
+( We take advantage of the fact that c's MSB is always zero and
+  thus ! automatically null-terminates our string )
+    IN> @ ! 1 IN> +!            ( c )
+    ( if newline, replace with zero to indicate EOL )
+    DUP 0xd = IF DROP 0 THEN ;

blk/450

@@ -0,0 +1,16 @@
+( Read one line in input buffer and make IN> point to it )
+: (rdln)
+    (infl) BEGIN (rdlnc) NOT 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/451

@@ -0,0 +1,12 @@
+( Initializes the readln subsystem )
+: RDLN$
+    ( 57 == rdln's memory )
+    H@ 0x57 RAM+ !
+    ( 2 for IN>, plus 2 for extra bytes after buffer: 1 for
+      the last typed 0x0a and one for the following NULL. )
+    INBUFSZ 4 + ALLOT
+    (infl)
+    ['] RDLN< 0x0c RAM+ !
+    1 0x06 RAM+ !  ( 06 == C<? )
+;
+

blk/453

@@ -1,13 +1,13 @@
-64 CONSTANT INBUFSZ
+: BLKMEM+ 0x59 RAM+ @ + ;
-: RDLNMEM+ 0x57 RAM+ @ + ;
+( n -- Fetches block n and write it to BLK( )
-( current position in INBUF )
+: BLK@* 0 BLKMEM+ ;
-: IN> 0 RDLNMEM+ ;
+( n -- Write back BLK( to storage at block n )
-( points to INBUF )
+: BLK!* 2 BLKMEM+ ;
-: IN( 2 RDLNMEM+ ;
+( Current blk pointer in ( )
-( points to INBUF's end )
+: BLK> 4 BLKMEM+ ;
-: IN) INBUFSZ 2+ RDLNMEM+ ;
+( Whether buffer is dirty )
+: BLKDTY 6 BLKMEM+ ;
+: BLK( 8 BLKMEM+ ;
+: BLK) BLK( 1024 + ;
 
-( flush input buffer )
-( set IN> to IN( and set IN> @ to null )
-: (infl) 0 IN( DUP IN> ! ! ;
 

blk/454

@@ -1,16 +1,12 @@
-( handle backspace: go back one char in IN>, if possible, then
+: BLK$
-  emit SPC + BS )
+    H@ 0x59 RAM+ !
-: (inbs)
+    ( 1024 for the block, 8 for variables )
-    ( already at IN( ? )
+    1032 ALLOT
-    IN> @ IN( = IF EXIT THEN
+    ( LOAD detects end of block with ASCII EOT. This is why
-    IN> @ 1- IN> !
+      we write it there. EOT == 0x04 )
-    SPC BS
+    4 C,
+    0 BLKDTY !
+    -1 BLK> !
 ;
 
-: KEY
-    85 RAM+ @ ( (key) override )
-    DUP IF EXECUTE ELSE DROP (key) THEN ;
 
-
-( cont.: read one char into input buffer and returns whether we
-  should continue, that is, whether CR was not met. )

blk/455

@@ -1,16 +1,13 @@
-: (rdlnc)                   ( -- f )
+: BLK! ( -- )
-    ( buffer overflow? same as if we typed a newline )
+    BLK> @ BLK!* @ EXECUTE
-    IN> @ IN) = IF 0x0a ELSE KEY THEN     ( c )
+    0 BLKDTY !
-    DUP 0x7f = IF DROP 0x8 THEN ( del? same as backspace )
+;
-    DUP 0x0a = IF DROP 0xd THEN ( lf? same as cr )
+: FLUSH BLKDTY @ IF BLK! THEN ;
-    ( echo back )
+: BLK@ ( n -- )
-    DUP EMIT                    ( c )
+    FLUSH
-    ( bacspace? handle and exit )
+    DUP BLK> @ = IF DROP EXIT THEN
-    DUP 0x8 = IF (inbs) EXIT THEN
+    DUP BLK> ! BLK@* @ EXECUTE
-    ( write and advance )
+;
-    DUP     ( keep as result )  ( c c )
+
-( We take advantage of the fact that c's MSB is always zero and
+: BLK!! 1 BLKDTY ! ;
-  thus ! automatically null-terminates our string )
+
-    IN> @ ! 1 IN> +!            ( c )
-    ( if newline, replace with zero to indicate EOL )
-    DUP 0xd = IF DROP 0 THEN ;

blk/456

@@ -1,16 +1,11 @@
-( Read one line in input buffer and make IN> point to it )
+: .2 DUP 10 < IF SPC THEN . ;
-: (rdln)
-    (infl) BEGIN (rdlnc) NOT UNTIL
-    LF IN( IN> ! ;
 
-( And finally, implement C<* )
+: LIST
-: RDLN<
+    BLK@
-    IN> @ C@
+    16 0 DO
-    DUP IF ( not EOL? good, inc and return )
+        I 1+ .2 SPC
-        1 IN> +!
+        64 I * BLK( + (print)
-    ELSE ( EOL ? readline. we still return null though )
+        CRLF
-        (rdln)
+    LOOP
-    THEN
-    ( update C<? flag )
-    IN> @ C@ 0 > 0x06 RAM+ !  ( 06 == C<? )
 ;
+

blk/457

@@ -1,12 +1,16 @@
-( Initializes the readln subsystem )
+: _
-: RDLN$
+    (boot<)
-    ( 57 == rdln's memory )
+    DUP 4 = IF
-    H@ 0x57 RAM+ !
+        ( We drop our char, but also "a" from WORD: it won't
-    ( 2 for IN>, plus 2 for extra bytes after buffer: 1 for
+          have the opportunity to balance PSP because we're
-      the last typed 0x0a and one for the following NULL. )
+          EXIT!ing. )
-    INBUFSZ 4 + ALLOT
+        2DROP
-    (infl)
+        ( We're finished interpreting )
-    ['] RDLN< 0x0c RAM+ !
+        EXIT!
-    1 0x06 RAM+ !  ( 06 == C<? )
+    THEN
 ;
 
+( 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/459

@@ -1,16 +1,2 @@
-: _
+( b1 b2 -- )
-    999 SWAP        ( stop indicator )
+: LOADR 1+ SWAP DO I DUP . CRLF LOAD LOOP ;
-    DUP 0 = IF '0' EXIT THEN    ( 0 is a special case )
-    BEGIN
-        DUP 0 = IF DROP EXIT THEN
-        10 /MOD         ( r q )
-        SWAP '0' + SWAP ( d q )
-    AGAIN ;
-: . ( n -- )
-    ( handle negative )
-    DUP 0< IF '-' EMIT -1 * THEN
-    _
-    BEGIN
-        DUP '9' > IF DROP EXIT THEN  ( stop indicator )
-        EMIT
-    AGAIN ;

blk/460

@@ -1,16 +0,0 @@
-: ? @ . ;
-: _
-    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/461

@@ -1,16 +0,0 @@
-: _ ( a -- a+8 )
-    DUP         ( save for 2nd loop )
-    ':' EMIT DUP .x SPC
-    4 0 DO
-        DUP @ 256 /MOD SWAP
-        .x .x SPC 2+
-    LOOP
-    DROP
-    8 0 DO
-        C@+
-        DUP 0x20 < OVER 0x7e > OR
-        IF DROP '.' THEN
-        EMIT
-    LOOP
-    CRLF
-;

blk/464

@@ -1,13 +0,0 @@
-: BLKMEM+ 0x59 RAM+ @ + ;
-( n -- Fetches block n and write it to BLK( )
-: BLK@* 0 BLKMEM+ ;
-( n -- Write back BLK( to storage at block n )
-: BLK!* 2 BLKMEM+ ;
-( Current blk pointer in ( )
-: BLK> 4 BLKMEM+ ;
-( Whether buffer is dirty )
-: BLKDTY 6 BLKMEM+ ;
-: BLK( 8 BLKMEM+ ;
-: BLK) BLK( 1024 + ;
-
-

blk/465

@@ -1,12 +0,0 @@
-: BLK$
-    H@ 0x59 RAM+ !
-    ( 1024 for the block, 8 for variables )
-    1032 ALLOT
-    ( LOAD detects end of block with ASCII EOT. This is why
-      we write it there. EOT == 0x04 )
-    4 C,
-    0 BLKDTY !
-    -1 BLK> !
-;
-
-

blk/466

@@ -1,13 +0,0 @@
-: BLK! ( -- )
-    BLK> @ BLK!* @ EXECUTE
-    0 BLKDTY !
-;
-: FLUSH BLKDTY @ IF BLK! THEN ;
-: BLK@ ( n -- )
-    FLUSH
-    DUP BLK> @ = IF DROP EXIT THEN
-    DUP BLK> ! BLK@* @ EXECUTE
-;
-
-: BLK!! 1 BLKDTY ! ;
-

blk/467

@@ -1,11 +0,0 @@
-: .2 DUP 10 < IF SPC THEN . ;
-
-: LIST
-    BLK@
-    16 0 DO
-        I 1+ .2 SPC
-        64 I * BLK( + (print)
-        CRLF
-    LOOP
-;
-

blk/468

@@ -1,16 +0,0 @@
-: _
-    (boot<)
-    DUP 4 = IF
-        ( We drop our char, but also "a" from WORD: it won't
-          have the opportunity to balance PSP because we're
-          EXIT!ing. )
-        2DROP
-        ( We're finished interpreting )
-        EXIT!
-    THEN
-;
-
-( 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/470

@@ -1,2 +0,0 @@
-( b1 b2 -- )
-: LOADR 1+ SWAP DO I DUP . CRLF LOAD LOOP ;

emul/xcomp.fs

@@ -17,6 +17,6 @@ H@ 256 /MOD 2 PC! 2 PC!
 PC ORG @ 8 + !
 ," CURRENT @ HERE ! "
 ," : (emit) 0 PC! ; : (key) 0 PC@ ; "
-422 470 XPACKR
+422 459 XPACKR
 ," ' (key) 12 RAM+ ! "
 H@ 256 /MOD 2 PC! 2 PC!

recipes/rc2014/xcomp.fs

@@ -23,11 +23,9 @@ H@ 256 /MOD 2 PC! 2 PC!
 (entry) _
 ( Update LATEST )
 PC ORG @ 8 + !
-422 441 XPACKR ( core )
+422 437 XPACKR ( core )
-446 452 XPACKR ( parse )
 358 360 XPACKR ( acia.fs )
-442 445 XPACKR ( print )
+438 452 XPACKR ( print fmt readln )
-453 463 XPACKR ( readln fmt )
 123 132 XPACKR ( linker )
 ," : _ ACIA$ RDLN$ (ok) ; _ "
 H@ 256 /MOD 2 PC! 2 PC!

recipes/trs80/xcomp.fs

@@ -18,7 +18,7 @@ H@ 256 /MOD 2 PC! 2 PC!
 ( Update LATEST )
 PC ORG @ 8 + !
 ," CURRENT @ HERE ! "
-422 470 XPACKR ( core cmp print parse readln fmt blk )
+422 459 XPACKR ( core print readln fmt blk )
 499 500 XPACKR ( trs80.fs )
 ," : _ BLK$ FD$ (ok) RDLN$ ; _ "
 H@ 256 /MOD 2 PC! 2 PC!