diff --git a/CHANGELOG.md b/CHANGELOG.md index e1f83f294..a4734a7ed 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -16,6 +16,8 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 - Data stack effects of :/;/:NONAME/DEFINE. Starting with 2.0.0, :/:NONAME/DEFINE would put a value on the data stack, to be later consumed by ;. This is no longer the case. ### Added - GETIN in IO: + - M*/ + - Literal doubles with a trailing period, e.g.: -100000. ### Fixed - LOADB/SAVEB could change active device. - IOABORT did not print all error messages. diff --git a/interpreter.asm b/interpreter.asm index 147bd57ac..0850c9224 100644 --- a/interpreter.asm +++ b/interpreter.asm @@ -653,6 +653,8 @@ apply_base READ_NUMBER lda LSB,x sta .chars_to_process + tay + dey lda MSB+1,x sta W3+1 lda LSB+1,x @@ -661,14 +663,30 @@ READ_NUMBER lda BASE sta OLD_BASE + lda (W3), y + cmp #"." + bne .is_single + dec .chars_to_process + sta .is_double ldy #0 - sty .negate + beq + +.is_single + ldy #0 + sty .is_double + ++ sty .negate dex dex sty LSB+1,x sty MSB+1,x + sty LSB,x sty MSB,x + ldy .chars_to_process + dey + +.check_char + ldy #0 lda (W3), y cmp #"'" beq .parse_char @@ -696,13 +714,35 @@ READ_NUMBER inc .negate jmp .prepare_next_char +.parse_char + lda .chars_to_process + cmp #3 + bne .parse_failed + ldy #2 + lda (W3),y + cmp #"'" + bne .parse_failed + dey + lda (W3),y + sta LSB+1,x + lda #0 + sta MSB+1,x + jmp .parse_done + +.parse_failed + inx + inx ; Z flag set + rts + .next_digit ; number *= BASE + dex + lda #0 + sta MSB,x lda BASE sta LSB,x - jsr U_M_STAR - lda LSB,x - bne .parse_failed ; overflow! + jsr ONE + jsr M_STAR_SLASH inc W3 bne + @@ -731,6 +771,10 @@ READ_NUMBER sta LSB+1,x bcc .prepare_next_char inc MSB+1,x + bne .prepare_next_char + inc LSB,x + bne .prepare_next_char + inc MSB,x beq .parse_failed .prepare_next_char dec .chars_to_process @@ -747,6 +791,20 @@ OLD_BASE = * + 1 sta MSB+3,x inx inx +.is_double = * + 1 + lda #0 ; placeholder + beq .single + lda LSB-2,x + sta LSB,x + lda MSB-2,x + sta MSB,x + lda .negate + beq + + jsr DNEGATE + tya + rts + +.single inx .negate = * + 1 lda #0 @@ -755,26 +813,6 @@ OLD_BASE = * + 1 tya ; clear Z flag + rts -.parse_char - lda .chars_to_process - cmp #3 - bne .parse_failed - ldy #2 - lda (W3),y - cmp #"'" - bne .parse_failed - dey - lda (W3),y - sta LSB+1,x - lda #0 - sta MSB+1,x - jmp .parse_done - -.parse_failed - inx - inx ; Z flag set - rts - .chars_to_process !byte 0 diff --git a/math.asm b/math.asm index 1502dcaa8..b989c0448 100644 --- a/math.asm +++ b/math.asm @@ -24,6 +24,7 @@ ; http://6502.org/source/integers/ummodfix/ummodfix.htm ; U< - UM* UM/MOD M+ INVERT NEGATE ABS * DNEGATE M* 0< S>D FM/MOD /MOD UD/MOD +; DABS M*/ +BACKLINK "u<", 2 U_LESS @@ -207,21 +208,6 @@ DABS_STAR ; ( n1 n2 -- ud1 ) bmi NEGATE rts - +BACKLINK "dnegate", 7 -DNEGATE - jsr INVERT - inx - jsr INVERT - dex - inc LSB+1,x - bne + - inc MSB+1,x - bne + - inc LSB,x - bne + - inc MSB,x -+ rts - +BACKLINK "m*", 2 jsr DABS_STAR bmi DNEGATE @@ -277,26 +263,163 @@ DIVISOR_SIGN = * + 1 ; (ud1 u2 -- urem udquot) +BACKLINK "ud/mod", 6 +UD_DIV_MOD + jsr ZERO + jsr SWAP + jmp UT_DIV_MOD + + +BACKLINK "dnegate", 7 +DNEGATE + jsr INVERT + inx + jsr INVERT + dex + inc LSB+1,x + bne + + inc MSB+1,x + bne + + inc LSB,x + bne + + inc MSB,x ++ rts + + + +BACKLINK "dabs", 4 +DABS + lda MSB, x + bmi DNEGATE + rts + +product_lo + !word 0 +product_hi + !word 0 + !word 0 + +; ( d1 n1 +n2 -- d2 ) + +BACKLINK "m*/", 3 +; wastes W, W2, y, W3 if +n2 != 1 +M_STAR_SLASH + lda MSB + 2,x + eor MSB + 1,x + sta .negateprod + inx + jsr ABS + inx + jsr DABS + dex + dex + lda MSB, x ; skip division if divisor = 1 + bne + ; saves W3 from being wasted if division not required + lda LSB, x + cmp #1 + bne + + sta .no_divide + inx + bne .do_mult ++ jsr TO_R + lda #0 + sta .no_divide +.do_mult + jsr ZERO + lda #$00 + sta product_lo ; clear upper bits of product + sta product_lo+1 + sta product_hi + sta product_hi+1 + sta product_hi+2 + sta product_hi+3 + ldy #$20 ; set binary count to 32 + ; ( muld mul ) +.dshift_r + lsr MSB + 2, x + ror LSB + 2, x + ror MSB + 3, x ; multiplier+1 ; divide multiplier by 2 + ror LSB + 3, x ; multiplier + bcc .drotate_r + lda product_hi ; get upper half of product and add multiplicand + clc + adc LSB+1, x ; multiplicand + sta product_hi + lda product_hi+1 + adc MSB+1, x + sta product_hi+1 + lda product_hi+2 + adc LSB, x + sta product_hi+2 + lda product_hi+3 + adc MSB, x +.drotate_r + ror ; rotate partial product + + ror product_hi+3 + ror product_hi+2 + ror product_hi+1 + ror product_hi + ror product_lo+1 + ror product_lo + ror product+1 + ror product + dey + bne .dshift_r + + inx + + lda product + sta LSB + 2, x + lda product + 1 + sta MSB + 2, x + lda product_lo + sta LSB + 1, x + lda product_lo + 1 + sta MSB + 1, x +.no_divide = * + 1 + lda #0 ; placeholder + beq .divide + inx + bne .divided +.divide + lda product_hi + sta LSB, x + lda product_hi + 1 + sta MSB, x + jsr R_TO ++ jsr UT_DIV_MOD ; ( umod udquot ) + inx + lda MSB, x + sta MSB + 1, x + lda LSB, x + sta LSB + 1, x + lda MSB - 1, x + sta MSB, x + lda LSB - 1, x + sta LSB, x +.divided + +.negateprod = * + 1 + lda #$ff ; placeholder + bpl + + jmp DNEGATE ++ rts + +UT_DIV_MOD ; (ut1 u2 -- urem udquot ) +; wastes W3 lda LSB,x - sta LSB - 1,x sta W3 lda MSB,x - sta MSB - 1,x sta W3 + 1 ; cache the divisor - lda #0 - sta LSB,x - sta MSB,x - dex - jsr UM_DIV_MOD ; divide the high word + jsr UM_DIV_MOD ; divide the highest word + ; ( u urem uquot ) lda LSB,x pha lda MSB,x pha ; cache the high word of quotient + lda W3 ; uncache the divisor sta LSB,x lda W3 + 1 sta MSB,x - jsr UM_DIV_MOD ; divide the low byte + jsr UM_DIV_MOD ; divide the low word dex pla ; push the high word of quotient sta MSB,x