From 7d5b1f5ceaae1492c72ce8a98636cb5dedadecfc Mon Sep 17 00:00:00 2001 From: Virgil Dupras Date: Tue, 31 Mar 2020 15:04:28 -0400 Subject: [PATCH] forth: Forth-ify parseDecimal --- emul/forth/z80c.bin | Bin 1555 -> 1720 bytes forth/core.fs | 3 -- forth/forth.asm | 85 ++-------------------------------------------------- forth/icore.fs | 37 +++++++++++++++++++++++ forth/z80a.fs | 23 ++++++++++++-- forth/z80c.fs | 17 ----------- 6 files changed, 59 insertions(+), 106 deletions(-) diff --git a/emul/forth/z80c.bin b/emul/forth/z80c.bin index d60643d8415a47cedf3d6adc2ea4216da3392640..d1c5da6b14d81e633858a3c3d3d65324dbceaf8f 100644 GIT binary patch delta 696 zcmY*W&ubG=5dQYPx4TJ5SBpPdL}4uzvbJJDLJvm4l!%XrF(HMP9Exlr6l!?HUV4xq zJ>{U6#gkBa%0(oCLcDq_;z2y>KTr_8>d82>yR~@O<;^!U-+c2;lz%_<=8JG1Zg$(j zO!P-=Ipvw1td)(7T==RpBU;i3jpXfP2`y^n=p;4d@H&1cBw6_XVa$-jBUvSegw=@Mf1}?`LSaN0XO8p* zFR|!)SauR^ziG*W>1}qmgEJufShquiHCCf}b@}QKhwD~K=OH}OnLj*`?AFSn$H2%w zkl!T#6A7c}i7Gfnw=UXl^h#Y=@4LHVoF)_4;OB(*@(yWyr@P(T2^M%flkB?1OE zVno+sj~M$vUrP>f+l`~>qJ65r=T6%Ov!u%cUv?Nf$*(nJuumOBtl{fKqg<;sm!Le% zrN;{5!|zimAz_I_wk1ym)yjIDVa@Xh5It&hCCCF)E+Q9*+z@*;}?;rJD=atU({lIK+BBmCNK(dCamhsY76K zX(N{(2XoLcznFmA`6kf^%fSGfp&m>`xx6%^#*w@?C#P3 @ ; -: = CMP NOT ; -: < CMP 0 1 - = ; -: > CMP 1 = ; : / /MOD SWAP DROP ; : MOD /MOD DROP ; diff --git a/forth/forth.asm b/forth/forth.asm index 19e45fc..c9e50dd 100644 --- a/forth/forth.asm +++ b/forth/forth.asm @@ -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 diff --git a/forth/icore.fs b/forth/icore.fs index f515eec..6044d14 100644 --- a/forth/icore.fs +++ b/forth/icore.fs @@ -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) diff --git a/forth/z80a.fs b/forth/z80a.fs index 2c3f521..463f8a2 100644 --- a/forth/z80a.fs +++ b/forth/z80a.fs @@ -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 diff --git a/forth/z80c.fs b/forth/z80c.fs index 506f69f..36f752a 100644 --- a/forth/z80c.fs +++ b/forth/z80c.fs @@ -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,