diff --git a/blk/018 b/blk/018 index ea7977c..93ae784 100644 --- a/blk/018 +++ b/blk/018 @@ -5,7 +5,7 @@ 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 +To compare whether something is negative, use the "0<" word which is the equivalent to "0x7fff >". diff --git a/emul/forth/z80c.bin b/emul/forth/z80c.bin index c13545b..bf11c6b 100644 Binary files a/emul/forth/z80c.bin and b/emul/forth/z80c.bin differ diff --git a/forth/cmp.fs b/forth/cmp.fs index 866bae5..eecad15 100644 --- a/forth/cmp.fs +++ b/forth/cmp.fs @@ -2,8 +2,7 @@ : >= < NOT ; : <= > NOT ; -: <0 32767 > ; -: >=0 <0 NOT ; +: 0>= 0< NOT ; ( n1 -- n1 true ) : <>{ 1 ; diff --git a/forth/fmt.fs b/forth/fmt.fs index b5b1b6d..ad42f0c 100644 --- a/forth/fmt.fs +++ b/forth/fmt.fs @@ -12,7 +12,7 @@ : . ( n -- ) ( handle negative ) - DUP <0 IF '-' EMIT -1 * THEN + DUP 0< IF '-' EMIT -1 * THEN _ BEGIN DUP '9' > IF DROP EXIT THEN ( stop indicator, we're done ) diff --git a/forth/icore.fs b/forth/icore.fs index 9cb00bc..e898ba8 100644 --- a/forth/icore.fs +++ b/forth/icore.fs @@ -51,6 +51,7 @@ : = CMP NOT ; : < CMP -1 = ; : > CMP 1 = ; +: 0< 32767 > ; ( r c -- r f ) ( Parse digit c and accumulate into result r. @@ -61,7 +62,7 @@ ( parse char ) '0' - ( if bad, return "r -1" ) - DUP 0 < IF DROP -1 EXIT THEN ( bad ) + 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 ) diff --git a/forth/parse.fs b/forth/parse.fs index fa1af00..93a6393 100644 --- a/forth/parse.fs +++ b/forth/parse.fs @@ -11,14 +11,14 @@ ; ( returns negative value on error ) -: hexdig ( c -- n ) +: _ ( c -- n ) ( '0' is ASCII 48 ) 48 - - DUP 0 < IF EXIT THEN ( bad ) + 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 0< IF EXIT THEN ( bad ) DUP 6 < IF 10 + EXIT THEN ( good ) ( bad ) 255 - @@ -31,24 +31,23 @@ 2+ ( validate slen ) DUP SLEN ( a l ) - DUP 0 = IF DROP 0 EXIT THEN ( a 0 ) + DUP NOT IF DROP 0 EXIT THEN ( a 0 ) 4 > IF DROP 0 EXIT THEN ( a 0 ) - 0 ( a r ) + 0 ( a r ) BEGIN - OVER C@ - DUP 0 = IF DROP SWAP DROP 1 EXIT THEN ( r, 1 ) - hexdig ( a r n ) - DUP 0 < IF DROP DROP 1 EXIT THEN ( a 0 ) - SWAP 16 * + ( a r*16+n ) - SWAP 1+ SWAP ( a+1 r ) + 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 ; ( returns negative value on error ) -: bindig ( c -- n ) +: _ ( c -- n ) ( '0' is ASCII 48 ) 48 - - DUP 0 < IF EXIT THEN ( bad ) + DUP 0< IF EXIT THEN ( bad ) DUP 2 < IF EXIT THEN ( good ) ( bad ) 255 - @@ -65,12 +64,11 @@ 16 > IF DROP 0 EXIT THEN ( a 0 ) 0 ( a r ) BEGIN - OVER C@ - DUP 0 = IF DROP SWAP DROP 1 EXIT THEN ( r, 1 ) - bindig ( a r n ) - DUP 0 < IF DROP DROP 1 EXIT THEN ( a 0 ) - SWAP 2 * + ( a r*2+n ) - SWAP 1+ SWAP ( a+1 r ) + 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 ;