blk/003

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

blk/018

@@ -1,9 +0,0 @@
-Signed-ness
-
-For simplicity purposes, numbers are generally considered
-unsigned. For convenience, decimal parsing and formatting
-support the "-" prefix, but under the hood, it's all unsigned.
-
-This leads to some oddities. For example, "-1 0 <" is false.
-To compare whether something is negative, use the "<0" word
-which is the equivalent to "0x7fff >".

blk/058

@@ -5,6 +5,6 @@ LIT    --         Write a LIT entry. You're expected to write
 LIT< x --         Read following word and write to HERE as a
                   string literal.
 LITS   a --       Write word at addr a as a atring literal.
-S=     a1 a2 -- f Returns whether string a1 == a2.
+SCMP   a1 a2 -- n Compare strings a1 and a2. See CMP
 SCPY   a --       Copy string at addr a into HERE.
 SLEN   a -- n     Push length of str at a.

emul/Makefile

@@ -22,8 +22,6 @@ all: $(TARGETS)
 
 $(BLKPACK):
 	$(MAKE) -C ../tools
-
-.PHONY: $(STRIPFC) $(SLATEST) $(BIN2C)
 $(STRIPFC): $(BLKPACK)
 $(SLATEST): $(BLKPACK)
 $(BIN2C): $(BLKPACK)

emul/forth/forth.c

@@ -118,9 +118,7 @@ int main(int argc, char *argv[])
         tcsetattr(0, TCSAFLUSH, &termInfo);
         emul_printdebug();
     }
-    if (blkfp != NULL) {
-        fclose(blkfp);
-    }
+    fclose(blkfp);
     fclose(fp);
     return retcode;
 }

forth/boot.fs

@@ -27,7 +27,7 @@ NOP, NOP,         ( 20, numberWord )
 NOP, NOP,         ( 22, litWord )
 NOP, NOP,         ( 24, addrWord )
 NOP, NOP,         ( 26, unused )
-RAMSTART 0x4e + JPnn, ( 28, RST 28 )
+0 JPnn,           ( 28, flagsToBC )
 0 JPnn,           ( 2b, doesWord )
 NOP, NOP,         ( 2e, unused )
 RAMSTART 0x4e + JPnn, ( RST 30 )
