From 582ecedbd15d090ac1d376219d02ed17792203b2 Mon Sep 17 00:00:00 2001 From: Rikard Nordgren Date: Wed, 1 Apr 2026 18:25:31 +0200 Subject: [PATCH] Update mul_FAC2_FAC1 --- STATUS.md | 2 +- src/basic/math/ba2b.mul_FAC2_FAC1.s | 73 +++++++++- src/basic/math/bab7.MULDIV.s | 47 +++++++ src/basic/math/bb12.div_FAC2_FAC1.s | 4 +- src/basic/math/mul_FAC2_FAC1.s | 195 --------------------------- src/basic/math/mul_FAC2_FAC1_shift.s | 46 ------- tools/similarity.c | 5 +- 7 files changed, 123 insertions(+), 249 deletions(-) create mode 100644 src/basic/math/bab7.MULDIV.s delete mode 100644 src/basic/math/mul_FAC2_FAC1.s delete mode 100644 src/basic/math/mul_FAC2_FAC1_shift.s diff --git a/STATUS.md b/STATUS.md index cdb44a0f..e53296df 100644 --- a/STATUS.md +++ b/STATUS.md @@ -220,7 +220,7 @@ Floating point mathematical routines - not official, but well known and broadly | `$B983` | `shiftr_FAC1` | DONE | From the Microsoft BASIC, original name: SHIFTR | | `$B9EA` | `log_FAC1` | PARTIAL | not fully tested yet | | `$BA28` | `mul_MEM_FAC1` | DONE | From the Microsoft BASIC, original name: FMULT | -| `$BA2B` | `mul_FAC2_FAC1` | DONE | | +| `$BA2B` | `mul_FAC2_FAC1` | DONE | From the Microsoft BASIC, original name: FMULTT | | `$BA8C` | `mov_MEM_FAC2` | DONE | From the Microsoft BASIC, original name: CONUPK | | `$BA90` | `get_FAC2_via_INDEX` | DONE | From the Microsoft BASIC, no label | | `$BAE2` | `mul10_FAC1` | DONE | | diff --git a/src/basic/math/ba2b.mul_FAC2_FAC1.s b/src/basic/math/ba2b.mul_FAC2_FAC1.s index e3ddc14a..5f70ee0b 100644 --- a/src/basic/math/ba2b.mul_FAC2_FAC1.s +++ b/src/basic/math/ba2b.mul_FAC2_FAC1.s @@ -3,6 +3,75 @@ ;; #LAYOUT# * BASIC_0 #TAKE ;; #LAYOUT# * * #IGNORE -; Just a compatibility jump - our routine is longer than original one +; This file is under the MIT license, it contains code released by Microsoft Corporation. +; See LICENSE for more information. - jmp mul_FAC2_FAC1 +; Math package - multiplies FAC1 by FAC2 +; +; This is verified to be identical to the original Microsoft implementation where it was named FMULTT +; +; Input: +; - .A - must load FAC1 exponent ($61) beforehand to set the zero flag +; +; +; See also: +; - [CM64] Computes Mapping the Commodore 64 - page 113 XXX address does not match +; - https://www.c64-wiki.com/wiki/Floating_point_arithmetic +; - https://codebase64.org/doku.php?id=base:kernal_floating_point_mathematics +; + +mul_FAC2_FAC1: + + bne @1 + jmp MULTRT ; If FAC1=0 return. FAC1 is set +@1: jsr MULDIV ; Fix up the exponents + lda #0 ; To clear result + sta RESHO+0 + sta RESHO+1 + sta RESHO+2 + sta RESHO+3 + lda FACOV + jsr MLTPLY + lda FAC1_mantissa+3 + jsr MLTPLY + lda FAC1_mantissa+2 + jsr MLTPLY + lda FAC1_mantissa+1 + jsr MLTPLY + lda FAC1_mantissa+0 + jsr MLTPL1 + jmp mov_RES_FAC1 ; Move result into FAC1, normalize and return + +MLTPLY: + bne MLTPL1 + jmp shift_for_mul_RES ; Shift result right 1 byte +MLTPL1: + lsr + ora #$80 +MLTPL2: + tay + bcc MLTPL3 ; If mult bit=0, just shift + clc + lda RESHO+3 + adc FAC2_mantissa+3 + sta RESHO+3 + lda RESHO+2 + adc FAC2_mantissa+2 + sta RESHO+2 + lda RESHO+1 + adc FAC2_mantissa+1 + sta RESHO+1 + lda RESHO+0 + adc FAC2_mantissa+0 + sta RESHO+0 +MLTPL3: + ror RESHO+0 + ror RESHO+1 + ror RESHO+2 + ror RESHO+3 + ror FACOV ; Save for rounding + tya + lsr ; Clear MSB so we get closer to 0 + bne MLTPL2 ; Slow as a turtle! +MULTRT: + rts diff --git a/src/basic/math/bab7.MULDIV.s b/src/basic/math/bab7.MULDIV.s new file mode 100644 index 00000000..995f5080 --- /dev/null +++ b/src/basic/math/bab7.MULDIV.s @@ -0,0 +1,47 @@ +;; #LAYOUT# STD * #TAKE +;; #LAYOUT# X16 BASIC_0 #TAKE-OFFSET 2000 +;; #LAYOUT# * BASIC_0 #TAKE +;; #LAYOUT# * * #IGNORE + +; This file is under the MIT license, it contains code released by Microsoft Corporation. +; See LICENSE for more information. + +; Math package - add exponents of FAC1 and FAC2 for multiplication and division +; +; This is verified to be identical to the original Microsoft implementation where it was named MULDIV +; + + + ;CHECK SPECIAL CASES AND ADD EXPONENTS FOR FMULT, FDIV. + +MULDIV: + lda FAC2_exponent ; Exponent of FAC2 = 0? +MLDEXP: + beq ZEREMV + clc + adc FAC1_exponent ; Result is in A + bcc @1 ; Find CF XOR NF + bmi GOOVER ; Overflow if bits match + clc + +skip_2_bytes_trash_nvz +@1: + bpl ZEREMV ; underflow + adc #$80 ; Add bias + sta FAC1_exponent + bne @2 + jmp ZEROML ; Zero the rest of it +@2: + lda ARISGN + sta FAC1_sign ; ARISGN is result's sign + rts + +MLDVEX: + lda FAC1_sign + eor #$FF + bmi GOOVER +ZEREMV: + pla ; Get address off stack + pla + jmp zero_FAC1 ; underflow +GOOVER: + jmp overflow_error ; overflow diff --git a/src/basic/math/bb12.div_FAC2_FAC1.s b/src/basic/math/bb12.div_FAC2_FAC1.s index 80efb11f..1e778874 100644 --- a/src/basic/math/bb12.div_FAC2_FAC1.s +++ b/src/basic/math/bb12.div_FAC2_FAC1.s @@ -32,7 +32,7 @@ div_FAC2_FAC1: ; Handle special case - dividing 0 by non-zero value lda FAC2_exponent - +beq set_FAC1_zero + +beq clear_FAC1 ; Multiply signs @@ -59,7 +59,7 @@ div_FAC2_FAC1: @1: lda RESHO+1 - +bmi set_FAC1_zero ; result too low, set 0 and quit + +bmi clear_FAC1 ; result too low, set 0 and quit lda RESHO+0 sta FAC1_exponent diff --git a/src/basic/math/mul_FAC2_FAC1.s b/src/basic/math/mul_FAC2_FAC1.s deleted file mode 100644 index abbe57c6..00000000 --- a/src/basic/math/mul_FAC2_FAC1.s +++ /dev/null @@ -1,195 +0,0 @@ -;; #LAYOUT# STD * #TAKE -;; #LAYOUT# * BASIC_0 #TAKE -;; #LAYOUT# * * #IGNORE - -; -; Math package - multiplies FAC1 by FAC2 -; -; Input: -; - .A - must load FAC1 exponent ($61) beforehand to set the zero flag -; -; Note: -; - load FAC2 after FAC1, or mimic the Kernals sign comparison (XXX do we need it?) -; -; See also: -; - [CM64] Computes Mapping the Commodore 64 - page 113 XXX address does not match -; - https://www.c64-wiki.com/wiki/Floating_point_arithmetic -; - https://codebase64.org/doku.php?id=base:kernal_floating_point_mathematics -; - -set_FAC1_zero: - - lda #$00 - sta FAC1_exponent - -mul_FAC2_FAC1_done: - - rts - -mul_FAC2_FAC1: - - ; First handle special case of multiplying by 0 - - lda FAC1_exponent - beq mul_FAC2_FAC1_done - - lda FAC2_exponent - bne @1 - sta FAC1_exponent - beq mul_FAC2_FAC1_done -@1: - ; Multiply signs - - lda FAC1_sign - eor FAC2_sign - sta FAC1_sign - - ; Add the exponents (subtract the bias) - XXX can this be optimized somehow? - - jsr muldiv_RESHO_set_0 - - lda FAC1_exponent - jsr muldiv_RESHO_01_add_A - - lda FAC2_exponent - jsr muldiv_RESHO_01_add_A - - lda RESHO+0 - sbc #$80 ; we need to correct double BIAS - sta RESHO+0 - bcs @2 - lda RESHO+1 - sbc #$00 - bcc set_FAC1_zero - sta RESHO+1 -@2: - lda RESHO+1 - +bne overflow_error ; overflow - - lda RESHO+0 - sta FAC1_exponent - - ; Multiply the mantissas - - jsr muldiv_RESHO_set_0 - clc - - ; XXX maybe we should preserve .X on stack? this will not cost us too much - - lda FACOV - jsr mul_FAC2_FAC1_by_A - jsr mul_FAC2_FAC1_shift - bcc @3 - inc RESHO+0 -@3: - lda FAC1_mantissa+3 - jsr mul_FAC2_FAC1_by_A - jsr mul_FAC2_FAC1_shift - bcc @4 - inc RESHO+0 -@4: - lda FAC1_mantissa+2 - jsr mul_FAC2_FAC1_by_A - jsr mul_FAC2_FAC1_shift - bcc @5 - inc RESHO+0 -@5: - lda FAC1_mantissa+1 - jsr mul_FAC2_FAC1_by_A - jsr mul_FAC2_FAC1_shift - bcc @6 - inc RESHO+0 -@6: - lda FAC1_mantissa+0 - jsr mul_FAC2_FAC1_by_A - jsr mul_FAC2_FAC1_shift - bcc @7 - inc RESHO+0 -@7: - ; Copy RESHO to FAC1 mantissa - - lda RESHO+4 - sta FACOV - lda RESHO+3 - sta FAC1_mantissa+3 - lda RESHO+2 - sta FAC1_mantissa+2 - lda RESHO+1 - sta FAC1_mantissa+1 - lda RESHO+0 - sta FAC1_mantissa+0 - - ; Correct the exponent - - lda FAC1_exponent - clc - adc #$08 - +bcs overflow_error ; branch if overflow - sta FAC1_exponent - jmp normal_FAC1 - -mul_FAC2_FAC1_by_A: - - beq mul_FAC2_FAC1_by_A_done - sta INDEX+3 - - ; Multiply FAC2_mantissa+3 - - lda FAC2_mantissa+3 - jsr mul_FAC2_FAC1_8x8 - - adc RESHO+4 - sta RESHO+4 - txa - adc RESHO+3 - sta RESHO+3 - bcc @8 - inc RESHO+2 - bne @8 - inc RESHO+1 - bne @8 - inc RESHO+0 -@8: - ; Multiply FAC2_mantissa+2 - - lda FAC2_mantissa+2 - jsr mul_FAC2_FAC1_8x8 - - adc RESHO+3 - sta RESHO+3 - txa - adc RESHO+2 - sta RESHO+2 - bcc @9 - inc RESHO+1 - bne @9 - inc RESHO+0 -@9: - ; Multiply FAC2_mantissa+1 - - lda FAC2_mantissa+1 - jsr mul_FAC2_FAC1_8x8 - - adc RESHO+2 - sta RESHO+2 - txa - adc RESHO+1 - sta RESHO+1 - bcc @10 - inc RESHO+0 -@10: - ; Multiply FAC2_mantissa+0 - - lda FAC2_mantissa+0 - jsr mul_FAC2_FAC1_8x8 - adc RESHO+1 - sta RESHO+1 - txa - adc RESHO+0 - sta RESHO+0 - - ; FALLTROUGH - -mul_FAC2_FAC1_by_A_done: - - rts diff --git a/src/basic/math/mul_FAC2_FAC1_shift.s b/src/basic/math/mul_FAC2_FAC1_shift.s deleted file mode 100644 index 7e3eaada..00000000 --- a/src/basic/math/mul_FAC2_FAC1_shift.s +++ /dev/null @@ -1,46 +0,0 @@ -;; #LAYOUT# STD * #TAKE -;; #LAYOUT# * BASIC_0 #TAKE -;; #LAYOUT# * * #IGNORE - -; -; Shift RESHO by one byte - for multiplication -; - -mul_FAC2_FAC1_shift: - - ; Check if rounding is needed - - php - clc - lda RESHO+4 - bpl @1 - sec -@1: - ; Copy bytes - - lda RESHO+3 - sta RESHO+4 - lda RESHO+2 - sta RESHO+3 - lda RESHO+1 - sta RESHO+2 - lda RESHO+0 - sta RESHO+1 - lda #$00 - sta RESHO+0 - bcc @2 - - ; Perform rounding - - inc RESHO+4 - bne @2 - inc RESHO+3 - bne @2 - inc RESHO+2 - bne @2 - inc RESHO+1 - bne @2 - inc RESHO+0 -@2: - plp - rts diff --git a/tools/similarity.c b/tools/similarity.c index c8a98373..4c80306f 100644 --- a/tools/similarity.c +++ b/tools/similarity.c @@ -20,15 +20,14 @@ int matches[MAX_SIZE]; int phase_mask[MAX_SIZE+MAX_SIZE]; -#define NUM_CHUNKS 7 +#define NUM_CHUNKS 6 // Pairs of start, end memory addresses of known exact similarity with the open source Microsoft BASIC unsigned short microsoft_basic_chunks[NUM_CHUNKS * 2] = { 0xB391, 0xB39D, 0xB3A2, 0xB3A5, 0xB849, 0xB97D, 0xB983, 0xB9BB, - 0xBA28, 0xBA2A, - 0xBA8C, 0xBAB6, + 0xBA28, 0xBAE1, 0xBB8F, 0xBCF2, };