support6800/__mulf.s Faster float multiplication

[zu2]

This is based on the existing __mulf.c. It is somewhat redundant, but fast enough.

Replacing __mull with a faster one will make it even faster, but it will use more memory.

	.setcpu 6800
	.code
	.export __mulf
	.code
__mulf:
	des
	des
	des
	des
	des
	des
	des
	des
	des
	des
;	if (!a1 || !a2) return (0);
	tsx
	ldaa 16,x	; a1
	oraa 17,x
	oraa 18,x
	oraa 19,x
	beq L0L
	ldaa 12,x	; a2
	oraa 13,x
	oraa 14,x
	oraa 15,x
	bne L1_e
L0L:
	clra
	clrb
	staa @hireg
	stab @hireg+1
;
	jmp L0_r
L1_e:
;	sign = (a1 ^ a2) & SIGNBIT;
;;		sign 6,x - 9,x but use only  6,x
	ldaa 16,x	; a1
	eora 12,x	; a2
	anda #$80
	staa 6,x
;	exp = EXP(a1) - EXCESS;
	ldab 16,x	; a1
	ldaa 17,x
	asla
	rolb
	clra
	subb #126
	sbca #0
	stab 5,x
	staa 4,x
;	exp += EXP(a2);
	ldab 12,x	; a2
	ldaa 13,x
	asla
	rolb
	clra
	addb 5,x
	adca 4,x
	stab 5,x
	staa 4,x
;	a1 = MANT(a1);
	clr	16,x
	ldaa 17,x
	oraa #$80
	staa 17,x
;	a2 = MANT(a2);
	clr	12,x
	ldaa 13,x
	oraa #$80
	staa 13,x
;	result = (a1 >> 8) * (a2 >> 8);
;		(a1>>8)
	ldab 18,x
	pshb
	ldab 17,x
	pshb
	ldab 16,x
	pshb
	clra
	psha
;		(a2>>8)
	staa @hireg
	ldaa 12,x
	staa @hireg+1
	ldab 14,x
	ldaa 13,x
;		*
	jsr __mull
;		result = ...
	tsx
	stab 3,x
	staa 2,x
	ldaa @hireg+1
	staa 1,x
	ldaa @hireg
	staa 0,x
;	result += ((a1 & 0xFFUL) * (a2 >> 8)) >> 8;
;;		(a1 & 0xFFUL)
	ldab 19,x
	pshb
	clra
	psha
	psha
	psha
;;		(a2 >> 8)
	staa @hireg
	ldaa 12,x
	staa @hireg+1
	ldab 14,x
	ldaa 13,x
	jsr __mull
;	result += (...) >> 8
	tsx
	adda 3,x
	staa 3,x
	ldaa 2,x
	adca @hireg+1
	staa 2,x
	ldaa 1,x
	adca @hireg
	staa 1,x
	ldaa 0,x
	adca #0
	staa 0,x
;	result += ((a2 & 0xFFUL) * (a1 >> 8)) >> 8;
;		(a2 & 0xFFUL)
;;		result 0,x - 3,x
;;		a1 16,x - 19,x
;;		a2 12,x - 15,x
	ldab 15,x
	pshb
	clra
	psha
	psha
	psha
;		(a1 >> 8)
	staa @hireg
	ldaa 16,x
	staa @hireg+1
	ldab 19,x
	ldaa 18,x
	jsr __mull
;	result += (...) >> 8
	tsx
	adda 3,x
	staa 3,x
	ldaa 2,x
	adca @hireg+1
	staa 2,x
	ldaa 1,x
	adca @hireg
	staa 1,x
	ldaa 0,x
	adca #0
	staa 0,x
;	result += 0x40;
	ldab 3,x
	addb #64
	stab 3,x
	ldab 2,x
	adcb #0
	stab 2,x
	ldab 1,x
	adcb #0
	stab 1,x
	ldab 0,x
	adcb #0
	stab 0,x
;	if (result & SIGNBIT) {
	bpl	L2_e
;	result += 0x40; result >>= 8;
	ldab 3,x
	addb #64
	ldab 2,x
	adcb #0
	stab 3,x
	ldab 1,x
	adcb #0
	stab 2,x
	ldab 0,x
	adcb #0
	stab 1,x
	clr 0,x
	bra L2_f
L2_e:
;	} else {
;	result >>= 7;
	ldaa 3,x
	asla
	ldaa 2,x
	rola
	staa 3,x
	ldaa 1,x
	rola
	staa 2,x
	ldaa 0,x
	rola
	staa 1,x
	ldaa #0
	rola
	staa 0,x
;	exp--;
	ldb 5,x
	lda 4,x
	addb #255
	adca #255
	stb 5,x
	sta 4,x
;
L2_f:
;	result &= ~HIDDEN;
	ldab 1,x
	andb #127
	stab 1,x
;	if (exp >= 0x100)
	ldaa 4,x
	cmpa #1
	blt	L3_e
;	a1 = (sign ? SIGNBIT : 0) | INFINITY;
;;	a1 = (sign ? 0x80000000UL: 0) | 0x78000000UL;
;;		sign 6,x - 9,x
	clrb
	stab 19,x
	stab 18,x
	stab 17,x
	ldab 6,x
	orb #$78
	stab 16,x
	jmp L3_f
L3_e:
;	else if (exp < 0)
	tst	4,x
	bpl	L4_e
;	a1 = 0;
	clra
	staa 19,x
	staa 18,x
	staa 17,x
	staa 16,x
	jmp L4_f
L4_e:
;	else
;	a1 = PACK(sign ? SIGNBIT : 0, exp, result);
;;	a1 = PACK(sign ? 0x80000000UL : 0, exp, result);
;;	a1 16,x
;;	sign 6,x
;;	exp 4-5,x
;;	result 0-3,x
	ldab 3,x
	stab 19,x
	ldab 2,x
	stab 18,x
	ldab 1,x
	ldaa 5,x
	lslb
	rora
	rorb
	stab 17,x
	oraa 6,x
	staa 16,x
L4_f:
L3_f:
	ldaa 18,x
	ldab 19,x
	ldx 16,x
	stx @hireg
;
L0_r:
	ins
	ins
	ins
	ins
	ins
	ins
	ins
	ins
	ins
	ins
	jmp __cleanup8

[zu2]

typo.

--- support6800/mulf_old.s	2024-10-30 23:49:23
+++ support6800/mulf.s	2024-10-30 23:47:24
@@ -138,8 +138,8 @@
 	staa @hireg
 	ldaa 16,x
 	staa @hireg+1
-	ldab 19,x
-	ldaa 18,x
+	ldab 18,x
+	ldaa 17,x
 	jsr __mull
 ;	result += (...) >> 8
 	tsx