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 )
|
||||
( if we have '-', we only advance. more processing later. )
|
||||
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 )
|
||||
OVER I + C@ ( a r c ) _pdacc ( a r f )
|
||||
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 ) ;
|
||||
|
2
blk/358
2
blk/358
@ -1,7 +1,7 @@
|
||||
( strings being sent to parse routines are always null
|
||||
terminated )
|
||||
|
||||
: (parsec) ( a -- n f )
|
||||
: _pc ( a -- n f, parse character )
|
||||
( apostrophe is ASCII 39 )
|
||||
DUP 1+ C@ 39 = OVER 3 + C@ 39 = AND ( a f )
|
||||
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 )
|
||||
DUP 1+ @ 0x7830 = NOT IF 0 EXIT THEN ( a 0 )
|
||||
( 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 )
|
||||
DUP 1+ @ 0x6230 = NOT IF 0 EXIT THEN ( a 0 )
|
||||
( We have "0b" prefix )
|
||||
|
8
blk/363
8
blk/363
@ -1,8 +1,8 @@
|
||||
: (parse) ( a -- n )
|
||||
(parsec) IF EXIT THEN
|
||||
(parseh) IF EXIT THEN
|
||||
(parseb) IF EXIT THEN
|
||||
(parsed) IF EXIT THEN
|
||||
_pc IF EXIT THEN
|
||||
_ph IF EXIT THEN
|
||||
_pb IF EXIT THEN
|
||||
_pd IF EXIT THEN
|
||||
( nothing works )
|
||||
LIT< (wnf) FIND IF EXECUTE ELSE ABORT THEN
|
||||
;
|
||||
|
4
blk/383
4
blk/383
@ -1,12 +1,12 @@
|
||||
: _
|
||||
999 SWAP ( stop indicator )
|
||||
DUP 0 = IF '0' EXIT THEN ( 0 is a special case )
|
||||
BEGIN
|
||||
DUP 0 = IF DROP EXIT THEN
|
||||
?DUP NOT IF EXIT THEN
|
||||
10 /MOD ( r q )
|
||||
SWAP '0' + SWAP ( d q )
|
||||
AGAIN ;
|
||||
: . ( n -- )
|
||||
?DUP NOT IF '0' EMIT EXIT THEN ( 0 is a special case )
|
||||
( handle negative )
|
||||
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