ocaml/otherlibs/num/bignum/s/vaxKerN.s

# Copyright     Digital Equipment Corporation & INRIA     1988, 1989, 1990
#
#		KerN for the VAX.
#		[Bepaul, Shand]
#		Last modified_on Mon Apr  2 21:03:05 GMT+2:00 1990 by shand 
#		     modified_on Mon Nov 20 13:51:10 GMT+1:00 1989 by herve 
#		     modified_on 17-OCT-1989 20:37:48 by Jim Lawton 
#
# >>> IMPORTANT <<<     DO NOT MODIFY THIS LINE
#
# >>> READ THIS <<<
#
# This file is automatically converted from unix to VAX/VMS assembler format.
# On VMS it is the callee's rsponsiblity to save all modified registers
# other than r0 and r1.  On Ultrix r0-r5 are considered saved by caller.
# Specify procedure entry masks that save ALL modified registers (including
# r0 and r1) and "&" them with "callee_save" which is a predefined constant
# that eliminates the saves which are unnecessary under whichever calling
# convention the file is being assembler for.
.set callee_save,~63
	# WARNING: text after comment used in conversion to VMS format assembler
		.data	# vaxKerN_data
_copyright:	.ascii "@(#)vaxKerN.s: copyright Digital Equipment Corporation & INRIA 1988, 1989, 1990\12\0"
	# WARNING: text after comment used in conversion to VMS format assembler
		.text	# vaxKerN
		.globl	_BnnSetToZero
		.align	3
_BnnSetToZero:
		.word	0x3&callee_save	# mask<r0,r1>
		movl	4(ap),r0	# nn
		movl	8(ap),r1	# nl
		sobgeq	r1,LSTZ1	# if(nl--) goto LSTZ1
		ret			# return;
LSTZ1:		clrl	(r0)+		# *(nn++) = 0;
		sobgeq	r1,LSTZ1	# if(nl--) goto LSTZ1;
		ret

		.globl	_BnnAssign
		.align	3
_BnnAssign:
		.word	0x7&callee_save	# mask<r0,r1,r2>
		movl	4(ap),r0	# mm
		movl	8(ap),r1	# nn
		movl	12(ap),r2	# nl
		cmpl	r0,r1
		bgequ	LAG2		# if(mm >= nn) goto LAG2;
		sobgeq	r2,LAG1		# if(nl--) goto LAG1;
		ret			# return;
LAG1:		movl	(r1)+,(r0)+	# *(mm++) = *(nn++);
		sobgeq	r2,LAG1		# if(nl--) goto LAG1;
LAG2:		blequ	LAG4		# if(mm <= nn) goto LAG4;
		moval	(r0)[r2],r0	# mm = &mm[nl];
		moval	(r1)[r2],r1	# nn = &nn[nl];
		sobgeq	r2,LAG3		# if(nl--) goto LAG3;
		ret			# return;
LAG3:		movl	-(r1),-(r0)	# *(--mm) = *(--nn);
		sobgeq	r2,LAG3		# if(nl--) goto LAG3;
LAG4:		ret			# return;

		.globl	_BnnSetDigit
		.align	3
_BnnSetDigit:
		.word	0x0&callee_save	# mask<>
		movl	8(ap),*4(ap)	# *nn = d;
		ret

		.globl	_BnnGetDigit
		.align	3
_BnnGetDigit:
		.word	0x0&callee_save	# mask<>
		movl	*4(ap),r0	# return(*nn);
		ret

		.globl	_BnnNumDigits
		.align	3
_BnnNumDigits:
		.word	0x2&callee_save	# mask<r1>
		movl	8(ap),r0	# nl
		moval	*4(ap)[r0],r1	# nn = &nn[nd];
		sobgeq	r0,LND1		# if(nl-- != 0) goto LND1;
		movl	$1,r0
		ret			# return(1);
LND1:		tstl	-(r1)
		bneq	LND3		# if(*(--n) != 0) goto LND3;
		sobgeq	r0,LND1		# if(nl-- != 0) goto LND1;
		movl	$1,r0
		ret			# return(1);
LND3:		incl	r0
		ret			# return(nl + 1);

		.globl	_BnnNumLeadingZeroBitsInDigit
		.align	3
