Procházet zdrojové kódy

core: make parse and format words a bit tighter

master
Virgil Dupras před 3 roky
rodič
revize
3a84a3871b
10 změnil soubory, kde provedl 28 přidání a 32 odebrání
  1. +0
    -10
      blk/356
  2. +8
    -2
      blk/357
  3. +1
    -1
      blk/358
  4. +0
    -6
      blk/359
  5. +7
    -1
      blk/360
  6. +0
    -5
      blk/361
  7. +6
    -1
      blk/362
  8. +4
    -4
      blk/363
  9. +2
    -2
      blk/383
  10. binární
      cvm/forth.bin

+ 0
- 10
blk/356 Zobrazit soubor

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

+ 8
- 2
blk/357 Zobrazit soubor

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

+ 1
- 1
blk/358 Zobrazit soubor

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


+ 0
- 6
blk/359 Zobrazit soubor

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

+ 7
- 1
blk/360 Zobrazit soubor

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


+ 0
- 5
blk/361 Zobrazit soubor

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

+ 6
- 1
blk/362 Zobrazit soubor

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


+ 4
- 4
blk/363 Zobrazit soubor

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

+ 2
- 2
blk/383 Zobrazit soubor

@@ -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ární
cvm/forth.bin Zobrazit soubor


Načítá se…
Zrušit
Uložit