@@ -1,10 +1,5 @@ | |||||
CREATE ACC 0 , | CREATE ACC 0 , | ||||
: _LIST ." Block " DUP . NL LIST ; | : _LIST ." Block " DUP . NL LIST ; | ||||
: _NUM | |||||
ACC @ SWAP _pdacc | |||||
1 = IF _LIST 0 THEN | |||||
ACC ! | |||||
; | |||||
: L BLK> @ _LIST ; | : L BLK> @ _LIST ; | ||||
: B BLK> @ 1- BLK@ L ; | : B BLK> @ 1- BLK@ L ; | ||||
: N BLK> @ 1+ BLK@ L ; | : N BLK> @ 1+ BLK@ L ; |
@@ -1,7 +1,7 @@ | |||||
CREATE CMD 2 C, '$' C, 0 C, | CREATE CMD 2 C, '$' C, 0 C, | ||||
CREATE PREVPOS 0 , CREATE PREVBLK 0 , | CREATE PREVPOS 0 , CREATE PREVBLK 0 , | ||||
: acc@ ACC @ 1 MAX ; | : 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 ; | : nspcs ( n -- , spit n space ) 0 DO SPC LOOP ; | ||||
: aty 0 SWAP AT-XY ; | : aty 0 SWAP AT-XY ; | ||||
: clrscr LINES 0 DO I aty COLS nspcs LOOP ; | : clrscr LINES 0 DO I aty COLS nspcs LOOP ; | ||||
@@ -1,14 +1,7 @@ | |||||
( r c -- r f ) | ( r c -- r f ) | ||||
( Parse digit c and accumulate into result r. | ( 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 | : _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 ; |
@@ -1,14 +1,11 @@ | |||||
: _pd ( a -- n f, parse decimal ) | : _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. ) | ( 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. ) | |||||
( if we can do the whole string, success. if _pdacc returns | |||||
false before, failure. ) | |||||
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 ) | |||||
NOT IF DROP 1- 0 UNLOOP EXIT THEN LOOP ( a r ) | |||||
( if we had '-', we need to invert result. ) | ( if we had '-', we need to invert result. ) | ||||
SWAP C@ '-' = IF 0 -^ THEN 1 ( r 1 ) ; | SWAP C@ '-' = IF 0 -^ THEN 1 ( r 1 ) ; |
@@ -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 ) | : _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 ) | ||||
DUP C@ ( a len ) | DUP C@ ( a len ) | ||||
0 SWAP 1+ ( len+1 ) 3 DO ( a r ) | 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 ; | NIP 1 ; |