_BnnNumLeadingZeroBitsInDigit:
		.word	0x2&callee_save	# mask<r1>
		movl	4(ap),r1	# d
		movl	$31,r0
LLZ1:		bbs	r0,r1,LLZ2
		sobgeq	r0,LLZ1
LLZ2:		subl3	r0,$31,r0
		ret

		.globl	_BnnDoesDigitFitInWord
		.align	3
_BnnDoesDigitFitInWord:
		.word	0x0&callee_save	# mask<>
		movl	$1,r0		# C_VERSION
		ret

		.globl	_BnnIsDigitZero
		.align	3
_BnnIsDigitZero:
		.word	0x2&callee_save	# mask<r1>
		tstl	4(ap)		# d
		bneq	LDZ1		# if(d) goto LDZ1;
		movl	$1,r0
		ret			# return(1);
LDZ1:		clrl	r0
		ret			# return(0);

		.globl	_BnnIsDigitNormalized
# Boolean BnIsDigitNormalized(n, nd) BigNum n; int nd; {
		.align	3
_BnnIsDigitNormalized:
		.word	0x0&callee_save	# mask<>
		movl	4(ap),r0	# d
		extzv	$31,$1,r0,r0	# return(d >> 31);
		ret

		.globl	_BnnIsDigitOdd
		.align	3
_BnnIsDigitOdd:
		.word	0x0&callee_save	# mask<>
		bicl3	$-2,4(ap),r0	# return(d || 1);
		ret

		.globl	_BnnCompareDigits
		.align	3
_BnnCompareDigits:
		.word	0x0&callee_save	# mask<>
		cmpl	4(ap),8(ap)	# cmpl d1,d2
		beql	LCDeq		# if(d0 == d1) goto LCDeq
		blssu	LCDinf		# if(d0 < d1) goto LCDinf
		movl	$1,r0		# return(1);
		ret
LCDeq:		clrl	r0		# return(0);
		ret
LCDinf:		movl	$-1,r0		# return(-1);
		ret

		.globl	_BnnComplement
		.align	3
_BnnComplement:
		.word	0x2&callee_save	# mask<r1>
		movl	4(ap),r0	# nn
		movl	8(ap),r1	# nl
		sobgeq	r1,LCM1		# if(nl-- != 0) goto LCM1;
		ret
LCM1:		mcoml	(r0),(r0)+	# *(n++) ^= -1;
		sobgeq	r1,LCM1		# if(nl-- != 0) goto LCM1;
		ret

		.globl	_BnnAndDigits
		.align	3
_BnnAndDigits:
		.word	0x0&callee_save	# mask<>
		mcoml	8(ap),r0	# d = ~d;
		bicl2	r0,*4(ap)	# *nn &= ~d;
		ret

		.globl	_BnnOrDigits
		.align	3
_BnnOrDigits:
		.word	0x0&callee_save	# mask<>
		bisl2	8(ap),*4(ap)	# *nn |= d;
		ret

		.globl	_BnnXorDigits
		.align	3
_BnnXorDigits:
		.word	0x0&callee_save	# mask<>
		xorl2	8(ap),*4(ap)	# *nn ^= d;
		ret

		.globl	_BnnShiftLeft
		.align	3
_BnnShiftLeft:
		.word	0x7E&callee_save	# mask<r1,r2,r3,r4,r5,r6>
		clrl	r0		# res = 0;
		movl	12(ap),r3	# nbi
		bneq	LSL0		# if(nbi) goto LSL0
		ret			# return(res);
LSL0:		movl	4(ap),r2	# mm
		movl	8(ap),r1	# ml
		subl3	r3,$32,r4	# rnbi = BN_DIGIT_SIZE - nbi;
		sobgeq	r1,LSL1		# if(ml-- != 0) goto LSL1;
		ret			# return(res);
LSL1:		movl	(r2),r5		# save = *mm
		ashl	r3,r5,r6	# X = save << nbi;
		bisl3	r0,r6,(r2)+	# *(mm++) = X | res;
		extzv	r4,r3,r5,r0	# res = save >> rnbits;
		sobgeq	r1,LSL1		# if(ml-- != 0) goto LSL1;
		ret			# return(res);

		.globl	_BnnShiftRight
		.align	3
