Update mul_FAC2_FAC1

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

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

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

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

src/basic/math/mul_FAC2_FAC1.s

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

src/basic/math/mul_FAC2_FAC1_shift.s

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

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,
+    0xBA28, 0xBAE1,
-    0xBA8C, 0xBAB6,
     0xBB8F, 0xBCF2,
 };