core: make parse and format words a bit tighter

This commit is contained in:
Virgil Dupras 2020-08-30 20:15:55 -04:00
parent 9c36885503
commit 3a84a3871b
10 changed files with 28 additions and 32 deletions

10
blk/356
View File

@ -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
View File

@ -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 ) ;

View File

@ -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 )

View File

@ -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 )
;

View File

@ -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 )

View File

@ -1,5 +0,0 @@
( returns negative value on error )
: _ ( c -- n )
DUP '0' '1' =><= IF '0' - EXIT THEN
DROP -1 ( bad )
;

View File

@ -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 )

View File

@ -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
; ;

View File

@ -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
_ _

Binary file not shown.