forth: implement "0b" number parsing
This commit is contained in:
parent
f0cbda1f2e
commit
af5a97243a
@ -27,7 +27,7 @@
|
|||||||
: (parseh) ( a -- n f )
|
: (parseh) ( a -- n f )
|
||||||
( '0': ASCII 0x30 'x': 0x78 0x7830: 30768 )
|
( '0': ASCII 0x30 'x': 0x78 0x7830: 30768 )
|
||||||
DUP @ 30768 = NOT IF 0 EXIT THEN ( a 0 )
|
DUP @ 30768 = NOT IF 0 EXIT THEN ( a 0 )
|
||||||
( We have "0x" suffix )
|
( We have "0x" prefix )
|
||||||
2 +
|
2 +
|
||||||
( validate slen )
|
( validate slen )
|
||||||
DUP SLEN ( a l )
|
DUP SLEN ( a l )
|
||||||
@ -44,9 +44,40 @@
|
|||||||
AGAIN
|
AGAIN
|
||||||
;
|
;
|
||||||
|
|
||||||
|
( returns negative value on error )
|
||||||
|
: bindig ( c -- n )
|
||||||
|
( '0' is ASCII 48 )
|
||||||
|
48 -
|
||||||
|
DUP 0 < IF EXIT THEN ( bad )
|
||||||
|
DUP 2 < IF EXIT THEN ( good )
|
||||||
|
( bad )
|
||||||
|
255 -
|
||||||
|
;
|
||||||
|
|
||||||
|
: (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 +
|
||||||
|
( validate slen )
|
||||||
|
DUP SLEN ( a l )
|
||||||
|
DUP 0 = IF DROP 0 EXIT THEN ( a 0 )
|
||||||
|
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 )
|
||||||
|
AGAIN
|
||||||
|
;
|
||||||
|
|
||||||
: (parse) ( a -- n )
|
: (parse) ( a -- n )
|
||||||
(parsec) NOT SKIP? EXIT
|
(parsec) NOT SKIP? EXIT
|
||||||
(parseh) NOT SKIP? EXIT
|
(parseh) NOT SKIP? EXIT
|
||||||
|
(parseb) NOT SKIP? EXIT
|
||||||
(parsed) NOT SKIP? EXIT
|
(parsed) NOT SKIP? EXIT
|
||||||
( nothing works )
|
( nothing works )
|
||||||
ABORT" unknown word! "
|
ABORT" unknown word! "
|
||||||
|
2
tests/forth/test_parse.fs
Normal file
2
tests/forth/test_parse.fs
Normal file
@ -0,0 +1,2 @@
|
|||||||
|
'b' 0x62 #eq
|
||||||
|
0b1111010101 981 #eq
|
Loading…
Reference in New Issue
Block a user