_BnnShiftRight:
		.word	0x7E&callee_save	# mask<r1,r2,r3,r4,r5,r6>
		clrl	r0		# res = 0;
		movl	12(ap),r3	# nbi
		bneq	LSR0		# if(nbi) goto LSR0;
		ret			# return(res);
LSR0:		movl	8(ap),r1	# ml
		moval	*4(ap)[r1],r2	# mm = &mm[ml];
		subl3	r3,$32,r4	# lnbi = BN_DIGIT_SIZE - nbi;
		sobgeq	r1,LSR1		# if(ml-- != 0) goto LSR1;
		ret			# return(res);
LSR1:		movl	-(r2),r5	# save = *(--mm);
		extzv	r3,r4,r5,r6	# X = save >> nbi;
		bisl3	r0,r6,(r2)	# *mm = X | res;
		ashl	r4,r5,r0	# res = save << lnbi;
		sobgeq	r1,LSR1		# if(ml-- != 0) goto LSR1;
		ret			# return(res);

		.globl	_BnnAddCarry
		.align	3
_BnnAddCarry:
		.word	0x2&callee_save	# mask<r1>
		movl	12(ap),r0	# car
		beql	LAC3		# if(car == 0) return(car);
		movl	8(ap),r0	# nl
		beql	LAC2		# if(nl == 0) return(1);
		movl	4(ap),r1	# nn
LAC1:		incl	(r1)+		# ++(*nn++);
		bcc	LAC4		# if(!Carry) goto LAC4
		sobgtr	r0,LAC1		# if(--nl > 0) goto LAC1;
LAC2:		movl	$1,r0		# return(1);
LAC3:		ret
LAC4:		clrl	r0		# return(0);
		ret

		.globl	_BnnAdd
		.align	3
_BnnAdd:
		.word	0x1E&callee_save	# mask<r1,r2,r3,r4>
LADDEntry:	movl	4(ap),r0	# mm
		movl	12(ap),r1	# nn
		movl	16(ap),r3	# nl
		bneq	LADD1		# if(nl) goto LADD1
		subl3	r3,8(ap),r2	# ml -= nl;
		tstl	20(ap)		# car
		bneq	LADD5		# if(car) goto LADD5
		clrl	r0
		ret			# return(0);
LADD1:		subl3	r3,8(ap),r2	# ml -= nl;
		addl3	20(ap),$-1,r4	# C = car

LADD2:		adwc	(r1)+,(r0)+	# *(m++) += *(n++) + C;
LADD3:		sobgtr	r3,LADD2	# if(--nl > 0) goto LADD2;
		bcs	LADD5		# if(C) goto LADD5;
LADD4:		clrl	r0
		ret

LADD6:		incl	(r0)+		# ++(*m++);
		bcc	LADD4		# if(!C) goto LADD4;
LADD5:		sobgeq	r2,LADD6	# if(--ml >= 0) goto LADD6;
LADD7:		movl	$1,r0
		ret

		.globl	_BnnSubtractBorrow
		.align	3
_BnnSubtractBorrow:
		.word	0x2&callee_save	# mask<r1>
		movl	12(ap),r0	# car
		bneq	LSB2		# if(car) return(car);
		movl	8(ap),r0	# nl
		beql	LSB20		# if(nl == 0) return(0);
		movl	4(ap),r1	# nn
LSB1:		decl	(r1)+		# (*nn++)--;
		bcc	LSB3		# if(!Carry) goto LSB3;
		sobgtr	r0,LSB1		# if(--nl > 0) goto LSB1;
LSB20:		# assert r0 == 0	  return(0);
LSB2:		ret
LSB3:		movl	$1,r0		# return(1);
		ret

		.globl	_BnnSubtract
		.align	3
_BnnSubtract:
		.word	0x1E&callee_save	# mask<r1,r2,r3,r4>
		movl	4(ap),r2	# mm
		movl	12(ap),r1	# nn
		movl	16(ap),r3	# nl
		bneq	LS1		# if(nl) goto LS1
		subl3	r3,8(ap),r0	# ml -= nl;
		tstl	20(ap)		# car
		beql	LS5		# if(car) goto LS5
		movl	$1,r0
		ret			# return(1);
LS1:		subl3	r3,8(ap),r0	# ml -= nl;
		tstl	20(ap)		# C = 0; Z = (car == 0)
		bneq	LS2		# if(!(Z = (car == 0))) goto LS2
		addl3	$1,$-1,r4	# C = 1;

