Pack core words blks a bit tighter

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

blk/003

@@ -8,8 +8,8 @@ reference.
 Contents
 
  4 DOES>                        6 Compilation vs meta-comp.
- 8 I/O                         11 Chained comparisons
+ 8 I/O                         14 Addressed devices         
-14 Addressed devices           18 Signed-ness
+18 Signed-ness
 
 
 

blk/011

@@ -1,16 +0,0 @@
-Chained comparisons
-
-The unit "cmp.fs" contains words to facilitate chained
-comparisons with a single reference number. This allows, for
-example, to easily express "a == b or a == c" or "a > b and a <
-c".
-
-The way those chained comparison words work is that, unlike
-single comparison operators, they don't have a "n1 n2 -- f"
-signature, but rather a "n1 f n2 -- n1 f" signature. That is,
-each operator "carries over" the reference number in addition
-to the latest flag.
-
-
-
-                                                        (cont.)

blk/012

@@ -1,16 +0,0 @@
-(cont.) You open a chain with "<>{" and you close a chain with
-"<>}".  Then, in between those words, you can chain operators.
-For example, to check whether A == B or A == C, you would
-write:
-
-A <>{ B &= C |= <>}
-
-The first operator must be of the "&" type because the chain
-starts with its flag to true. For example, "<>{ <>}" yields
-true.
-
-To check whether A is in between B and C inclusively, you would
-write:
-
-A <>{ B 1 - &> C 1 + &< <>}
-

blk/060

@@ -4,8 +4,6 @@ I/O
                   result in n as well as whether parsing was a
                   success in f (false = failure, true =
                   success)
-(parse*) -- a     Variable holding the current pointer for
-                  system number parsing. By default, (parse).
 (print)  a --     Print string at addr a.
 .        n --     Print n in its decimal form
 .x       n --     Print n's LSB in hex form. Always 2
@@ -13,4 +11,6 @@ I/O
 .X       n --     Print n in hex form. Always 4 characters.
                   Numbers are never considered negative.
                   "-1 .X" --> ffff
+
+
                                                         (cont.)

blk/081

@@ -4,7 +4,7 @@ RAMSTART  INITIAL_SP           +55       (key) override
 +04       HERE                 +59       blk's variables
 +06       C<?                  +5b       z80a's variables
 +08       C<* override         +5d       adev's variables
-+0a       PARSEPTR             +5f       FUTURE USES
++0a       RESERVED             +5f       FUTURE USES
 +0c       C<*                  +70       DRIVERS
 +0e       WORDBUF              +80       RAMEND
 +2e       BOOT C< PTR

blk/089

@@ -10,7 +10,7 @@ very few things.
 
 In a normal system, BOOT is in icore and does a few things:
 
-1. Find "(parse)" and set "(parse*)" to it.
+1. Find "(c<)" a set CINPTR to it (what C< calls).
-2. Find "(c<)" a set CINPTR to it (what C< calls).
+2. Initialize all overrides to 0.
-3. Write LATEST in SYSTEM SCRATCHPAD ( see below )
+3. Write LATEST in BOOT C< PTR ( see below )
 4. Find "INIT". If found, execute. Otherwise, "INTERPRET"(cont)

blk/090

@@ -1,7 +1,7 @@
-(cont.) On a bare system (only boot+icore), this sequence will
+On a bare system (only boot+icore), this sequence will result
-result in "(parse)" reading only decimals and (c<) reading
+in (c<) reading characters from memory starting from CURRENT
-characters from memory starting from CURRENT (this is why we
+(this is why we put CURRENT in BOOT C< PTR, it tracks current
-put CURRENT in SYSTEM SCRATCHPAD, it tracks current pos ).
+pos ).
 
 This means that you can put initialization code in source form
 right into your binary, right after your last compiled dict

blk/123

@@ -2,7 +2,7 @@
 : ASKIP ( a -- a+n )
     DUP @       ( a n )
     ( ?br or br or NUMBER )
-    DUP <>{ 0x67 &= 0x53 |= 0x20 |= 0x24 |= <>}
+    DUP 0x67 = OVER 0x53 = OR OVER 0x20 = OR OVER 0x24 = OR
     IF DROP 4 + EXIT THEN
     ( regular word )
     0x22 = NOT IF 2+ EXIT THEN

