blk/003

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

blk/011

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

@@ -0,0 +1,16 @@
+(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,6 +4,8 @@ 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
@@ -11,6 +13,4 @@ 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       RESERVED             +5f       FUTURE USES
++0a       PARSEPTR             +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 "(c<)" a set CINPTR to it (what C< calls).
-2. Initialize all overrides to 0.
-3. Write LATEST in BOOT C< PTR ( see below )
+1. Find "(parse)" and set "(parse*)" to it.
+2. Find "(c<)" a set CINPTR to it (what C< calls).
+3. Write LATEST in SYSTEM SCRATCHPAD ( see below )
 4. Find "INIT". If found, execute. Otherwise, "INTERPRET"(cont)

blk/090

@@ -1,7 +1,7 @@
-On a bare system (only boot+icore), this sequence will result
-in (c<) reading characters from memory starting from CURRENT
-(this is why we put CURRENT in BOOT C< PTR, it tracks current
-pos ).
+(cont.) On a bare system (only boot+icore), this sequence will
+result in "(parse)" reading only decimals and (c<) reading
+characters from memory starting from CURRENT (this is why we
+put CURRENT in SYSTEM SCRATCHPAD, it tracks current 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 = OVER 0x53 = OR OVER 0x20 = OR OVER 0x24 = OR
+    DUP <>{ 0x67 &= 0x53 |= 0x20 |= 0x24 |= <>}
     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 = OVER 0x2b = OR NOT IF
-        ( unwind all args ) 2DROP 2DROP EXIT THEN
+    DUP <>{ 0x0e &= 0x2b |= <>} NOT IF ( 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) LITN THEN
+        ELSE (parse*) @ EXECUTE LITN THEN
     THEN
     AGAIN
 ;

blk/393

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

blk/394

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

blk/399

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

blk/400

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

blk/401

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

blk/402

@@ -1,16 +1,15 @@
-: (parseb)          ( a -- n f )
-    ( '0': ASCII 0x30 'b': 0x62 0x6230: 25136 )
-    DUP @ 25136 = NOT IF 0 EXIT THEN    ( a 0 )
-    ( We have "0b" prefix )
-    2+
-    0  ( a r )
-    BEGIN
-    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 2 * +                              ( a r*2+n )
-    AGAIN
+: [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/403

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

blk/404

@@ -1,12 +1,11 @@
-: C<? 0x06 RAM+ @ ;
-: C<
-    0x08 RAM+ @  ( 08 == C<* override )
-    DUP NOT IF DROP 0x0c RAM+ @ THEN  ( 0c == C<* )
-    EXECUTE
+( 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 )
 ;
 
-: , HERE @ ! HERE @ 2+ HERE ! ;
-
-: C, HERE @ C! HERE @ 1+ HERE ! ;
-
 

blk/405

@@ -1,12 +1,15 @@
-( The NOT is to normalize the negative/positive numbers to 1
-  or 0. Hadn't we wanted to normalize, we'd have written:
-  32 CMP 1 - )
-: WS? 33 CMP 1+ NOT ;
-
-: TOWORD
-    BEGIN
-        C< DUP WS? NOT IF EXIT THEN DROP
-    AGAIN
+: BOOT
+    0x02 RAM+ CURRENT* !
+    LIT< (parse) (find) DROP (parse*) !
+    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/406

@@ -1,16 +1,14 @@
-( Read word from C<, copy to WORDBUF, null-terminate, and
-  return, make HL point to WORDBUF. )
-: WORD
-    0x0e RAM+  ( 0e == WORDBUF )
-    TOWORD     ( a c )
-    BEGIN
-        ( We take advantage of the fact that char MSB is
-          always zero to pre-write our null-termination )
-        OVER ! 1+            ( a+1 )
-        C<                   ( a c )
-        DUP WS?
-    UNTIL
-    ( a this point, PS is: a WS )
-    ( null-termination is already written )
-    2DROP
-    0x0e RAM+ ;
+( 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/407

@@ -1,10 +1,16 @@
-: SCPY
-    BEGIN         ( a )
-        DUP C@    ( a c )
-        DUP C,    ( a c )
-        NOT IF DROP EXIT THEN
-        1+        ( a+1 )
-    AGAIN
-;
-
-
+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*) @ EXECUTE LITN THEN
+    AGAIN ;
+( from PSP ) ';' SWAP 4 - C!

blk/408

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

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

blk/410

@@ -1,11 +0,0 @@
-( 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

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

@@ -1,14 +0,0 @@
-( 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

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

blk/436

@@ -8,3 +8,7 @@
     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 @@
-: EMIT
-    ( 0x53==(emit) override )
-    83 RAM+ @ DUP IF EXECUTE ELSE DROP (emit) THEN ;
+( Words useful for complex comparison operations )
+
+: >= < NOT ;
+: <= > 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,16 +1,15 @@
-: ,"
-    BEGIN
-        C<
-        ( 34 is ASCII for " )
-        DUP 34 = IF DROP EXIT THEN C,
-    AGAIN ;
 
-: ."
-    34 , ( 34 == litWord ) ," 0 C,
-    COMPILE (print)
-; IMMEDIATE
+: _|&
+    ( n1 n2 cell )
+    >R >R DUP R> R>          ( n1 n1 n2 cell )
+    @ EXECUTE                ( n1 f )
+;
 
-: ABORT" [COMPILE] ." COMPILE ABORT ; IMMEDIATE
-
-: (uflw) ABORT" stack underflow" ;
+( n1 f n2 -- n1 f )
+: _|
+    CREATE , DOES>
+    ( n1 f n2 cell )
+    ROT IF 2DROP 1 EXIT THEN ( n1 true )
+    _|&
+;
 

blk/440

@@ -1,9 +1,15 @@
-: 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 ;
+: _&
+    CREATE , DOES>
+    ( n1 f n2 cell )
+    ROT NOT IF 2DROP 0 EXIT THEN ( n1 true )
+    _|&
+;
 
+( All words below have this signature:
+  n1 f n2 -- n1 f )
+' = _| |=
+' = _& &=
+' > _| |>
+' > _& &>
+' < _| |<
+' < _& &<

blk/442

@@ -1,16 +1,13 @@
-: _
-    999 SWAP        ( stop indicator )
-    DUP 0 = IF '0' EXIT THEN    ( 0 is a special case )
+: EMIT
+    ( 0x53==(emit) override )
+    83 RAM+ @ DUP IF EXECUTE ELSE DROP (emit) THEN ;
+
+: (print)
     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 ;
+    C@+      ( a+1 c )
+    ( exit if null )
+    DUP NOT IF 2DROP EXIT THEN
+    EMIT     ( a )
+    AGAIN
+;
+

blk/443

@@ -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
-;
+: ,"
+    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/444

@@ -1,16 +1,9 @@
-: _ ( 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
-;
+: 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/446

@@ -0,0 +1,11 @@
+( 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,13 +1,15 @@
-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+ ;
+( returns negative value on error )
+: _            ( c -- n )
+    ( '0' is ASCII 48 )
+    48 -
+    DUP 0< IF EXIT THEN                 ( bad )
+    DUP 10 < IF EXIT THEN               ( good )
+    ( 'a' is ASCII 97. 59 = 97 - 48 )
+    49 -
+    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,16 +1,15 @@
-( 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
+: (parseh)          ( a -- n f )
+    ( '0': ASCII 0x30 'x': 0x78 0x7830: 30768 )
+    DUP @ 30768 = NOT IF 0 EXIT THEN    ( a 0 )
+    ( We have "0x" prefix )
+    2+
+    0  ( a r )
+    BEGIN
+    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,16 +1,11 @@
-: (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 ;
+( returns negative value on error )
+: _            ( c -- n )
+    ( '0' is ASCII 48 )
+    48 -
+    DUP 0< IF EXIT THEN                 ( bad )
+    DUP 2 < IF EXIT THEN                ( good )
+    ( bad )
+    255 -
+;
+
+

blk/450

@@ -1,16 +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<? )
+: (parseb)          ( a -- n f )
+    ( '0': ASCII 0x30 'b': 0x62 0x6230: 25136 )
+    DUP @ 25136 = NOT IF 0 EXIT THEN    ( a 0 )
+    ( We have "0b" prefix )
+    2+
+    0  ( a r )
+    BEGIN
+    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 2 * +                              ( a r*2+n )
+    AGAIN
 ;
+
+

blk/451

@@ -1,12 +1,10 @@
-( 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<? )
+: (parse)           ( a -- n )
+    (parsec) IF EXIT THEN
+    (parseh) IF EXIT THEN
+    (parseb) IF EXIT THEN
+    (parsed) IF EXIT THEN
+    ( nothing works )
+    LIT< (wnf) (find) IF EXECUTE ELSE ABORT THEN
 ;
 
+' (parse) (parse*) !

blk/453

@@ -1,13 +1,13 @@
-: 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 + ;
+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/454

@@ -1,12 +1,16 @@
-: 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> !
+( 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/455

@@ -1,13 +1,16 @@
-: 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 ! ;
-
+: (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/456

@@ -1,11 +1,16 @@
-: .2 DUP 10 < IF SPC THEN . ;
+( Read one line in input buffer and make IN> point to it )
+: (rdln)
+    (infl) BEGIN (rdlnc) NOT UNTIL
+    LF IN( IN> ! ;
 
-: LIST
-    BLK@
-    16 0 DO
-        I 1+ .2 SPC
-        64 I * BLK( + (print)
-        CRLF
-    LOOP
+( 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/457

@@ -1,16 +1,12 @@
-: _
-    (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
+( 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<? )
 ;
 
-( 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,2 +1,16 @@
-( b1 b2 -- )
-: LOADR 1+ SWAP DO I DUP . CRLF LOAD LOOP ;
+: _
+    999 SWAP        ( stop indicator )
+    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

@@ -0,0 +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
+;

blk/461

@@ -0,0 +1,16 @@
+: _ ( 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

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

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

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

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

blk/468

@@ -0,0 +1,16 @@
+: _
+    (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

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

blk/501

@@ -0,0 +1 @@
+

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 459 XPACKR
+422 470 XPACKR
 ," ' (key) 12 RAM+ ! "
 H@ 256 /MOD 2 PC! 2 PC!

recipes/rc2014/xcomp.fs

@@ -23,9 +23,11 @@ H@ 256 /MOD 2 PC! 2 PC!
 (entry) _
 ( Update LATEST )
 PC ORG @ 8 + !
-422 437 XPACKR ( core )
+422 441 XPACKR ( core cmp )
+446 452 XPACKR ( parse )
 358 360 XPACKR ( acia.fs )
-438 452 XPACKR ( print fmt readln )
+442 445 XPACKR ( print )
+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 459 XPACKR ( core print readln fmt blk )
+422 470 XPACKR ( core cmp print parse 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,2 +1,6 @@
+0x70 <>{ 0x70 &= 0x58 |= 0x20 |= <>} #
+0x71 <>{ 0x70 &= 0x58 |= 0x20 |= <>} NOT #
+0x42 <>{ 0x40 &> 0x44 &< <>} #
+0x44 <>{ 0x40 &> 0x44 &< <>} NOT #
 0x22 0x8065 < #
 -1 0 > #