LS2:		sbwc	(r1)+,(r2)+	# C..*m++ -= *n++ + C
		sobgtr	r3,LS2		# if(--nl > 0) goto LS2
		bcs	LS5
LS3:		movl	$1,r0
		ret
LS4:		decl	(r2)+
		bcc	LS3
LS5:		sobgeq	r0,LS4		# if (--ml >= 0) goto LS4
		clrl	r0
		ret

		.globl	_BnnMultiplyDigit
# note1: (2^32-1)*(2^32-1) = 2^64-1 - 2*(2^32-1)
# thus 64 bits accomodates a*b+c+d for all a,b,c,d < 2^32
# note2: inner loop is doubled to avoid unnecessary register moves.
		.align	3
_BnnMultiplyDigit:
		.word	0x1FE&callee_save	# mask<r1,r2,r3,r4,r5,r6,r7,r8>
		movl	20(ap),r2	# r2 = d
		blss	LMDNeg		# if (d<0) goto LMDNeg
		bneq	LMD1		# if (d) goto LMD1;
		clrl	r0
		ret
LMD1:		cmpl	$1,r2
		bneq	LMD2		# if (d != 1) goto LMD2
		clrl	20(ap)		# IN BnnAdd: car = 0
		brw	LADDEntry	# BnnAdd(pp,pl,mm,ml,0);

LMD2:		movl	4(ap),r3	# r3 = p
		movl	12(ap),r1	# r1 = m
		movl	16(ap),r7	# r7 = ml
		subl3	r7,8(ap),r8	# r8 = pl-ml
		ashl	$-1,r7,r0	# loop counter r0 = (ml+1)/2
		clrl	r5
		bitl	$1,r7
		bneq	LMDPOddLen	# if (ml is odd) goto LMDPOddLen
		clrl	r7
		brb	LMDPEvenLen	# if (ml is even) goto LMDPOddLen
LMDPLoop:	emul	(r1)+,r2,$0,r4	# r4:r5 = m[i]*d
		bgeq	LMDMPos1	# if (m[i] < 0) 
		addl2	r2,r5		#    r5 += d
LMDMPos1:	addl2	r7,r4		# r4 = (m[i]*d)%2^32+(m[i-1]*d)/2^32+C
		adwc	$0,r5		# r5 = (m[i]*d)/2^32 + carry1
		addl2	r4,(r3)+	# *p++ += r4
		adwc	$0,r5		# r5 = (m[i]*d)/2^32 + carry2
LMDPOddLen:	emul	(r1)+,r2,$0,r6	# r6:r7 = m[i+1]*d
		bgeq	LMDMPos2	# if (m[i+1] < 0)
		addl2	r2,r7		#    r7 += d
LMDMPos2:	addl2	r5,r6		# r6 = (m[i+1]*d)%2^32+(m[i]*d)/2^32+C
		adwc	$0,r7		# r7 = (m[i+1]*d)/2^32 + carry1
		addl2	r6,(r3)+	# *p++ += r6
		adwc	$0,r7		# r7 = (m[i+1]*d)/2^32 + carry2
LMDPEvenLen:	sobgeq	r0,LMDPLoop	# if ((i+=2)/2 < ml/2) repeat loop
		addl2	r7,(r3)+	# *p += (m[ml-1]*d)/2^32
		bcs	LMDTail
LMDRet0:	clrl	r0
		ret

LMDNeg:		movl	4(ap),r3	# r3 = p
		movl	12(ap),r1	# r1 = m
		movl	16(ap),r7	# r7 = ml
		subl3	r7,8(ap),r8	# r8 = pl-ml
		ashl	$-1,r7,r0	# loop counter r0 = (ml+1)/2
		clrl	r5
		bitl	$1,r7
		bneq	LMDNOddLen
		clrl	r7
		brb	LMDNEvenLen
LMDNLoop:	movl	(r1)+,r6	# r6 = m[i]
		emul	r6,r2,$0,r4	# r4:r5 = m[i]*d
		bleq	LMDMPos3	# if (m[i] < 0) 
		addl2	r2,r5		#    r5 += d
