Add words >< and =><=
This commit is contained in:
parent
c494917452
commit
c681cb639d
2
blk/056
2
blk/056
@ -3,6 +3,8 @@ Logic
|
|||||||
= n1 n2 -- f Push true if n1 == n2
|
= n1 n2 -- f Push true if n1 == n2
|
||||||
< n1 n2 -- f Push true if n1 < n2
|
< n1 n2 -- f Push true if n1 < n2
|
||||||
> n1 n2 -- f Push true if n1 > n2
|
> n1 n2 -- f Push true if n1 > n2
|
||||||
|
>< n l h -- f Push true if l < n < h
|
||||||
|
=><= n l h -- f Push true if l <= n <= h
|
||||||
CMP n1 n2 -- n Compare n1 and n2 and set n to -1, 0, or 1.
|
CMP n1 n2 -- n Compare n1 and n2 and set n to -1, 0, or 1.
|
||||||
n=0: a1=a2. n=1: a1>a2. n=-1: a1<a2.
|
n=0: a1=a2. n=1: a1>a2. n=-1: a1<a2.
|
||||||
NOT f -- f Push the logical opposite of f
|
NOT f -- f Push the logical opposite of f
|
||||||
|
4
blk/394
4
blk/394
@ -7,7 +7,9 @@
|
|||||||
: >= < NOT ;
|
: >= < NOT ;
|
||||||
: <= > NOT ;
|
: <= > NOT ;
|
||||||
: 0>= 0< NOT ;
|
: 0>= 0< NOT ;
|
||||||
|
( n l h -- f )
|
||||||
|
: >< 2 PICK > ( n l f ) ROT ROT > AND ;
|
||||||
|
: =><= 2 PICK >= ( n l f ) ROT ROT >= AND ;
|
||||||
( a -- a+1 c )
|
( a -- a+1 c )
|
||||||
: C@+ DUP C@ SWAP 1+ SWAP ;
|
: C@+ DUP C@ SWAP 1+ SWAP ;
|
||||||
( c a -- a+1 )
|
( c a -- a+1 )
|
||||||
|
5
blk/395
5
blk/395
@ -5,10 +5,9 @@
|
|||||||
: _pdacc
|
: _pdacc
|
||||||
DUP 0x21 < IF DROP 1 EXIT THEN
|
DUP 0x21 < IF DROP 1 EXIT THEN
|
||||||
( parse char )
|
( parse char )
|
||||||
'0' -
|
|
||||||
( if bad, return "r -1" )
|
( if bad, return "r -1" )
|
||||||
DUP 0< IF DROP -1 EXIT THEN ( bad )
|
'0' -
|
||||||
DUP 9 > IF DROP -1 EXIT THEN ( bad )
|
DUP 10 < NOT IF DROP -1 EXIT THEN
|
||||||
( good, add to running result )
|
( good, add to running result )
|
||||||
SWAP 10 * + ( r*10+n )
|
SWAP 10 * + ( r*10+n )
|
||||||
0 ( good )
|
0 ( good )
|
||||||
|
12
blk/399
12
blk/399
@ -1,14 +1,8 @@
|
|||||||
( returns negative value on error )
|
( returns negative value on error )
|
||||||
: _ ( c -- n )
|
: _ ( c -- n )
|
||||||
( '0' is ASCII 48 )
|
DUP '0' '9' =><= IF '0' - EXIT THEN
|
||||||
48 -
|
DUP 'a' 'f' =><= IF 0x57 ( 'a' - 10 ) - EXIT THEN
|
||||||
DUP 0< ( bad ) OVER 10 < ( good ) OR IF EXIT THEN
|
DROP -1 ( bad )
|
||||||
( 'a' is ASCII 97. 59 = 97 - 48 )
|
|
||||||
49 -
|
|
||||||
DUP 0< IF EXIT THEN ( bad )
|
|
||||||
DUP 6 < IF 10 + EXIT THEN ( good )
|
|
||||||
( bad )
|
|
||||||
255 -
|
|
||||||
;
|
;
|
||||||
|
|
||||||
|
|
||||||
|
7
blk/401
7
blk/401
@ -1,10 +1,7 @@
|
|||||||
( returns negative value on error )
|
( returns negative value on error )
|
||||||
: _ ( c -- n )
|
: _ ( c -- n )
|
||||||
( '0' is ASCII 48 )
|
DUP '0' '1' =><= IF '0' - EXIT THEN
|
||||||
48 -
|
DROP -1 ( bad )
|
||||||
DUP 0< ( bad ) OVER 2 < ( good ) OR IF EXIT THEN
|
|
||||||
( bad )
|
|
||||||
255 -
|
|
||||||
;
|
;
|
||||||
|
|
||||||
|
|
||||||
|
2
blk/444
2
blk/444
@ -8,7 +8,7 @@
|
|||||||
DROP
|
DROP
|
||||||
8 0 DO
|
8 0 DO
|
||||||
C@+
|
C@+
|
||||||
DUP 0x20 < OVER 0x7e > OR
|
DUP 0x20 0x7e =><= NOT
|
||||||
IF DROP '.' THEN
|
IF DROP '.' THEN
|
||||||
EMIT
|
EMIT
|
||||||
LOOP
|
LOOP
|
||||||
|
BIN
emul/forth.bin
BIN
emul/forth.bin
Binary file not shown.
Loading…
Reference in New Issue
Block a user