default nanop ccnop ldnop sb aluz yd car0 ss0 alubr mdrikd marika
global mult32

; TWO'S COMPLEMENT 32-BIT MULTIPLY USING MULTIPLIER CHIP (20 instructions)
;    (r14,r13) = r12*r11
; 32-bit operands, 64-bit result
; r12 and Q get clobbered, r11 does not
;
; Paul Heckbert    30 Oct 82
;
; NOTATION: (x1,x0) = 2^32*x1+x0 = a*b = (2^16*a1 + a0) * (2^16*b1 + b0)
;           where a0,a1,b0,b1 are 16-bit; x0,x1 are 32 bit
; VARIABLE:   a   b  x1  x0   t
; REGISTER:  11  12  14  13  12

mult32:
	pr ra12 alumpy  ldudr 0xffff		; MPY=b0
	pr ra11 alumpx  ccy16 jmpdf fixb1	; MPX=a0; if b0<0 fix b1
	pr rbhs b12 alumpy  jmpdf b1ok		; MPY=b1
fixb1:	pr rbhs b12 alumpy car1			; MPY=b1+1
b1ok:	mpzbr b13  pr rimm 0 bdqd		; x0=MPZ=a0*b0; Q=0xffff0000
	mpzbr b14 bd  pr ra13		 	; x1=MPZ=a0*b1; x0?
	ras rbhr b14 sq qd  ccneg jmpdf xn	; Q&=x1<<>16; if x0<0 go xn

xp:	pr ra11					; a?
	rps ra13 sq b13 bd  ccy16 jmpdf xpan	; x0+=Q; if a0<0 goto xpan
xpap:	pr car31 rbhs b14 lsxbd			; x1=SXT((x1>>16)+carry)
	smr car1 rlimm 0x8000 b13 bd		; x0=x0-0x8000 (unround 4x)
	smr car31 rlimm 0x8001 b14 bd		; x1=x1-0x8001+carry
	pr rbhs b11 alumpx  jmpdf a1ok		; MPX=a1

xpan:	pr car31 rbhs b14 lsxbd			; x1=SXT((x1>>16)+carry)
	smr car1 rlimm 0x8000 b13 bd		; x0=x0-0x8000 (unround 4x)
	smr car31 rlimm 0x8001 b14 bd		; x1=x1-0x8001+carry
	pr car1 rbhs b11 alumpx  jmpdf a1ok	; MPX=a1+1

xn:	pr ra11					; a?
	rps ra13 sq b13 bd  ccy16 jmpdf xnan	; x0+=Q; if a0<0 goto xnan
xnap:	pr car31 rbhs b14 lsxbd			; x1=SXT((x1>>16)+carry)
	smr car1 rlimm 0x8000 b13 bd		; x0=x0-0x8000 (unround 4x)
	smr car31 rlimm 0x8002 b14 bd		; x1=x1-0x8002+carry (s.x. x0)
	pr rbhs b11 alumpx  jmpdf a1ok		; MPX=a1

xnan:	pr car31 rbhs b14 lsxbd			; x1=SXT((x1>>16)+carry)
	smr car1 rlimm 0x8000 b13 bd		; x0=x0-0x8000 (unround 4x)
	smr car31 rlimm 0x8002 b14 bd		; x1=x1-0x8002+carry (s.x. x0)
	pr car1 rbhs b11 alumpx  jmpdf a1ok	; MPX=a1+1

a1ok:	pr ra12 alumpy  ldudr 0xffff		; MPY=b0
	mpzbr b12 bd				; t=MPZ=a1*b1
	rps ra12 b14 bd				; x1+=t
	mpzbr b12  pr rimm 0 bdqd	 	; t=MPZ=a1*b0; Q=0xffff0000
	ras rbhr b12 sq qd			; Q&=t<<>16
	rps ra13 sq b13 bd			; x0+=Q
	pr car31 rbhs b12 lsxbd			; t=SXT((t>>16)+carry)
	rps ra12 b14 bd  naretn			; x1+=t
end