.title	QuadMath Quadword Math Routines

;
; Author:	R Eldridge
;		104 Computer Science
;		Iowa State University
;		Ames, IA 50011
;		(515) 294-5659
;
; Created:	March 1986
;
; References:	VAX Architecture Handbook
;		DECUS SIG Tape [VAX84A.HUGHES]QUADMATH.MAR
;


global module addq <quad1,quad2> -
  psect=quad_math -
  mask=<r2,r3>

begin

	movl	addq.quad1(ap),r1
	movl	addq.quad2(ap),r2

	addl	(r1),(r2)
	adwc	4(r1),4(r2)

	if <tstl 4(r2)> lss then
	  movl	#-1,r0				; quad2 < 0
	elseif gtr or <tstl (r2)> nequ then
	  movl	#1,r0				; quad2 > 0
	else
	  clrl	r0				; quad2 = 0
	end

	return

end addq


global module addq3 <quad1,quad2,quad> -
  psect=quad_math -
  mask=<r2,r3>

begin

	movl	addq3.quad1(ap),r1
	movl	addq3.quad2(ap),r2
	movl	addq3.quad3(ap),r3

	movq	(r2),(r3)
	addl	(r1),(r3)
	adwc	4(r1),4(r3)

	if <tstl 4(r3)> lss then
	  movl	#-1,r0				; quad3 < 0
	elseif gtr or <tstl (r3)> nequ then
	  movl	#1,r0				; quad3 > 0
	else
	  clrl	r0				; quad3 = 0
	end

	return

end addq3


global module clrq <quad> -
  psect=quad_math

begin

	movl	clrq.quad(ap),r1
	clrq	(r1)

	clrl	r0				; quad = 0

	return

end clrq


global module cmpq <quad1,quad2> -
  psect=quad_math -
  mask=<r2,r3,r4,r5>
	
begin

	movl	cmpq.quad1(ap),r1
	movl	cmpq.quad2(ap),r2

	movq	(r1),r4

	subl	(r2),r4
	sbwc	4(r2),r5

	if <tstl r5> lss then
	  movl	#-1,r0				; quad1 < quad2
	elseif gtr or <tstl r4> nequ then
	 movl	#1,r0				; quad1 > quad2
	else
	  clrl	r0				; quad1 = quad2
	end

	return

end cmpq


global module divq4 <divr,divd,quo,rem> -
  psect=quad_math -
  mask=<r2,r3,r4,r5,r6,r7,r8,r9,r10,r11>

begin

 	movq	@divq4.divr(ap),r0
 	movq	@divq4.divd(ap),r2

 	movq	r2,r4				; quo = divd
 	clrq	r6				; rem = 0
 	clrl	r8				; "carry" flag

	for	r10 from=#0 to=#64 do

	  ashq	#1,r6,r6			; shift left by 1
	  bisl2	r8,r6				; shift in from divd "carry"
	  clrl	r8				; clear "carry" flag

	  if <cmpl r1,r7> eql then		; if divr > current rem
	    cmpl  r0,r6
	  elseif lequ then
	    subl2 r0,r6				; subtract divr from rem
	    sbwc  r1,r7
	    incl  r8				; set "carry" flag
	  end

	  if <tstl r5> lss then			; "carry" after the shift?
	    incl  r9				; yes
	  else
	    clrl  r9				; no
	  end

	  ashq	#1,r4,r4			; shift quo left by 1
	  bisl2	r8,r4				; shift in a new bit
	  movl	r9,r8				; set "carry" flag

	end

	movq	r4,@divq4.quo(ap)		; save the quotient
	movq	r6,@divq4.rem(ap)		; and the remainder

	if <tstl 4(r4)> lss then
	  movl	#-1,r0				; quo < 0
	elseif gtr or <tstl (r4)> nequ then
	  movl	#1,r0				; quo > 0
	else
	  clrl	r0				; quo = 0
	end

	return

end divq4


global module movq <quad1,quad2> -
  psect=quad_math -
  mask=<r2>

begin

	movl	movq.quad1(ap),r1
	movl	movq.quad2(ap),r2

	movq	(r1),(r2)

	if <tstl 4(r2)> lss then
	  movl	#-1,r0				; quad2 < 0
	elseif gtr or <tstl (r2)> nequ then
	  movl	#1,r0				; quad2 > 0
	else
	  clrl	r0				; quad2 = 0
	end

	return

end movq


global module mulq <mulr,prod> -
  psect=quad_math -
  mask=<r2,r3,r4,r5,r6,r7>

begin

	movl	mulq.mulr(ap),r1
	movl	mulq.prod(ap),r2

	emul	(r0),(r1),#0,r6
	mull3	4(r0),(r1),r4
	mull3	(r0),4(r1),r5
	addl	r5,r4

	if <tstl (r0)> lss then
	  addl	(r1),r4
	end

	if <tstl (r1)> lss then
	  addl	(r0),r4
	end

	addl	r4,r7
	movq	r6,(r2)

	if <tstl 4(r2)> lss then
	  movl	#-1,r0				; prod < 0
	elseif gtr or <tstl (r2)> nequ then
	  movl	#1,r0				; prod > 0
	else
	  clrl	r0				; prod = 0
	end

	return

end mulq


global module mulq3 <mulr,muld,prod> -
  psect=quad_math -
  mask=<r2,r3,r4,r5>

begin

	movl	mulq3.mulr(ap),r1
	movl	mulq3.muld(ap),r2
	movl	mula3.prod(ap),r3

	emul	(r0),(r1),#0,(r3)
	mull3	4(r0),(r1),r4
	mull3	(r0),4(r1),r5
	addl	r5,r4

	if <tstl (r0)> lss then
	  addl	(r1),r4
	end

	if <tstl (r1)> lss then
	  addl	(r0),r4
	end

	addl	r4,4(r3)

	if <tstl 4(r3)> lss then
	  movl	#-1,r0				; prod < 0
	elseif gtr or <tstl (r3)> nequ then
	  movl	#1,r0				; prod > 0
	else
	  clrl	r0				; prod = 0
	end

	return

end mulq3


global module subq <quad1,quad2> -
  psect=quad_math -
  mask=<r2>

begin

	movl	subq.quad1(ap),r1
	movl	subq.quad2(ap),r2

	subl	(r1),(r2)
	sbwc	4(r1),4(r2)

	if <tstl 4(r2)> lss then
	  movl	#-1,r0				; quad2 < 0
	elseif gtr or <tstl (r2)> nequ then
	  movl	#1,r0				; quad2 > 0
	else
	  clrl	r0				; quad2 = 0
	end

	return

end subq


global module subq3 <quad1,quad2,quad3> -
  psect=quad_math -
  mask=<r2,r3>

begin

	movl	subq3.quad1(ap),r1
	movl	subq3.quad2(ap),r2
	movl	subq3.quad3(ap),r3

	movq	(r2),(r3)
	subl	(r1),(r3)
	sbwc	4(r1),4(r3)

	if <tstl 4(r3)> lss then
	  movl	#-1,r0					; quad1 < 0
	elseif gtr or <tstl (r3)> nequ then
	  movl	#1,r0					; quad2 > 0
	else
	  clrl	r0					; quad3 = 0
	end

	return

end subq3


global module tstq <quad> -
  psect=quad_math

begin

	movl	tstq.quad(ap),r1

	if <tstl 4(r1)> lss then
	  movl	#-1,r0				; quad < 0
	elseif gtr or <tstl (r1)> nequ then
	  movl	#1,r0				; quad > 0
	else
	  clrl	r0				; quad = 0
	end

	return

end tstq

.end