@@ -201,7 +201,7 @@ L4 FSET L3 FSET ( loopend )
     ( HL is prev field's addr. Is offset zero? )
     A D LDrr,
     E ORr,
-    IFNZ, ( noprev )
+    IFZ, ( noprev )
         ( get absolute addr from offset )
         ( carry cleared from "or e" )
         DE SBCHLss,
@@ -218,6 +218,16 @@ L4 FSET ( end )
     BC POPqq,
     RET,
 
+PC ORG @ 0x29 + ! ( flagsToBC )
+    BC 0 LDddnn,
+    CZ RETcc, ( equal )
+    BC INCss,
+    CC RETcc, ( > )
+    ( < )
+    BC DECss,
+    BC DECss,
+    RET,
+
 PC ORG @ 0x12 + ! ( pushRS )
     IX INCss,
     IX INCss,

forth/cmp.fs

@@ -2,8 +2,6 @@
 
 : >= < NOT ;
 : <= > NOT ;
-: <0 32767 > ;
-: >=0 <0 NOT ;
 
 ( n1 -- n1 true )
 : <>{ 1 ;

forth/core.fs

@@ -18,7 +18,7 @@
 : BEGIN H@ ; IMMEDIATE
 : AGAIN COMPILE (br) H@ - , ; IMMEDIATE
 : UNTIL COMPILE (?br) H@ - , ; IMMEDIATE
-: ( BEGIN LIT< ) WORD S= UNTIL ; IMMEDIATE
+: ( BEGIN LIT< ) WORD SCMP NOT UNTIL ; IMMEDIATE
 ( 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

forth/fmt.fs

@@ -12,7 +12,9 @@
 
 : .               ( n -- )
     ( handle negative )
-    DUP <0 IF '-' EMIT -1 * THEN
+    ( that "0 1 -" thing is because we don't parse negative
+      number correctly yet. )
+    DUP 0 < IF '-' EMIT 0 1 - * THEN
     _
     BEGIN
     DUP '9' > IF DROP EXIT THEN ( stop indicator, we're done )

forth/icore.fs

@@ -52,52 +52,37 @@
 : < CMP -1 = ;
 : > CMP 1 = ;
 
-( 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 )
-    '0' -
-    ( if bad, return "r -1" )
-    DUP 0 < IF DROP -1 EXIT THEN   ( bad )
-    DUP 9 > IF DROP -1 EXIT THEN   ( bad )
-    ( good, add to running result )
-    SWAP 10 * +                    ( r*10+n )
-    0                              ( good )
-;
-
 : (parsed)      ( a -- n f )
     ( read first char outside of the loop. it *has* to be
       nonzero. )
-    DUP C@                        ( a c )
+    DUP C@                    ( a c )
+    DUP NOT IF EXIT THEN      ( a 0 )
     ( special case: do we have a negative? )
     DUP '-' = IF
         ( Oh, a negative, let's recurse and reverse )
         DROP 1 +                  ( a+1 )
-        (parsed)                  ( n f )
-        0 ROT                     ( f 0 n )
+        (parsed)                     ( n f )
+        SWAP 0 SWAP               ( f 0 n )
         - SWAP EXIT               ( 0-n f )
     THEN
-    ( running result from first char )
+    ( running result, staring at zero )
     0 SWAP                               ( a r c )
-    _pdacc                               ( a r f )
-    DUP IF
-        ( first char was not a valid digit )
-        2DROP 0 EXIT                     ( a 0 )
-    THEN
-    BEGIN                         ( a r 0 )
-        DROP SWAP 1 +             ( r a+1 )
-        DUP C@                    ( r a c )
-        ROT SWAP                  ( a r c )
-        _pdacc                    ( a r f )
-    DUP UNTIL
-    ( a r f -- f is 1 on success, -1 on error, normalize
-      to bool. )
-    1 =         ( a r f )
-    ( we want "r f" )
-    ROT DROP
+    ( Loop over chars )
+    BEGIN
+    ( parse char )
+    '0' -
+    ( if bad, return "a 0" )
+    DUP 0 < IF 2DROP 0 EXIT THEN   ( bad )
+    DUP 9 > IF 2DROP 0 EXIT THEN   ( bad )
+    ( good, add to running result )
+    SWAP 10 * +                    ( a r*10+n )
+    SWAP 1 + SWAP                  ( a+1 r )
+    ( read next char )
+    OVER C@
+    DUP NOT UNTIL
+    ( we're done and it's a success. We have "a r c", we want
+      "r 1". )
+    DROP SWAP DROP 1
 ;
 
 ( This is only the "early parser" in earlier stages. No need

forth/z80a.fs

@@ -372,10 +372,10 @@
 : BWR @ AGAIN, ;
 ( same as BSET, but we need to write a placeholder )
 : FJR, PC 0 A, ;
-: IFZ, JRNZ, FJR, ;
-: IFNZ, JRZ, FJR, ;
-: IFC, JRNC, FJR, ;
-: IFNC, JRC, FJR, ;
+: IFZ, JRZ, FJR, ;
+: IFNZ, JRNZ, FJR, ;
+: IFC, JRC, FJR, ;
+: IFNC, JRNC, FJR, ;
 : THEN,
     DUP PC          ( l l pc )
     -^ 1 -          ( l off )

forth/z80c.fs

@@ -149,10 +149,10 @@ CODE NOT
     A L LDrr,
     H ORr,
     HL 0 LDddnn,
-    IFZ,
+    IFNZ, ( skip )
         ( false, make 1 )
         HL INCss,
-    THEN,
+    THEN, ( skip )
     HL PUSHqq,
 ;CODE
 
@@ -209,10 +209,10 @@ CODE /MOD
         RLA,
         HL ADCHLss,
         DE SBCHLss,
-        IFC,
+        IFNC, ( skip )
             DE ADDHLss,
             C DECr,
-        THEN,
+        THEN, ( skip )
     DJNZ, AGAIN, ( loop )
     B A LDrr,
     HL PUSHqq,
@@ -311,13 +311,10 @@ CODE (resRS)
     IX RS_ADDR LDddnn,
 ;CODE
 
-CODE S=
+CODE SCMP
     DE  POPqq,
     HL  POPqq,
     chkPS,
-    ( pre-push false )
-    BC 0 LDddnn,
-    BC PUSHqq,
     BEGIN, ( loop )
         LDA(DE),
         (HL) CPr,
@@ -327,11 +324,10 @@ CODE S=
         HL INCss,
         DE INCss,
     JRNZ, AGAIN, ( loop )
-    ( success, change false to true )
-    HL POPqq,
-    HL INCss,
-    HL PUSHqq,
 L1 FSET ( end )
+    ( 40 == flagsToBC )
+    40 CALLnn,
+    BC PUSHqq,
 ;CODE
 
 CODE CMP
@@ -339,16 +335,8 @@ CODE CMP
     DE  POPqq,
     chkPS,
     DE SUBHLss,
-    BC 0 LDddnn,
-    IFNZ,
-        ( not equal )
-        BC INCss,
-        IFNC,
-            ( < )
-            BC DECss,
-            BC DECss,
-        THEN,
-    THEN,
+    ( 40 == flagsToBC )
+    40 CALLnn,
     BC PUSHqq,
 ;CODE
 
@@ -359,14 +347,13 @@ CODE _find
     chkPS,
     ( 3 == find )
     3 CALLnn,
-    IFNZ,
+    IFZ, ( found )
         ( not found )
         HL PUSHqq,
         DE 0 LDddnn,
         DE PUSHqq,
         JPNEXT,
-    THEN,
-    ( found )
+    THEN, ( found )
     DE PUSHqq,
     DE 1 LDddnn,
     DE PUSHqq,

tests/forth/test_cmp.fs

@@ -3,4 +3,3 @@
 0x42 <>{ 0x40 &> 0x44 &< <>} #
 0x44 <>{ 0x40 &> 0x44 &< <>} NOT #
 0x22 0x8065 < #
--1 0 > #