LMDMPos3:	addl2	r6,r5		# r5 += m[i]
		addl2	r7,r4		# r4 = (m[i]*d)%2^32+(m[i-1]*d)/2^32+C
		adwc	$0,r5		# r5 = (m[i]*d)/2^32 + carry1
		addl2	r4,(r3)+	# *p++ += r4
		adwc	$0,r5		# r5 = (m[i]*d)/2^32 + carry2
LMDNOddLen:	movl	(r1)+,r4	# r6 = m[i+1]
		emul	r4,r2,$0,r6	# r6:r7 = m[i+1]*d
		bleq	LMDMPos4	# if (m[i+1] < 0)
		addl2	r2,r7		#    r7 += d
LMDMPos4:	addl2	r4,r7		# r7 += m[i+1]
		addl2	r5,r6		# r6 = (m[i+1]*d)%2^32+(m[i]*d)/2^32+C
		adwc	$0,r7		# r7 = (m[i+1]*d)/2^32 + carry1
		addl2	r6,(r3)+	# *p++ += r6
		adwc	$0,r7		# r7 = (m[i+1]*d)/2^32 + carry2
LMDNEvenLen:	sobgeq	r0,LMDNLoop	# if ((i+=2)/2 < ml/2) repeat loop
		addl2	r7,(r3)+	# *p += (m[ml-1]*d)/2^32
		bcs	LMDTail
		clrl	r0		# r0 = carry
		ret

LMDTailLoop:	incl	(r3)+
		bcc	LMDRet0
LMDTail:	sobgtr	r8,LMDTailLoop
		movl	$1,r0		# r0 = carry
		ret

		.globl	_BnnDivideDigit
		.align	3
_BnnDivideDigit:
		.word	0x3FE&callee_save	# mask<r1,r2,r3,r4,r5,r6,r7,r8,r9>
		movl	12(ap),r2	# nl
		movl	16(ap),r3	# d
		moval	*8(ap)[r2],r0	# nn = &nn[nl];
		decl	r2		# nl--;
		moval	*4(ap)[r2],r1	# qq = &qq[nl];
		movl	-(r0),r5	#  X(hight) = *(--n);
		extzv	$1,$31,r3,r7	# r7 = D' <- D div 2
		tstl	r3
		bgeq	Lndivc2
		brw	Lndiv5		# D < 0!!

					# D < 2**31
		brb	Lndivc2		# N < D * 2**32
Lndivc1:	movl	-(r0),r4	# (bdivu dx3 ax1 dx1)
		cmpl	r5,r7
		blss	Lndivc11
		extzv	$0,$1,r4,r6	# r6 <- n0
		ashq	$-1,r4,r4	# N' = r4 = N quo 2 < D * 2**31
		ediv	r3,r4,r4,r5	# r4 <- Q' = N' quo D < 2**31
					# r5 <- R' = N' rem D < D
		ashq	$1,r4,r4	# r4 <- 2 * Q'        < 2**32
					# r5 <- 2 * R'        < 2 * D
		addl2	r6,r5		# r5 <- 2 * R' + n0   < 2 * D
		cmpl	r5,r3		# r5 < D -> Q = r4, R = r5
		blssu	Lndivc12		# sinon
		incl	r4		# Q = r4 + 1
		subl2	r3,r5		# R = r5 - D
		brb	Lndivc12
Lndivc11:	ediv	r3,r4,r4,r5	# Q = r4, R = r5
Lndivc12:	movl	r4,-(r1)	# range r4 en me'moire
Lndivc2:	sobgeq	r2,Lndivc1	# (sobgez dx2 Lndivc1)
		movl	r5,r0		# return(X(hight));
		ret

Lndiv3:		movl	-(r0),r4	# r4 poid faible de N
		extzv	$0,$1,r4,r9	# r9 <-  n0
		extzv	$1,$1,r4,r6	# r6 <-  n1
		extzv	$2,$1,r4,r8	# r8 <- n2
		ashq	$-3,r4,r4	# r4 <- N'' = N quo 4
		bicl2	$0xE0000000,r5	# Le ashq ne le fait pas
		ediv 	r7,r4,r4,r5	# r4 <- Q' = N''' quo D'
					# r5 <- R' = N''' rem D'
		ashl	$1,r5,r5	# r5 <- 2 * R'
		addl2	r8,r5		# r5 <- 2 * R' + n2
		bbc	$0,r3,Lndiv4	# si d0 = 0
		cmpl	r5,r4		# sinon r5 <- 2R' + n1 - Q'
		blssu	Lndiv30		# la diff est < 0
		subl2	r4,r5		# la diff est > 0
		brb	Lndiv4		# voila la diff!
