mirror of
https://github.com/hsoft/collapseos.git
synced 2024-11-23 20:08:05 +11:00
forth: Forth-ify parseDecimal
This commit is contained in:
Virgil Dupras
parent
25814c0b8b
commit
7d5b1f5cea
Binary file not shown.
@ -77,9 +77,6 @@
|
||||
|
||||
: VARIABLE CREATE 2 ALLOT ;
|
||||
: CONSTANT CREATE , DOES> @ ;
|
||||
: = CMP NOT ;
|
||||
: < CMP 0 1 - = ;
|
||||
: > CMP 1 = ;
|
||||
: / /MOD SWAP DROP ;
|
||||
: MOD /MOD DROP ;
|
||||
|
||||
|
||||
@ -78,7 +78,7 @@
|
||||
.dw PARSEPTR
|
||||
.dw HERE
|
||||
.dw CURRENT
|
||||
jp parseDecimal
|
||||
nop \ nop \ nop ; unused
|
||||
jp doesWord
|
||||
|
||||
; *** Boot dict ***
|
||||
@ -186,87 +186,6 @@ forthMain:
|
||||
.bootName:
|
||||
.db "BOOT", 0
|
||||
|
||||
; Parse string at (HL) as a decimal value and return value in DE.
|
||||
; Reads as many digits as it can and stop when:
|
||||
; 1 - A non-digit character is read
|
||||
; 2 - The number overflows from 16-bit
|
||||
; HL is advanced to the character following the last successfully read char.
|
||||
; Error conditions are:
|
||||
; 1 - There wasn't at least one character that could be read.
|
||||
; 2 - Overflow.
|
||||
; Sets Z on success, unset on error.
|
||||
|
||||
parseDecimal:
|
||||
; First char is special: it has to succeed.
|
||||
ld a, (hl)
|
||||
cp '-'
|
||||
jr z, .negative
|
||||
; Parse the decimal char at A and extract it's 0-9 numerical value. Put the
|
||||
; result in A.
|
||||
; On success, the carry flag is reset. On error, it is set.
|
||||
add a, 0xff-'9' ; maps '0'-'9' onto 0xf6-0xff
|
||||
sub 0xff-9 ; maps to 0-9 and carries if not a digit
|
||||
ret c ; Error. If it's C, it's also going to be NZ
|
||||
; During this routine, we switch between HL and its shadow. On one side,
|
||||
; we have HL the string pointer, and on the other side, we have HL the
|
||||
; numerical result. We also use EXX to preserve BC, saving us a push.
|
||||
exx ; HL as a result
|
||||
ld h, 0
|
||||
ld l, a ; load first digit in without multiplying
|
||||
|
||||
.loop:
|
||||
exx ; HL as a string pointer
|
||||
inc hl
|
||||
ld a, (hl)
|
||||
exx ; HL as a numerical result
|
||||
|
||||
; same as other above
|
||||
add a, 0xff-'9'
|
||||
sub 0xff-9
|
||||
jr c, .end
|
||||
|
||||
ld b, a ; we can now use a for overflow checking
|
||||
add hl, hl ; x2
|
||||
sbc a, a ; a=0 if no overflow, a=0xFF otherwise
|
||||
ld d, h
|
||||
ld e, l ; de is x2
|
||||
add hl, hl ; x4
|
||||
rla
|
||||
add hl, hl ; x8
|
||||
rla
|
||||
add hl, de ; x10
|
||||
rla
|
||||
ld d, a ; a is zero unless there's an overflow
|
||||
ld e, b
|
||||
add hl, de
|
||||
adc a, a ; same as rla except affects Z
|
||||
; Did we oveflow?
|
||||
jr z, .loop ; No? continue
|
||||
; error, NZ already set
|
||||
exx ; HL is now string pointer, restore BC
|
||||
; HL points to the char following the last success.
|
||||
ret
|
||||
|
||||
.end:
|
||||
push hl ; --> lvl 1, result
|
||||
exx ; HL as a string pointer, restore BC
|
||||
pop de ; <-- lvl 1, result
|
||||
cp a ; ensure Z
|
||||
ret
|
||||
|
||||
.negative:
|
||||
inc hl
|
||||
call parseDecimal
|
||||
ret nz
|
||||
push hl ; --> lvl 1
|
||||
or a ; clear carry
|
||||
ld hl, 0
|
||||
sbc hl, de
|
||||
ex de, hl
|
||||
pop hl ; <-- lvl 1
|
||||
xor a ; set Z
|
||||
ret
|
||||
|
||||
; Find the entry corresponding to word where (HL) points to and sets DE to
|
||||
; point to that entry.
|
||||
; Z if found, NZ if not.
|
||||
@ -503,7 +422,7 @@ litWord:
|
||||
ld (IP), hl
|
||||
jp next
|
||||
|
||||
.fill 20
|
||||
.fill 84
|
||||
; *** Dict hook ***
|
||||
; This dummy dictionary entry serves two purposes:
|
||||
; 1. Allow binary grafting. Because each binary dict always end with a dummy
|
||||
|
||||
@ -82,6 +82,43 @@
|
||||
|
||||
: ABORT _c (resSP) _c QUIT ;
|
||||
|
||||
: = _c CMP _c NOT ;
|
||||
: < _c CMP -1 _c = ;
|
||||
: > _c CMP 1 _c = ;
|
||||
|
||||
: (parsed) ( a -- n f )
|
||||
( read first char outside of the loop. it *has* to be
|
||||
nonzero. )
|
||||
_c DUP _c C@ ( a c )
|
||||
_c DUP _c NOT IF EXIT THEN ( a 0 )
|
||||
( special case: do we have a negative? )
|
||||
_c DUP '-' _c = IF
|
||||
( Oh, a negative, let's recurse and reverse )
|
||||
_c DROP 1 _c + ( a+1 )
|
||||
_c (parsed) ( n f )
|
||||
_c SWAP 0 _c SWAP ( f 0 n )
|
||||
_c - _c SWAP EXIT ( 0-n f )
|
||||
THEN
|
||||
( running result, staring at zero )
|
||||
0 _c SWAP ( a r c )
|
||||
( Loop over chars )
|
||||
BEGIN
|
||||
( parse char )
|
||||
'0' _c -
|
||||
( if bad, return "a 0" )
|
||||
_c DUP 0 _c < IF _c 2DROP 0 EXIT THEN ( bad )
|
||||
_c DUP 9 _c > IF _c 2DROP 0 EXIT THEN ( bad )
|
||||
( good, add to running result )
|
||||
_c SWAP 10 _c * _c + ( a r*10+n )
|
||||
_c SWAP 1 _c + _c SWAP ( a+1 r )
|
||||
( read next char )
|
||||
_c OVER _c C@
|
||||
_c DUP _c NOT UNTIL
|
||||
( we're done and it's a success. We have "a r c", we want
|
||||
"r 1". )
|
||||
_c DROP _c SWAP _c DROP 1
|
||||
;
|
||||
|
||||
( This is only the "early parser" in earlier stages. No need
|
||||
for an abort message )
|
||||
: (parse)
|
||||
|
||||
@ -73,6 +73,16 @@
|
||||
3 CONSTANT AF
|
||||
3 CONSTANT SP
|
||||
|
||||
( "cc" condition constants )
|
||||
0 CONSTANT CNZ
|
||||
1 CONSTANT CZ
|
||||
2 CONSTANT CNC
|
||||
3 CONSTANT CC
|
||||
4 CONSTANT CPO
|
||||
5 CONSTANT CPE
|
||||
6 CONSTANT CP
|
||||
7 CONSTANT CM
|
||||
|
||||
( As a general rule, IX and IY are equivalent to spitting an
|
||||
extra 0xdd / 0xfd and then spit the equivalent of HL )
|
||||
: IX 0xdd A, HL ;
|
||||
@ -126,6 +136,8 @@
|
||||
;
|
||||
0x04 OP1r INCr,
|
||||
0x05 OP1r DECr,
|
||||
( also works for cc )
|
||||
0xc0 OP1r RETcc,
|
||||
|
||||
( r -- )
|
||||
: OP1r0
|
||||
@ -134,11 +146,14 @@
|
||||
C@ ( r op )
|
||||
OR A,
|
||||
;
|
||||
0x80 OP1r0 ADDr,
|
||||
0x88 OP1r0 ADCr,
|
||||
0xa0 OP1r0 ANDr,
|
||||
0xb0 OP1r0 ORr,
|
||||
0xa8 OP1r0 XORr,
|
||||
0xb8 OP1r0 CPr,
|
||||
0x90 OP1r0 SUBr
|
||||
0xb0 OP1r0 ORr,
|
||||
0x90 OP1r0 SUBr,
|
||||
0x98 OP1r0 SBCr,
|
||||
0xa8 OP1r0 XORr,
|
||||
|
||||
( qq -- also works for ss )
|
||||
: OP1qq
|
||||
@ -192,6 +207,8 @@
|
||||
;
|
||||
0xd3 OP2n OUTnA,
|
||||
0xdb OP2n INAn,
|
||||
0xc6 OP2n ADDn,
|
||||
0xd6 OP2n SUBn,
|
||||
|
||||
( r n -- )
|
||||
: OP2rn
|
||||
|
||||
@ -368,23 +368,6 @@ CODE CMP
|
||||
BC PUSHqq,
|
||||
;CODE
|
||||
|
||||
CODE (parsed)
|
||||
HL POPqq,
|
||||
chkPS,
|
||||
( 60 == parseDecimal )
|
||||
60 CALLnn,
|
||||
JRZ, L1 FWR ( success )
|
||||
( error )
|
||||
DE 0 LDddnn,
|
||||
DE PUSHqq, ( dummy )
|
||||
DE PUSHqq, ( flag )
|
||||
JPNEXT,
|
||||
L1 FSET ( success )
|
||||
DE PUSHqq,
|
||||
DE 1 LDddnn,
|
||||
DE PUSHqq,
|
||||
;CODE
|
||||
|
||||
CODE (find)
|
||||
HL POPqq,
|
||||
chkPS,
|
||||
|
||||
Loading…
Reference in New Issue
Block a user