blk/127

@@ -1,7 +1,7 @@
 : RLWORD ( ol o a1 a2 -- )
     SWAP DUP C@             ( ol o a2 a1 n )
-    DUP <>{ 0x0e &= 0x2b |= <>} NOT IF ( unwind all args )
+    DUP 0x0e = OVER 0x2b = OR NOT IF
-        2DROP 2DROP EXIT THEN
+        ( unwind all args ) 2DROP 2DROP EXIT THEN
     0x2b = IF 2+ THEN ( ol o a2 a1 )
     1+                          ( ol o a2 a1+1 )
     BEGIN                       ( ol o a2 a1 )

blk/265

@@ -8,7 +8,7 @@
     ELSE ( w )
         0x02 RAM+ @ SWAP ( cur w ) _find ( a f )
         IF DUP IMMED? NOT IF ABORT THEN EXECUTE
-        ELSE (parse*) @ EXECUTE LITN THEN
+        ELSE (parse) LITN THEN
     THEN
     AGAIN
 ;

blk/393

@@ -1,6 +1,5 @@
 : RAM+ [ RAMSTART LITN ] + ;
 : BIN+ [ BIN( @ LITN ] + ;
-: (parse*) 0x0a RAM+ ;
 : HERE 0x04 RAM+ ;
 : CURRENT* 0x51 RAM+ ;
 : CURRENT CURRENT* @ ;
@@ -13,4 +12,4 @@
     0 0x08 RAM+ !  ( 08 == C<* override )
     LIT< INTERPRET (find) DROP EXECUTE
 ;
-394 407 LOADR
+394 413 LOADR

blk/394

@@ -4,5 +4,11 @@
 : < CMP -1 = ;
 : > CMP 1 = ;
 : 0< 32767 > ;
+: >= < NOT ;
+: <= > NOT ;
+: 0>= 0< NOT ;
 
-
+( a -- a+1 c )
+: C@+ DUP C@ SWAP 1+ SWAP ;
+( c a -- a+1 )
+: C!+ SWAP OVER C! 1+ ;

blk/398

@@ -1,16 +1,11 @@
-( This is only the "early parser" in earlier stages. No need
+( strings being sent to parse routines are always null
-  for an abort message )
+  terminated )
-: (parse) (parsed) NOT IF ABORT THEN ;
 
-: C<? 0x06 RAM+ @ ;
+: (parsec)          ( a -- n f )
-: C<
+    ( apostrophe is ASCII 39 )
-    0x08 RAM+ @  ( 08 == C<* override )
+    DUP C@ 39 = OVER 2+ C@ 39 = AND     ( a f )
-    DUP NOT IF DROP 0x0c RAM+ @ THEN  ( 0c == C<* )
+    NOT IF 0 EXIT THEN   ( a 0 )
-    EXECUTE
+    ( surrounded by apos, good, return )
+    1+ C@ 1                             ( n 1 )
 ;
 
-: , HERE @ ! HERE @ 2+ HERE ! ;
-
-: C, HERE @ C! HERE @ 1+ HERE ! ;
-
-

blk/399

@@ -1,12 +1,14 @@
-( The NOT is to normalize the negative/positive numbers to 1
+( returns negative value on error )
-  or 0. Hadn't we wanted to normalize, we'd have written:
+: _            ( c -- n )
-  32 CMP 1 - )
+    ( '0' is ASCII 48 )
-: WS? 33 CMP 1+ NOT ;
+    48 -
-
+    DUP 0< ( bad ) OVER 10 < ( good ) OR IF EXIT THEN
-: TOWORD
+    ( 'a' is ASCII 97. 59 = 97 - 48 )
-    BEGIN
+    49 -
-        C< DUP WS? NOT IF EXIT THEN DROP
+    DUP 0< IF EXIT THEN                 ( bad )
-    AGAIN
+    DUP 6 < IF 10 + EXIT THEN           ( good )
+    ( bad )
+    255 -
 ;
 
 

blk/400

@@ -1,16 +1,15 @@
-( Read word from C<, copy to WORDBUF, null-terminate, and
+: (parseh)          ( a -- n f )
-  return, make HL point to WORDBUF. )
+    ( '0': ASCII 0x30 'x': 0x78 0x7830: 30768 )
-: WORD
+    DUP @ 30768 = NOT IF 0 EXIT THEN    ( a 0 )
-    0x0e RAM+  ( 0e == WORDBUF )
+    ( We have "0x" prefix )
-    TOWORD     ( a c )
+    2+
+    0  ( a r )
     BEGIN
-        ( We take advantage of the fact that char MSB is
+    SWAP C@+                            ( r a+1 c )
-          always zero to pre-write our null-termination )
+    DUP NOT IF 2DROP 1 EXIT THEN        ( r, 1 )
-        OVER ! 1+            ( a+1 )
+    _                                   ( r a n )
-        C<                   ( a c )
+    DUP 0< IF ROT 2DROP 0 EXIT THEN     ( a 0 )
-        DUP WS?
+    ROT 16 * +                          ( a r*16+n )
-    UNTIL
+    AGAIN
-    ( a this point, PS is: a WS )
+;
-    ( null-termination is already written )
+
-    2DROP
-    0x0e RAM+ ;

blk/401

@@ -1,10 +1,10 @@
-: SCPY
+( returns negative value on error )
-    BEGIN         ( a )
+: _            ( c -- n )
-        DUP C@    ( a c )
+    ( '0' is ASCII 48 )
-        DUP C,    ( a c )
+    48 -
-        NOT IF DROP EXIT THEN
+    DUP 0< ( bad ) OVER 2 < ( good ) OR IF EXIT THEN
-        1+        ( a+1 )
+    ( bad )
-    AGAIN
+    255 -
 ;
 
 

blk/402

@@ -1,15 +1,16 @@
-: [entry]
+: (parseb)          ( a -- n f )
-    HERE @       ( w h )
+    ( '0': ASCII 0x30 'b': 0x62 0x6230: 25136 )
-    SWAP SCPY    ( h )
+    DUP @ 25136 = NOT IF 0 EXIT THEN    ( a 0 )
-    ( Adjust HERE -1 because SCPY copies the null )
+    ( We have "0b" prefix )
-    HERE @ 1-    ( h h' )
+    2+
-    DUP HERE !   ( h h' )
+    0  ( a r )
-    SWAP -       ( sz )
+    BEGIN
-    ( write prev value )
+    SWAP C@+                               ( r a+1 c )
-    HERE @ CURRENT @ - ,
+    DUP NOT IF 2DROP 1 EXIT THEN           ( r 1 )
-    ( write size )
+    _                                      ( r a n )
-    C,
+    DUP 0< IF ROT 2DROP 0 EXIT THEN        ( a 0 )
-    HERE @ CURRENT !
+    ROT 2 * +                              ( a r*2+n )
+    AGAIN
 ;
 
-: (entry) WORD [entry] ;
+

blk/403

@@ -1,9 +1,8 @@
-: INTERPRET
+: (parse)           ( a -- n )
-    BEGIN
+    (parsec) IF EXIT THEN
-    WORD
+    (parseh) IF EXIT THEN
-    (find)
+    (parseb) IF EXIT THEN
-    NOT IF (parse*) @ THEN EXECUTE
+    (parsed) IF EXIT THEN
-    C<? NOT IF LIT< (ok) (find) IF EXECUTE THEN THEN
+    ( nothing works )
-    AGAIN
+    LIT< (wnf) (find) IF EXECUTE ELSE ABORT THEN
 ;
-

blk/404

@@ -1,11 +1,12 @@
-( system c< simply reads source from binary, starting at
+: C<? 0x06 RAM+ @ ;
-  LATEST. Convenient way to bootstrap a new system. )
+: C<
-: (boot<)
+    0x08 RAM+ @  ( 08 == C<* override )
-    ( 2e == BOOT C< PTR )
+    DUP NOT IF DROP 0x0c RAM+ @ THEN  ( 0c == C<* )
-    0x2e RAM+ @   ( a )
+    EXECUTE
-    DUP C@        ( a c )
-    SWAP 1 +      ( c a+1 )
-    0x2e RAM+ !   ( c )
 ;
 
+: , HERE @ ! HERE @ 2+ HERE ! ;
+
+: C, HERE @ C! HERE @ 1+ HERE ! ;
+
 

blk/405

@@ -1,15 +1,12 @@
-: BOOT
+( The NOT is to normalize the negative/positive numbers to 1
-    0x02 RAM+ CURRENT* !
+  or 0. Hadn't we wanted to normalize, we'd have written:
-    LIT< (parse) (find) DROP (parse*) !
+  32 CMP 1 - )
-    CURRENT @ 0x2e RAM+ ! ( 2e == BOOT C< PTR )
+: WS? 33 CMP 1+ NOT ;
-    0 0x08 RAM+ !  ( 08 == C<* override )
+
-    0 0x53 RAM+ !  ( 53 == (emit) override )
+: TOWORD
-    0 0x55 RAM+ !  ( 55 == (key) override )
+    BEGIN
-    ( 0c == C<* )
+        C< DUP WS? NOT IF EXIT THEN DROP
-    LIT< (boot<) (find) DROP 0x0c RAM+ !
+    AGAIN
-    ( boot< always has a char waiting. 06 == C<?* )
-    1 0x06 RAM+ !
-    LIT< INIT (find)
-    IF EXECUTE ELSE DROP INTERPRET THEN
 ;
 
+

blk/406

@@ -1,14 +1,16 @@
-( LITN has to be defined after the last immediate usage of
+( Read word from C<, copy to WORDBUF, null-terminate, and
-  it to avoid bootstrapping issues )
+  return, make HL point to WORDBUF. )
-: LITN 32 , , ( 32 == NUMBER ) ;
+: WORD
-
+    0x0e RAM+  ( 0e == WORDBUF )
-: IMMED? 1- C@ 0x80 AND ;
+    TOWORD     ( a c )
-
+    BEGIN
-( ';' can't have its name right away because, when created, it
+        ( We take advantage of the fact that char MSB is
-  is not an IMMEDIATE yet and will not be treated properly by
+          always zero to pre-write our null-termination )
-  xcomp. )
+        OVER ! 1+            ( a+1 )
-: _
+        C<                   ( a c )
-    ['] EXIT ,
+        DUP WS?
-    R> DROP     ( exit : )
+    UNTIL
-; IMMEDIATE
+    ( a this point, PS is: a WS )
-
+    ( null-termination is already written )
+    2DROP
+    0x0e RAM+ ;

blk/407

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

blk/408

@@ -0,0 +1,15 @@
+: [entry]
+    HERE @       ( w h )
+    SWAP SCPY    ( h )
+    ( Adjust HERE -1 because SCPY copies the null )
+    HERE @ 1-    ( h h' )
+    DUP HERE !   ( h h' )
+    SWAP -       ( sz )
+    ( write prev value )
+    HERE @ CURRENT @ - ,
+    ( write size )
+    C,
+    HERE @ CURRENT !
+;
+
+: (entry) WORD [entry] ;

blk/409

@@ -0,0 +1,9 @@
+: INTERPRET
+    BEGIN
+    WORD
+    (find)
+    NOT IF (parse) ELSE EXECUTE THEN
+    C<? NOT IF LIT< (ok) (find) IF EXECUTE THEN THEN
+    AGAIN
+;
+

blk/410

@@ -0,0 +1,11 @@
+( system c< simply reads source from binary, starting at
+  LATEST. Convenient way to bootstrap a new system. )
+: (boot<)
+    ( 2e == BOOT C< PTR )
+    0x2e RAM+ @   ( a )
+    DUP C@        ( a c )
+    SWAP 1 +      ( c a+1 )
+    0x2e RAM+ !   ( c )
+;
+
+

blk/411

@@ -0,0 +1,14 @@
+: BOOT
+    0x02 RAM+ CURRENT* !
+    CURRENT @ 0x2e RAM+ ! ( 2e == BOOT C< PTR )
+    0 0x08 RAM+ !  ( 08 == C<* override )
+    0 0x53 RAM+ !  ( 53 == (emit) override )
+    0 0x55 RAM+ !  ( 55 == (key) override )
+    ( 0c == C<* )
+    LIT< (boot<) (find) DROP 0x0c RAM+ !
+    ( boot< always has a char waiting. 06 == C<?* )
+    1 0x06 RAM+ !
+    LIT< INIT (find)
+    IF EXECUTE ELSE DROP INTERPRET THEN
+;
+

blk/412

@@ -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/413

@@ -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/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/436

@@ -8,7 +8,3 @@
     DROP
 ;
 
-( a -- a+1 c )
-: C@+ DUP C@ SWAP 1+ SWAP ;
-( c a -- a+1 )
-: C!+ SWAP OVER C! 1+ ;

blk/438

@@ -1,13 +1,13 @@
-( Words useful for complex comparison operations )
+: EMIT
-
+    ( 0x53==(emit) override )
-: >= < NOT ;
+    83 RAM+ @ DUP IF EXECUTE ELSE DROP (emit) THEN ;
-: <= > NOT ;
-: 0>= 0< NOT ;
-
-( n1 -- n1 true )
-: <>{ 1 ;
-
-( n1 f -- f )
-: <>} SWAP DROP ;
 
+: (print)
+    BEGIN
+    C@+      ( a+1 c )
+    ( exit if null )
+    DUP NOT IF 2DROP EXIT THEN
+    EMIT     ( a )
+    AGAIN
+;
 

blk/439

@@ -1,15 +1,16 @@
+: ,"
+    BEGIN
+        C<
+        ( 34 is ASCII for " )
+        DUP 34 = IF DROP EXIT THEN C,
+    AGAIN ;
 
-: _|&
+: ."
-    ( n1 n2 cell )
+    34 , ( 34 == litWord ) ," 0 C,
-    >R >R DUP R> R>          ( n1 n1 n2 cell )
+    COMPILE (print)
-    @ EXECUTE                ( n1 f )
+; IMMEDIATE
-;
 
-( n1 f n2 -- n1 f )
+: ABORT" [COMPILE] ." COMPILE ABORT ; IMMEDIATE
-: _|
+
-    CREATE , DOES>
+: (uflw) ABORT" stack underflow" ;
-    ( n1 f n2 cell )
-    ROT IF 2DROP 1 EXIT THEN ( n1 true )
-    _|&
-;
 

blk/440

@@ -1,15 +1,9 @@
-: _&
+: BS 8 EMIT ;
-    CREATE , DOES>
+: LF 10 EMIT ;
-    ( n1 f n2 cell )
+: CR 13 EMIT ;
-    ROT NOT IF 2DROP 0 EXIT THEN ( n1 true )
+: CRLF CR LF ;
-    _|&
+: SPC 32 EMIT ;
-;
+
+: (wnf) (print) SPC ABORT" word not found" ;
+: (ok) SPC ." ok" CRLF ;
 
-( All words below have this signature:
-  n1 f n2 -- n1 f )
-' = _| |=
-' = _& &=
-' > _| |>
-' > _& &>
-' < _| |<
-' < _& &<

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/446

@@ -1,11 +0,0 @@
-( strings being sent to parse routines are always null
-  terminated )
-
-: (parsec)          ( a -- n f )
-    ( apostrophe is ASCII 39 )
-    DUP C@ 39 = NOT IF 0 EXIT THEN      ( a 0 )
-    DUP 2+ C@ 39 = NOT IF 0 EXIT THEN   ( a 0 )
-    ( surrounded by apos, good, return )
-    1+ C@ 1                             ( n 1 )
-;
-

blk/447

@@ -1,15 +1,13 @@
-( returns negative value on error )
+64 CONSTANT INBUFSZ
-: _            ( c -- n )
+: RDLNMEM+ 0x57 RAM+ @ + ;
-    ( '0' is ASCII 48 )
+( current position in INBUF )
-    48 -
+: IN> 0 RDLNMEM+ ;
-    DUP 0< IF EXIT THEN                 ( bad )
+( points to INBUF )
-    DUP 10 < IF EXIT THEN               ( good )
+: IN( 2 RDLNMEM+ ;
-    ( 'a' is ASCII 97. 59 = 97 - 48 )
+( points to INBUF's end )
-    49 -
+: IN) INBUFSZ 2+ RDLNMEM+ ;
-    DUP 0< IF EXIT THEN                 ( bad )
-    DUP 6 < IF 10 + EXIT THEN           ( good )
-    ( bad )
-    255 -
-;
 
+( flush input buffer )
+( set IN> to IN( and set IN> @ to null )
+: (infl) 0 IN( DUP IN> ! ! ;
 

blk/448

@@ -1,15 +1,16 @@
-: (parseh)          ( a -- n f )
+( handle backspace: go back one char in IN>, if possible, then
-    ( '0': ASCII 0x30 'x': 0x78 0x7830: 30768 )
+  emit SPC + BS )
-    DUP @ 30768 = NOT IF 0 EXIT THEN    ( a 0 )
+: (inbs)
-    ( We have "0x" prefix )
+    ( already at IN( ? )
-    2+
+    IN> @ IN( = IF EXIT THEN
-    0  ( a r )
+    IN> @ 1- IN> !
-    BEGIN
+    SPC BS
-    SWAP C@+                            ( r a+1 c )
-    DUP NOT IF 2DROP 1 EXIT THEN        ( r, 1 )
-    _                                   ( r a n )
-    DUP 0< IF ROT 2DROP 0 EXIT THEN     ( a 0 )
-    ROT 16 * +                          ( a r*16+n )
-    AGAIN
 ;
 
+: 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

@@ -1,11 +1,16 @@
-( returns negative value on error )
+: (rdlnc)                   ( -- f )
-: _            ( c -- n )
+    ( buffer overflow? same as if we typed a newline )
-    ( '0' is ASCII 48 )
+    IN> @ IN) = IF 0x0a ELSE KEY THEN     ( c )
-    48 -
+    DUP 0x7f = IF DROP 0x8 THEN ( del? same as backspace )
-    DUP 0< IF EXIT THEN                 ( bad )
+    DUP 0x0a = IF DROP 0xd THEN ( lf? same as cr )
-    DUP 2 < IF EXIT THEN                ( good )
+    ( echo back )
-    ( bad )
+    DUP EMIT                    ( c )
-    255 -
+    ( 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

@@ -1,16 +1,16 @@
-: (parseb)          ( a -- n f )
+( Read one line in input buffer and make IN> point to it )
-    ( '0': ASCII 0x30 'b': 0x62 0x6230: 25136 )
+: (rdln)
-    DUP @ 25136 = NOT IF 0 EXIT THEN    ( a 0 )
+    (infl) BEGIN (rdlnc) NOT UNTIL
-    ( We have "0b" prefix )
+    LF IN( IN> ! ;
-    2+
+
-    0  ( a r )
+( And finally, implement C<* )
-    BEGIN
+: RDLN<
-    SWAP C@+                               ( r a+1 c )
+    IN> @ C@
-    DUP NOT IF 2DROP 1 EXIT THEN           ( r 1 )
+    DUP IF ( not EOL? good, inc and return )
-    _                                      ( r a n )
+        1 IN> +!
-    DUP 0< IF ROT 2DROP 0 EXIT THEN        ( a 0 )
+    ELSE ( EOL ? readline. we still return null though )
-    ROT 2 * +                              ( a r*2+n )
+        (rdln)
-    AGAIN
+    THEN
+    ( update C<? flag )
+    IN> @ C@ 0 > 0x06 RAM+ !  ( 06 == C<? )
 ;
-
-

blk/451

@@ -1,10 +1,12 @@
-: (parse)           ( a -- n )
+( Initializes the readln subsystem )
-    (parsec) IF EXIT THEN
+: RDLN$
-    (parseh) IF EXIT THEN
+    ( 57 == rdln's memory )
-    (parseb) IF EXIT THEN
+    H@ 0x57 RAM+ !
-    (parsed) IF EXIT THEN
+    ( 2 for IN>, plus 2 for extra bytes after buffer: 1 for
-    ( nothing works )
+      the last typed 0x0a and one for the following NULL. )
-    LIT< (wnf) (find) IF EXECUTE ELSE ABORT THEN
+    INBUFSZ 4 + ALLOT
+    (infl)
+    ['] RDLN< 0x0c RAM+ !
+    1 0x06 RAM+ !  ( 06 == C<? )
 ;
 
-' (parse) (parse*) !

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 &< 0x7e |> <>}
-        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 ;

blk/501

@@ -1 +0,0 @@
-

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

tests/forth/test_cmp.fs

@@ -1,6 +1,2 @@
-0x70 <>{ 0x70 &= 0x58 |= 0x20 |= <>} #
-0x71 <>{ 0x70 &= 0x58 |= 0x20 |= <>} NOT #
-0x42 <>{ 0x40 &> 0x44 &< <>} #
-0x44 <>{ 0x40 &> 0x44 &< <>} NOT #
 0x22 0x8065 < #
 -1 0 > #