Lndiv30:	subl2	r4,r5		# la diff!
		decl	r4		# r4 <- r4 - 1
		addl2	r3,r5		# r5 <- r5 + D
Lndiv4:		ashl	$1,r4,r4	# r4 <- 2Q'
		addl2	r5,r5		# r5 <- 2r5
		bisl2	r6,r5		# r5 <- r5 + n1 (flag C ok!)
		bcs	Lndiv40		# On deborde sur!
		cmpl	r5,r3
		blssu	Lndiv42		# depasse pas D
Lndiv40:	incl	r4		# Q = r4 + 1
		subl2	r3,r5		# R = r5 - D
Lndiv42:	ashl	$1,r4,r4	# r4 <- 2Q'
		addl2	r5,r5		# r5 <- 2r5
		bisl2	r9,r5		# r5 <- r5 + n0 (flag C ok!)
		bcs	Lndiv43		# On deborde sur!
		cmpl	r5,r3
		blssu	Lndiv44		# depasse pas D
Lndiv43:	incl	r4		# Q = r4 + 1
		subl2	r3,r5		# R = r5 - D
Lndiv44:	movl	r4,-(r1)	# range le quotient en memoire
Lndiv5:		sobgeq	r2,Lndiv3	# On continue!
		movl	r5,r0		# return(X(hight));
		ret

# BigNumCarry BnnMultiply (pp, pl, mm, ml, nn, nl)
# BigNum	pp, nn, mm;
# BigNumLength	pl, nl, ml;

.globl	_BnnMultiply
	.align	3
_BnnMultiply:
	.word	0xFFE&callee_save	# mask<r1,r2,r3,r4,r5,r6,r7,r8,r9,r10,r11>
	movl	24(ap),r9		# r9 = nl
	bneq	LMM_nl_pos
LMM_Ret0a:
	clrl	r0
LMM_Ret:
	ret
LMM_nl_pos:
	movl	20(ap),r11		# nn
	cmpl	12(ap),r11		# if (nn == mm)
	beql	BMM_Sqr
LMM_NotSqr:
	movl	4(ap),r10		# pp
	clrl	r8			# c_hi
LMM_NLoop:
	  movl	16(ap),r7		# ml
	  movl	12(ap),r1		# mm
	  moval	(r10)+,r3		# pp
	  clrl	r5			# c_lo
	  movl	(r11)+,r2		# digit
	  bsbw	BMM_MultiplyDigit
	  sobgtr	r9,LMM_NLoop
	movl	r8,r0
	beql	LMM_Ret
	movl	16(ap),r7		# r7 = ml
	subl3	r7,8(ap),r1		# r7 = pl-ml
	subl2	24(ap),r1		# r7 = pl-ml-nl
	bleq	LMM_Ret
	moval	(r10)[r7],r10		# pp += ml
LMM_PLoop:
	incl	(r10)+
	bcc	LMM_Ret0a
	sobgtr	r1,LMM_PLoop
	ret
# Special squaring code based on:
# n[0..nl-1]*n[0..nl-1] = sum (i = 0..nl-1):
#                                B^2i * (n[i]*n[i] + 2*n[i] * n[i+1..nl-1] * B)
# the 2*n[i] is tricky because it may overflow, but ...
# suppose  L[i] = 2*n[i]%2^32
#    and   H[i] = 2*n[i]/2^32
# Then:
#   sum (i = 0..nl-1):
#         B^2i * (n[i]*n[i] + L[i]+H[i-1] * n[i+1..nl-1] * B + H[i-1]*n[i])
# notice that when i = nl-1 the final term is 2*n[nl-1] * n[nl..nl-1],
# n[nl..nl-1] is zero length -- i.e. we can ignore it!
# lastly we don't have quite enough registers to conveniently remember
# the top bit of n[i-1] we encode it in the PC by duplicating
# the loop--sometimes I love assembler.
LMMS_NNLoop:
	    # execute this version of loop if n[i-1] was >= 2^31
	    movl	(r11)+,r0	# d = r0 = *nn++
	    movl	r11,r1		# r1 = mm
	    emul	r0,r0,$0,r4	# r4:r5 = d*d
	    addl2	r0,r4		# r4 += (2*n[i-1])/2^32*n[i] (= d)
	    adwc	$0,r5
	    addl2	r4,(r10)+	# *pp++ += d*d%2^32
	    adwc	$0,r5		# r5 += C
	    moval	(r10)+,r3	# arg-p = pp++
	    movl	r9,r7		# arg-ml = ml
	    addl3	r0,r0,r2	# if (d >= 0)
	    bisl2	$1,r2
	    bcc		LMMS_DPos	# switch to < 2^31 loop
