core: make parse and format words a bit tighter
This commit is contained in:
parent
9c36885503
commit
3a84a3871b
10
blk/356
10
blk/356
@ -1,10 +0,0 @@
|
|||||||
( parsed is tight, all comments ahead. We read the first char
|
|
||||||
outside of the loop because it *has* to be nonzero, which
|
|
||||||
means _pdacc *has* to return 0.
|
|
||||||
|
|
||||||
Then, we check for '-'. If we get it, we advance by one,
|
|
||||||
recurse and invert result.
|
|
||||||
|
|
||||||
We loop until _pdacc is nonzero, which means either WS or
|
|
||||||
non-digit. 1 means WS, which means parsing was a success.
|
|
||||||
-1 means non-digit, which means we have a non-decimal. )
|
|
10
blk/357
10
blk/357
@ -1,8 +1,14 @@
|
|||||||
: (parsed) ( a -- n f )
|
: _pd ( a -- n f, parse decimal )
|
||||||
|
( We read the first char outside of the loop because it *has*
|
||||||
|
to be nonzero, which means _pdacc *has* to return 0. )
|
||||||
C@+ OVER C@ 0 ( a len firstchar startat )
|
C@+ OVER C@ 0 ( a len firstchar startat )
|
||||||
|
( if we have '-', we only advance. more processing later. )
|
||||||
SWAP '-' = IF 1+ THEN ( a len startat )
|
SWAP '-' = IF 1+ THEN ( a len startat )
|
||||||
|
( We loop until _pdacc is nonzero, which means either WS or
|
||||||
|
non-digit. 1 means WS, which means parsing was a success.
|
||||||
|
-1 means non-digit, which means we have a non-decimal. )
|
||||||
0 ROT ROT ( len ) ( startat ) DO ( a r )
|
0 ROT ROT ( len ) ( startat ) DO ( a r )
|
||||||
OVER I + C@ ( a r c ) _pdacc ( a r f )
|
OVER I + C@ ( a r c ) _pdacc ( a r f )
|
||||||
IF DROP 1- 0 UNLOOP EXIT THEN LOOP ( a r )
|
IF DROP 1- 0 UNLOOP EXIT THEN LOOP ( a r )
|
||||||
( negate if needed )
|
( if we had '-', we need to invert result. )
|
||||||
SWAP C@ '-' = IF 0 -^ THEN 1 ( r 1 ) ;
|
SWAP C@ '-' = IF 0 -^ THEN 1 ( r 1 ) ;
|
||||||
|
2
blk/358
2
blk/358
@ -1,7 +1,7 @@
|
|||||||
( strings being sent to parse routines are always null
|
( strings being sent to parse routines are always null
|
||||||
terminated )
|
terminated )
|
||||||
|
|
||||||
: (parsec) ( a -- n f )
|
: _pc ( a -- n f, parse character )
|
||||||
( apostrophe is ASCII 39 )
|
( apostrophe is ASCII 39 )
|
||||||
DUP 1+ C@ 39 = OVER 3 + C@ 39 = AND ( a f )
|
DUP 1+ C@ 39 = OVER 3 + C@ 39 = AND ( a f )
|
||||||
NOT IF 0 EXIT THEN ( a 0 )
|
NOT IF 0 EXIT THEN ( a 0 )
|
||||||
|
6
blk/359
6
blk/359
@ -1,6 +0,0 @@
|
|||||||
( returns negative value on error )
|
|
||||||
: _ ( c -- n )
|
|
||||||
DUP '0' '9' =><= IF '0' - EXIT THEN
|
|
||||||
DUP 'a' 'f' =><= IF 0x57 ( 'a' - 10 ) - EXIT THEN
|
|
||||||
DROP -1 ( bad )
|
|
||||||
;
|
|
8
blk/360
8
blk/360
@ -1,4 +1,10 @@
|
|||||||
: (parseh) ( a -- n f )
|
( returns negative value on error )
|
||||||
|
: _ ( c -- n )
|
||||||
|
DUP '0' '9' =><= IF '0' - EXIT THEN
|
||||||
|
DUP 'a' 'f' =><= IF 0x57 ( 'a' - 10 ) - EXIT THEN
|
||||||
|
DROP -1 ( bad )
|
||||||
|
;
|
||||||
|
: _ph ( a -- n f, parse hex )
|
||||||
( '0': ASCII 0x30 'x': 0x78 0x7830 )
|
( '0': ASCII 0x30 'x': 0x78 0x7830 )
|
||||||
DUP 1+ @ 0x7830 = NOT IF 0 EXIT THEN ( a 0 )
|
DUP 1+ @ 0x7830 = NOT IF 0 EXIT THEN ( a 0 )
|
||||||
( We have "0x" prefix )
|
( We have "0x" prefix )
|
||||||
|
5
blk/361
5
blk/361
@ -1,5 +0,0 @@
|
|||||||
( returns negative value on error )
|
|
||||||
: _ ( c -- n )
|
|
||||||
DUP '0' '1' =><= IF '0' - EXIT THEN
|
|
||||||
DROP -1 ( bad )
|
|
||||||
;
|
|
7
blk/362
7
blk/362
@ -1,4 +1,9 @@
|
|||||||
: (parseb) ( a -- n f )
|
( returns negative value on error )
|
||||||
|
: _ ( c -- n )
|
||||||
|
DUP '0' '1' =><= IF '0' - EXIT THEN
|
||||||
|
DROP -1 ( bad )
|
||||||
|
;
|
||||||
|
: _pb ( a -- n f, parse binary )
|
||||||
( '0': ASCII 0x30 'b': 0x62 0x6230 )
|
( '0': ASCII 0x30 'b': 0x62 0x6230 )
|
||||||
DUP 1+ @ 0x6230 = NOT IF 0 EXIT THEN ( a 0 )
|
DUP 1+ @ 0x6230 = NOT IF 0 EXIT THEN ( a 0 )
|
||||||
( We have "0b" prefix )
|
( We have "0b" prefix )
|
||||||
|
8
blk/363
8
blk/363
@ -1,8 +1,8 @@
|
|||||||
: (parse) ( a -- n )
|
: (parse) ( a -- n )
|
||||||
(parsec) IF EXIT THEN
|
_pc IF EXIT THEN
|
||||||
(parseh) IF EXIT THEN
|
_ph IF EXIT THEN
|
||||||
(parseb) IF EXIT THEN
|
_pb IF EXIT THEN
|
||||||
(parsed) IF EXIT THEN
|
_pd IF EXIT THEN
|
||||||
( nothing works )
|
( nothing works )
|
||||||
LIT< (wnf) FIND IF EXECUTE ELSE ABORT THEN
|
LIT< (wnf) FIND IF EXECUTE ELSE ABORT THEN
|
||||||
;
|
;
|
||||||
|
4
blk/383
4
blk/383
@ -1,12 +1,12 @@
|
|||||||
: _
|
: _
|
||||||
999 SWAP ( stop indicator )
|
999 SWAP ( stop indicator )
|
||||||
DUP 0 = IF '0' EXIT THEN ( 0 is a special case )
|
|
||||||
BEGIN
|
BEGIN
|
||||||
DUP 0 = IF DROP EXIT THEN
|
?DUP NOT IF EXIT THEN
|
||||||
10 /MOD ( r q )
|
10 /MOD ( r q )
|
||||||
SWAP '0' + SWAP ( d q )
|
SWAP '0' + SWAP ( d q )
|
||||||
AGAIN ;
|
AGAIN ;
|
||||||
: . ( n -- )
|
: . ( n -- )
|
||||||
|
?DUP NOT IF '0' EMIT EXIT THEN ( 0 is a special case )
|
||||||
( handle negative )
|
( handle negative )
|
||||||
DUP 0< IF '-' EMIT -1 * THEN
|
DUP 0< IF '-' EMIT -1 * THEN
|
||||||
_
|
_
|
||||||
|
BIN
cvm/forth.bin
BIN
cvm/forth.bin
Binary file not shown.
Loading…
Reference in New Issue
Block a user