Optimize parsing routines
This commit is contained in:
parent
f027f13042
commit
30b56185e9
5
blk/106
5
blk/106
@ -1,10 +1,5 @@
|
||||
CREATE ACC 0 ,
|
||||
: _LIST ." Block " DUP . NL LIST ;
|
||||
: _NUM
|
||||
ACC @ SWAP _pdacc
|
||||
1 = IF _LIST 0 THEN
|
||||
ACC !
|
||||
;
|
||||
: L BLK> @ _LIST ;
|
||||
: B BLK> @ 1- BLK@ L ;
|
||||
: N BLK> @ 1+ BLK@ L ;
|
||||
|
2
blk/126
2
blk/126
@ -1,7 +1,7 @@
|
||||
CREATE CMD 2 C, '$' C, 0 C,
|
||||
CREATE PREVPOS 0 , CREATE PREVBLK 0 ,
|
||||
: acc@ ACC @ 1 MAX ;
|
||||
: num ACC @ SWAP _pdacc IF DROP ELSE ACC ! THEN ;
|
||||
: num ACC @ SWAP _pdacc IF ACC ! ELSE DROP THEN ;
|
||||
: nspcs ( n -- , spit n space ) 0 DO SPC LOOP ;
|
||||
: aty 0 SWAP AT-XY ;
|
||||
: clrscr LINES 0 DO I aty COLS nspcs LOOP ;
|
||||
|
15
blk/357
15
blk/357
@ -1,14 +1,7 @@
|
||||
( r c -- r f )
|
||||
( Parse digit c and accumulate into result r.
|
||||
Flag f is 0 when c was a valid digit, 1 when c was WS,
|
||||
-1 when c was an invalid digit. )
|
||||
Flag f is true when c was a valid digit )
|
||||
: _pdacc
|
||||
DUP 0x21 < IF DROP 1 EXIT THEN
|
||||
( parse char )
|
||||
( if bad, return "r -1" )
|
||||
'0' -
|
||||
DUP 10 < NOT IF DROP -1 EXIT THEN
|
||||
( good, add to running result )
|
||||
SWAP 10 * + ( r*10+n )
|
||||
0 ( good )
|
||||
;
|
||||
'0' - DUP 10 < IF ( good, add to running result )
|
||||
SWAP 10 * + 1 ( r*10+n f )
|
||||
ELSE ( bad ) DROP 0 THEN ;
|
||||
|
9
blk/358
9
blk/358
@ -1,14 +1,11 @@
|
||||
: _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. )
|
||||
( if we can do the whole string, success. if _pdacc returns
|
||||
false before, failure. )
|
||||
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 )
|
||||
NOT IF DROP 1- 0 UNLOOP EXIT THEN LOOP ( a r )
|
||||
( if we had '-', we need to invert result. )
|
||||
SWAP C@ '-' = IF 0 -^ THEN 1 ( r 1 ) ;
|
||||
|
11
blk/361
11
blk/361
@ -1,15 +1,10 @@
|
||||
( 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 )
|
||||
DUP C@ ( a len )
|
||||
0 SWAP 1+ ( len+1 ) 3 DO ( a r )
|
||||
OVER I + C@ ( a r c ) _ ( a r n )
|
||||
DUP 0< IF 2DROP 0 UNLOOP EXIT THEN
|
||||
SWAP 1 LSHIFT + ( a r*2+n ) LOOP
|
||||
OVER I + C@ ( a r c )
|
||||
DUP '0' '1' =><= NOT IF 2DROP 0 UNLOOP EXIT THEN
|
||||
'0' - SWAP 1 LSHIFT + ( a r*2+n ) LOOP
|
||||
NIP 1 ;
|
||||
|
BIN
cvm/forth.bin
BIN
cvm/forth.bin
Binary file not shown.
Loading…
Reference in New Issue
Block a user