LMMS_DNeg:
	    addl2	r0,r5		# compensate for signed mul
	    addl2	r0,r5		# r4:r5 += 2*r2*2^32
	    tstl	r2		# set condition codes for entry to subr
	    # MultiplyDigit(pp=r3, mm=r1, ml=r7, d=r2, c_hi=r8, c_lo=r5)
	    bsbb	BMM_MultiplyDigit
	    sobgeq	r9,LMMS_NNLoop
	brb	LMMS_Post
# >>> ENTRY <<<
BMM_Sqr:
	# r9 = nl, r11 = nn
	movl	16(ap),r8		# r8 = ml
	bneq	LMMS_ml_pos
	clrl	r0
	ret				# return 0;
LMMS_ml_pos:
	cmpl	r8,r9			# if (ml != nl)
	bneq	LMM_NotSqr

	# r8 = 0, r9 = nl, r11 = nn, r10 = sgn(nn[nl-1])
	movl	4(ap),r10		# r10 = pp
					# r11 = nn
	clrl	r8			# r8 = high carry = 0
	decl	r9			# r9 = ml-1 = nl-1
LMMS_NLoop:
	    # execute this version of loop if n[i-1] was < 2^31
	    movl	(r11)+,r0	# d = r0 = *nn++
	    movl	r11,r1		# r1 = mm
	    emul	r0,r0,$0,r4	# r4:r5 = d*d
	    addl2	r4,(r10)+	# *pp++ += d*d%2^32
	    adwc	$0,r5		# r5 += C
	    moval	(r10)+,r3	# arg-p = pp++
	    movl	r9,r7		# arg-ml = ml
	    addl3	r0,r0,r2	# if (d < 0)
	    bcs		LMMS_DNeg	# switch to >= 2^31 loop
LMMS_DPos:
	    tstl	r2		# set condition codes for entry to subr
	    # MultiplyDigit(pp=r3, mm=r1, ml=r7, d=r2, c_hi=r8, c_lo=r5)
	    bsbb	BMM_MultiplyDigit
	    sobgeq	r9,LMMS_NLoop
	# r9 = 0, r10 = pp+2*ml, r2 = 2*nn[nl-1], r8 = carry_hi, r11 = nn+nl
LMMS_Post:
	movl	r8,r0
	bneq	LMMS_CProp		# if (c != 0)
LMMS_ret:
	ret				# return
LMMS_CProp:
	movl	16(ap),r7		# r7 = nl
	subl3	r7,8(ap),r2		# r2 = pl-nl (note nl == ml)
	subl2	r7,r2			# r2 = pl-nl-ml
	bleq	LMMS_ret		# if (pl-nl > ml)
					# ret = BnnAddCarry(pp+ml, pl-ml, c);
LMMS_CPLoop:
	incl	(r10)+			# (*pp++)++
	bcc	LMMS_Ret0
	sobgtr	r2,LMMS_CPLoop
	ret
LMMS_Ret0:
	clrl	r0
	ret

# Subroutine: MultiplyDigit(pp,mm,ml,d,c_hi,c_lo)
# returns:
# c_hi*base^(ml+1)+ pp[0..ml] = pp[0..ml]+(mm[0..ml-1]*d)+c_hi*base^ml+c_lo
#
# In:
#  ml_entry:r7
#  ml/2: r0
#  mm: r1
#  digit: r2
#  pp: r3
#  c_hi: r8
#  c_lo: r5
#
# multiply scratch: r4,r5 / r6,r7
#
# Out:
#  c_hi: r8
LMMD_C_hi:
		addl2	r8,(r3)[r7]	# p[ml] += c_hi
		clrl	r8
		adwc	$0,r8
		rsb
