;	Static Name Aliases
;
	TITLE   mulm

include qheadl.asm

QFLT_DATA	SEGMENT
temp	DW	NQ+2 DUP (?)
source	DW	NQ+2 DUP (?)
QFLT_DATA	ENDS

QFLT_TEXT      SEGMENT
	ASSUME	CS: QFLT_TEXT

; Multiply mantissa of x by mantissa of y, result to y
; subm( x, y )
	PUBLIC	_mulm
_mulm	PROC FAR
	push	bp
	mov	bp,sp
	push	si
	push	di
	push	ax
	push	bx
	push	cx
	push	dx
	push	es
	push	ds

	push	ds
	pop	es

; temp area for the product
	lea	bx,temp
; clear the temp area
	xor	ax,ax
	mov	di,bx
	mov	cx,NQ+2
	rep	stosw

; read source
	push	ds
	lea	di,source
	add	di,4
	mov	cx,OMG
	lds	si,DWORD PTR [bp+6]
	ASSUME DS: NOTHING
	add	si,4
	rep	movsw

	pop	ds
	ASSUME DS: DGROUP
	lea	si,source
	les	di,DWORD PTR [bp+10]	;dest

	xor	cx,cx	; for adc 0

hh = OMG-1

rept OMG-1

g = 0
h = hh
rept (hh+1)/2
if g LE OMG-2
if h LE OMG-2
	zmul	g,h
	zmul	h,g
endif
endif
g = g+1
h = h-1
endm

if g EQ h
	zmul	g,g
endif

hh = hh-1

endm

	zmul	0,0

mulnorm:
	push ds
	pop dx
	call	far ptr mdnorm

	mov	si,bx
	add	si,4
	add	di,4
	mov	cx,OMG
	rep	movsw


	pop	ds
	pop	es
	pop	dx
	pop	cx
	pop	bx
	pop	ax
	pop	di
	pop	si
	pop	bp
	ret	
_mulm	ENDP



; Source has at most 16 significant bits

	PUBLIC	_mulin
_mulin	PROC NEAR
	push	bp
	mov	bp,sp
	push	si
	push	di
	push	ax
	push	bx
	push	cx
	push	dx
	push	es
	push	ds

	push	ds
	pop	es

; temp area
	lea	bx,temp
; clear the temp area
	xor	ax,ax
	mov	di,bx
	mov	cx,NQ+2
	rep	stosw

; read source
	push	ds
	lea	di,source
	add	di,4
	mov	cx,OMG
	lds	si,DWORD PTR [bp+6]
	ASSUME DS: NOTHING
	add	si,4
	rep	movsw

	pop	ds
	ASSUME DS: DGROUP

	lea	si,source
	les	di,DWORD PTR [bp+10]	;dest

	xor	cx,cx	; for adc 0


h = OMG-2

rept OMG-1
	zmul	h,0
h = h-1
endm

	jmp	mulnorm

_mulin	ENDP



; normalize and round off
; enter with source = bx, dest = di

	PUBLIC mdnorm
mdnorm	PROC FAR
	push ds
	push dx
	pop  ds
	mov	cx,3
$normlp:
	test	word ptr [bx]+6,08000H
	jnz	$round

; Prevent exponent from wrapping around.
; Rounding may be incorrect when this happens.
	test	word ptr es:[di]+2,0FFFFH
	jz	$nlup
	sub	word ptr es:[di]+2,1
; shift up 1 bit and decrement exponent
g = NQ+NQ
	clc
rept OMG
	rcl	word ptr [bx]+g,1
g = g-2
endm
$nlup:
	loop	$normlp

$round:


; round off
g = NQ+NQ
	test	word ptr [bx]+g,08000H
	jnz	$doround
	jmp	$done

$doround:
	xor	cx,cx
g = NQ+NQ-2
	add	word ptr [bx]+g,1
rept OMG-1
g = g-2
	adc	word ptr [bx]+g,cx
endm

; check for overflow on rounding up
	test	word ptr [bx]+4,0FFFFH
	jz	$done

; shift down 1 bit and increment exponent
g = 4
	clc
rept OMG
	rcr	word ptr [bx]+g,1
g = g+2
endm
	add	word ptr es:[di]+2,1


$done:
	pop ds
	ret
mdnorm	ENDP

QFLT_TEXT	ENDS
END