LMMD_Zero:
		tstl	r5		# Too complicated, return to
		beql	LMMD_ZC_lo	# normal case.
		tstl	r2
		brb	LMMD_Retry
LMMD_ZC_lo:
		tstl	r8
		bneq	LMMD_C_hi
		rsb
BMM_MultiplyDigit:
		beql	LMMD_Zero
LMMD_Retry:
		blss	LMMD_Neg	# if (d<0) goto LMMD_Neg
		ashl	$-1,r7,r0	# loop counter r0 = ml/2
		bitl	$1,r7
		bneq	LMMD_POddLen	# if (ml is odd) goto LMMD_POddLen
		movl	r5,r7
		brb	LMMD_PEvenLen	# if (ml is even) goto LMMD_POddLen
LMMD_PLoop:	emul	(r1)+,r2,$0,r4	# r4:r5 = m[i]*d
		bgeq	LMMD_MPos1	# if (m[i] < 0) 
		addl2	r2,r5		#    r5 += d
LMMD_MPos1:	addl2	r7,r4		# r4 = (m[i]*d)%2^32+(m[i-1]*d)/2^32+C
		adwc	$0,r5		# r5 = (m[i]*d)/2^32 + carry1
		addl2	r4,(r3)+	# *p++ += r4
		adwc	$0,r5		# r5 = (m[i]*d)/2^32 + carry2
LMMD_POddLen:	emul	(r1)+,r2,$0,r6	# r6:r7 = m[i+1]*d
		bgeq	LMMD_MPos2	# if (m[i+1] < 0)
		addl2	r2,r7		#    r7 += d
LMMD_MPos2:	addl2	r5,r6		# r6 = (m[i+1]*d)%2^32+(m[i]*d)/2^32+C
		adwc	$0,r7		# r7 = (m[i+1]*d)/2^32 + carry1
		addl2	r6,(r3)+	# *p++ += r6
		adwc	$0,r7		# r7 = (m[i+1]*d)/2^32 + carry2
LMMD_PEvenLen:	sobgeq	r0,LMMD_PLoop	# if ((i+=2)/2 < ml/2) repeat loop
		addl2	r8,r7
		clrl	r8
		adwc	$0,r8
		addl2	r7,(r3)		# *p += (m[ml-1]*d)/2^32
		adwc	$0,r8
		rsb
LMMD_Neg:
		ashl	$-1,r7,r0	# loop counter r0 = ml/2
		bitl	$1,r7
		bneq	LMMD_NOddLen
		movl	r5,r7
		brb	LMMD_NEvenLen
LMMD_NLoop:	movl	(r1)+,r6	# r6 = m[i]
		emul	r6,r2,$0,r4	# r4:r5 = m[i]*d
		bleq	LMMD_MPos3	# if (m[i] < 0) 
		addl2	r2,r5		#    r5 += d
LMMD_MPos3:	addl2	r6,r5		# r5 += m[i]
		addl2	r7,r4		# r4 = (m[i]*d)%2^32+(m[i-1]*d)/2^32+C
		adwc	$0,r5		# r5 = (m[i]*d)/2^32 + carry1
		addl2	r4,(r3)+	# *p++ += r4
		adwc	$0,r5		# r5 = (m[i]*d)/2^32 + carry2
LMMD_NOddLen:	movl	(r1)+,r4	# r6 = m[i+1]
		emul	r4,r2,$0,r6	# r6:r7 = m[i+1]*d
		bleq	LMMD_MPos4	# if (m[i+1] < 0)
		addl2	r2,r7		#    r7 += d
LMMD_MPos4:	addl2	r4,r7		# r7 += m[i+1]
		addl2	r5,r6		# r6 = (m[i+1]*d)%2^32+(m[i]*d)/2^32+C
		adwc	$0,r7		# r7 = (m[i+1]*d)/2^32 + carry1
		addl2	r6,(r3)+	# *p++ += r6
		adwc	$0,r7		# r7 = (m[i+1]*d)/2^32 + carry2
LMMD_NEvenLen:	sobgeq	r0,LMMD_NLoop	# if ((i+=2)/2 < ml/2) repeat loop
		addl2	r8,r7
		clrl	r8
		adwc	$0,r8
		addl2	r7,(r3)		# *p += (m[ml-1]*d)/2^32
		adwc	$0,r8
		rsb