/*
 * String instruction emulation - MicroVAX only.  These routines are called
 * from locore.s when an "emulate" fault occurs on the MicroVAX.  They are
 * called with the stack set up as follows:
 *
 *	  (sp):	Return address of trap handler
 *	 4(sp):	Instruction Opcode	(also holds PSL result from emulator)
 *	 8(sp):	Instruction PC
 *	12(sp):	Operand 1
 *	16(sp):	Operand 2
 *	20(sp):	Operand 3
 *	24(sp):	Operand 4
 *	28(sp):	Operand 5
 *	32(sp):	Operand 6
 *	36(sp):	old Register 11
 *	40(sp):	old Register 10
 *	44(sp):	Return PC
 *	48(sp):	Return PSL
 *	52(sp): TOS before instruction
 *
 * R11 and r10 are available for use.  If any routine needs to use r9-r1
 * they need to save them first (unless those registers are SUPPOSED to be
 * messed with by the "instruction").  These routines leave their results
 * in registers 0-5 explicitly, as needed, and use the macros defined below
 * to link up with calling routine.
 */

#include <vax/psl.h>

#define return		rsb
#define oldpsl		48(sp)
#define pslloc		4(sp)
#define savepsl		movpsl	pslloc
#define setpsl(reg)	movl	reg,pslloc
#define overflowpsl	movl	$PSL_V,pslloc
#define arg1		12(sp)
#define arg2		16(sp)
#define arg3		20(sp)
#define arg4		24(sp)
#define arg5		28(sp)
#define arg6		32(sp)
#define argub(num,reg)	movzbl	8+4*num(sp),reg
#define arguw(num,reg)	movzwl	8+4*num(sp),reg
#define argul(num,reg)	movl	8+4*num(sp),reg
#define argb(num,reg)	cvtbl	8+4*num(sp),reg
#define argw(num,reg)	cvtwl	8+4*num(sp),reg
#define argl(num,reg)	movl	8+4*num(sp),reg
#define toarg(reg,num)	movl	reg,8+4*num(sp)

	.text

	.globl	__EMbegin
__EMbegin:

	.align	1
	.globl	_EMmovtc
_EMmovtc:
/* movtc srclen.rw,srcaddr.ab,fill.rb,tbladdr.ab,dstlen.rw,dstaddr.ab */
#define srclen r10
#define srcaddr r1
#define dstlen r11
#define dstaddr r5
#define fill r2
#define tbladdr r3
#define tmp1 r4
#define tmp2 r0
/* Pick up the arguments */
	arguw(1,srclen)
	argl(2,srcaddr)
	arguw(5,dstlen)
	argl(6,dstaddr)
	argub(3,fill)
	argl(4,tbladdr)
/* Do the condition codes now */
	cmpw		srclen,dstlen
	savepsl
/* If dstlen == 0 then we're done */
	tstl		dstlen
	jeql		Lmovtc_f_done
/* If srclen == 0 then just fill */
	tstl		srclen
	jeql		Lmovtc_f_fill
/* Which way must we do it?  Branch if backwards. */
	cmpl		srcaddr,dstaddr
	jlssu		Lmovtc_backwards
/* #chars-to-move = MINU(srclen,dstlen) */
	movl		srclen,tmp2
	cmpl		srclen,dstlen
	jlssu		1f
	movl		dstlen,tmp2
1:
/* #chars == 0  ->  nothing to move, just fill */
	tstl		tmp2
	jeql		Lmovtc_f_fill
/* Move the chars */
1:	movzbl		(srcaddr)+,tmp1
	movb		(tbladdr)[tmp1],(dstaddr)+
	sobgtr		tmp2,1b
/* Done moving, now pad to dstlen */
Lmovtc_f_fill:
	subl3		srclen,dstlen,tmp1
	jlequ		Lmovtc_f_done
2:	movb		fill,(dstaddr)+
	sobgtr		tmp1,2b
Lmovtc_f_done:
/* Be careful: things live in these registers! */
	/* r5 done (1 byte beyond dest string) */
	/* r3 done (translation table) */
	/* r1 done (1 byte beyond last src byte used) */
	subl3		dstlen,srclen,r0
	jgequ		1f
	clrl		r0
1:	clrl		r2
	clrl		r4
	return
Lmovtc_backwards:
/* Compute # chars to move, and pad if required */
	addl2		dstlen,dstaddr
	movl		dstlen,tmp2
	subl3		srclen,dstlen,tmp1
	jlequ		1f
	movl		srclen,tmp2
2:	movb		fill,-(dstaddr)
	sobgtr		tmp1,2b
1:
/* Now do the move.  No longer need fill so use it to save tmp2. */
	movl		tmp2,fill
	addl2		tmp2,srcaddr
1:	movzbl		-(srcaddr),tmp1
	movb		(tbladdr)[tmp1],-(dstaddr)
	sobgtr		tmp2,1b
/* Done, set up for Lmovtc_f_done */
	addl2		fill,srcaddr
	addl2		dstlen,dstaddr
	jbr		Lmovtc_f_done
#undef srclen
#undef srcaddr
#undef dstlen
#undef dstaddr
#undef fill
#undef tbladdr
#undef tmp1
#undef tmp2

	.align	1
	.globl	_EMmovtuc
_EMmovtuc:
/* movtuc srclen.rw,srcaddr.ab,esc.rb,tbladdr.ab,dstlen.rw,dstaddr.ab */
#define srclen r10
#define srcaddr r1
#define dstlen r11
#define dstaddr r5
#define esc r2
#define tbladdr r3
#define tmp1 r4
#define tmp2 r0
/* Pick up the arguments */
	arguw(1,srclen)
	argl(2,srcaddr)
	arguw(5,dstlen)
	argl(6,dstaddr)
	argub(3,esc)
	argl(4,tbladdr)
/* Do the condition codes now (except for PSL_V if escape) */
	cmpw		srclen,dstlen
	savepsl
/* # chars to move->tmp2.  Fortunately savepsl doesn't destroy cc bits. */
	jlequ		1f
	movl		dstlen,tmp2
	jbr		2f
1:	movl		srclen,tmp2
2:
/* tmp2 == 0  ->  nothing to do. */
	jeql		Lmovtuc_done
/* Crank through the bytes */
1:	movzbl		(srcaddr)+,tmp1
	movzbl		(tbladdr)[tmp1],tmp1
	cmpb		tmp1,esc
	jeql		Lmovtuc_esc
	movb		tmp1,(dstaddr)+
	sobgtr		tmp2,1b
Lmovtuc_done:
/* Finished.  Load registers (carefully).  Here, esc is a temporary. */
	/* r1 done (address of next src byte) */
	/* r3 done (table address) */
	/* r5 done (address of next dst byte) */
	subl3		dstlen,srclen,esc
	jlssu		1f
	movl		tmp2,r4
	addl3		esc,r4,r0
	jbr		2f
1:	/* movl		tmp2,r0 - tmp2 is already r0 */
	mnegl		esc,r4
2:	clrl		r2
	return
Lmovtuc_esc:
/* Escape.  Compensate for + on (srcaddr)+; set PSL_V; finish up. */
	decl		srcaddr
	bisl2		$PSL_V,pslloc
	jbr		Lmovtuc_done
#undef srclen
#undef srcaddr
#undef dstlen
#undef dstaddr
#undef esc
#undef tbladdr
#undef tmp1
#undef tmp2

	.align	1
	.globl	_EMmatchc
_EMmatchc:
/* matchc objlen.rw,objaddr.ab,srclen.rw,srcaddr.ab */
#define objlen r0
#define objaddr r1
#define srclen r2
#define srcaddr r3
#define temp r10
/* Pick up the arguments */
	arguw(1,objlen)
	argl(2,objaddr)
	arguw(3,srclen)
	argl(4,srcaddr)
/* Zero the condition codes (set PSL_Z later if appropriate) */
	savepsl
	bicl2		$PSL_ALLCC,pslloc
/* Find the match.  Algorithm follows the gray book (pg 4-154). */
/* Gray book names: */
#define tmp1 objlen
#define tmp2 objaddr
#define tmp3 srclen
#define tmp4 srcaddr
#define tmp5 temp
	movl		tmp1,tmp5
2:	tstl		tmp1
	jeql		Lmatchc_out
	cmpl		tmp3,tmp1
	jlssu		Lmatchc_out
	cmpb		(tmp2),(tmp4)+
	jneq		1f
	decl		tmp1
	incl		tmp2
	decl		tmp3
	jbr		2b
1:	subl3		tmp1,tmp5,tmp1
	subl2		tmp1,tmp2
	decl		tmp3
	addl2		tmp1,tmp3
	subl2		tmp1,tmp4
	movl		tmp5,tmp1
	jbr		2b
Lmatchc_out:
	cmpl		tmp3,tmp1
	jgequ		1f
	addl2		tmp3,tmp4
	clrl		tmp3
1:	/* All registers already have correct values, by choice of */
	/*  registers for the temporaries. */
#undef tmp1
#undef tmp2
#undef tmp3
#undef tmp4
#undef tmp5
	tstl		r0
	jneq		1f
	bisl2		$PSL_Z,pslloc
1:	return
#undef objlen
#undef objaddr
#undef srclen
#undef srcaddr
#undef temp

	.align	1
	.globl	_EMspanc
_EMspanc:
/* spanc len.rw,addr.ab,tbladdr.ab,mask.rb */
#define len r0
#define addr r1
#define tbladdr r3
#define mask r2
#define temp r11
/* Pick up the arguments */
	arguw(1,len)
	argl(2,addr)
	argl(3,tbladdr)
	argub(4,mask)
/* Zero the condition codes (set PSL_Z later if appropriate) */
	savepsl
	bicl2		$PSL_ALLCC,pslloc
/* Do the span */
	tstl		len
	jeql		Lspanc_done
1:	movzbl		(addr)+,temp
	bitb		mask,(tbladdr)[temp]
	jeql		Lspanc_found
	sobgtr		len,1b
Lspanc_done:
	/* Registers already loaded through choice of #defines */
	tstl		r0
	jneq		1f
	bisl2		$PSL_Z,pslloc
1:	return
Lspanc_found:
	decl		addr
	jbr		Lspanc_done
#undef len
#undef addr
#undef tbladdr
#undef mask
#undef temp

	.align	1
	.globl	_EMscanc
_EMscanc:
/* scanc len.rw,addr.ab,tbladdr.ab,mask.rb */
#define len r0
#define addr r1
#define tbladdr r3
#define mask r2
#define temp r11
/* Pick up the arguments */
	arguw(1,len)
	argl(2,addr)
	argl(3,tbladdr)
	argub(4,mask)
/* Zero the condition codes (set PSL_Z later if appropriate) */
	savepsl
	bicl2		$PSL_ALLCC,pslloc
/* Do the scan */
	tstl		len
	jeql		Lscanc_done
1:	movzbl		(addr)+,temp
	bitb		mask,(tbladdr)[temp]
	jneq		Lscanc_found
	sobgtr		len,1b
Lscanc_done:
	/* Registers already loaded through choice of #defines */
	tstl		r0
	jneq		1f
	bisl2		$PSL_Z,pslloc
1:	return
Lscanc_found:
	decl		addr
	jbr		Lscanc_done
#undef len
#undef addr
#undef tbladdr
#undef mask
#undef temp

	.align	1
	.globl	_EMskpc
_EMskpc:
/* skpc char.rb,len.rw,addr.ab */
#define len r0
#define addr r1
#define char r11
/* Pick up the arguments */
	argub(1,char)
	arguw(2,len)
	argl(3,addr)
/* Zero the condition codes (set PSL_Z later if appropriate) */
	savepsl
	bicl2		$PSL_ALLCC,pslloc
/* Do the skip */
	tstl		len
	jeql		Lskpc_done
1:	cmpb		(addr)+,char
	jneq		Lskpc_found
	sobgtr		len,1b
Lskpc_done:
	/* Registers already loaded through choice of #defines */
	tstl		r0
	jneq		1f
	bisl2		$PSL_Z,pslloc
1:	return
Lskpc_found:
	decl		addr
	jbr		Lskpc_done

	.align	1
	.globl	_EMlocc
_EMlocc:
/* locc char.rb,len.rw,addr.ab */
#define len r0
#define addr r1
#define char r11
/* Pick up the arguments */
	argub(1,char)
	arguw(2,len)
	argl(3,addr)
/* Zero the condition codes (set PSL_Z later if appropriate) */
	savepsl
	bicl2		$PSL_ALLCC,pslloc
/* Do the locate */
	tstl		len
	jeql		Llocc_done
1:	cmpb		(addr)+,char
	jeql		Llocc_found
	sobgtr		len,1b
Llocc_done:
	/* Registers already loaded through choice of #defines */
	tstl		r0
	jneq		1f
	bisl2		$PSL_Z,pslloc
1:	return
Llocc_found:
	decl		addr
	jbr		Llocc_done

	.align	1
	.globl	_EMcmpc3
_EMcmpc3:
/* cmpc3 len.rw,src1addr.ab,src2addr.ab */
#define len r0
#define src1addr r1
#define src2addr r3
/* Pick up the arguments */
	arguw(1,len)
	argl(2,src1addr)
	argl(3,src2addr)
/* Do the compare */
	tstl		len
	jeql		Lcmpc3_done
1:	cmpb		(src1addr)+,(src2addr)+
	jneq		Lcmpc3_found
	sobgtr		len,1b
Lcmpc3_equal:
	tstl		$0
Lcmpc3_done:
	savepsl
Lcmpc3_return:
	movl		r0,r2
	return
Lcmpc3_found:
	savepsl
	decl		src1addr
	decl		src2addr
	jbr		Lcmpc3_return

	.align	1
	.globl	_EMcmpc5
_EMcmpc5:
/* cmpc5 src1len.rw,src1addr.ab,fill.rb,src2len.rw,src2addr.ab */
#define src1len r0
#define src1addr r1
#define fill r11
#define src2len r2
#define src2addr r3
#define temp r10
/* Pick up the arguments */
	arguw(1,src1len)
	argl(2,src1addr)
	argub(3,fill)
	arguw(4,src2len)
	argl(5,src2addr)
/* Do the compare.  First, get MINU(src1len,src2len) */
	movl		src1len,temp
	cmpl		src1len,src2len
	jlequ		1f
	movl		src2len,temp
1:
/* Compare that many bytes */
	tstl		temp
	jeql		Lcmpc5_fillcmp
	subl2		temp,src1len
	subl2		temp,src2len
1:	cmpb		(src1addr)+,(src2addr)+
	jneq		Lcmpc5_bodyfound
	sobgtr		temp,1b
Lcmpc5_fillcmp:
	tstl		src1len
	jneq		Lcmpc5_fill1
	tstl		src2len
	jneq		Lcmpc5_fill2
Lcmpc5_equal:
	tstl		$0
Lcmpc5_done:
	savepsl
	return
Lcmpc5_bodyfound:
	savepsl
	decl		src1addr
	decl		src2addr
	addl2		temp,src1len
	addl2		temp,src2len
	return
Lcmpc5_fill1:
1:	cmpb		(src1addr)+,fill
	jneq		Lcmpc5_1found
	sobgtr		src1len,1b
	jbr		Lcmpc5_equal
Lcmpc5_fill2:
1:	cmpb		fill,(src2addr)+
	jneq		Lcmpc5_2found
	sobgtr		src2len,1b
	jbr		Lcmpc5_equal
Lcmpc5_1found:
	savepsl
	decl		src1addr
	return
Lcmpc5_2found:
	savepsl
	decl		src2addr
	return
#undef src1len
#undef src1addr
#undef fill
#undef src2len
#undef src2addr
#undef temp

/*
 * Packed Decimal string operations
 */

	.align	1
canon_sign:			/* make a sign canonical */
	.byte		0	/* 0 - digit */
	.byte		0	/* 1 - digit */
	.byte		0	/* 2 - digit */
	.byte		0	/* 3 - digit */
	.byte		0	/* 4 - digit */
	.byte		0	/* 5 - digit */
	.byte		0	/* 6 - digit */
	.byte		0	/* 7 - digit */
	.byte		0	/* 8 - digit */
	.byte		0	/* 9 - digit */
	.byte		12	/* 10 - +ve */
	.byte		13	/* 11 - -ve */
	.byte		12	/* 12 - +ve */
	.byte		13	/* 13 - -ve */
	.byte		12	/* 14 - +ve */
	.byte		12	/* 15 - +ve */

	.align	1
	.globl	_newEMaddp4
_newEMaddp4:
/* addp4 addlen.rw,addaddr.ab,sumlen.rw,sumaddr.ab */
#define addlen r0
#define addaddr r1
#define sumlen r2
#define sumaddr r3
#define temp1 r10
#define temp2 r11
#define flagsum r4
#define FLAG_C 0x100
#define FLAGV_C 8
#define FLAG_AOUT 0x200
#define FLAGV_AOUT 9
#define FLAG_SOUT 0x400
#define FLAGV_SOUT 10
#define lenleft r5
/* Pick up the arguments */
	arguw(1,addlen)
	argl(2,addaddr)
	arguw(3,sumlen)
	argl(4,sumaddr)
/* Save r4 and r5 in arg5 and arg6 spots */
	toarg(r4,5)
	toarg(r5,6)
/* Clear condition codes; will set bits as necessary later */
	savepsl
	bicl2		$PSL_ALLCC,pslloc
/* Save sumlen before we lose the low bit */
	movl		sumlen,lenleft
/* Fix lengths to be in bits */
	mull2		$4,addlen
	bicl2		$4,addlen
	mull2		$4,sumlen
	bicl2		$4,sumlen
/* Pick up signs */
	addl2		$4,addlen
	xorl3		$4,addlen,temp1
	extzv		temp1,$4,(addaddr),temp1
	movb		canon_sign[temp1],temp1
	addl2		$4,sumlen
	xorl3		$4,sumlen,temp2
	extzv		temp2,$4,(sumaddr),temp2
	movb		canon_sign[temp2],temp2
	cmpb		temp1,temp2
	jneq		Laddp4_diffsign
/* Signs match; add */
/* First put the canonical version of the sign in the sum */
	xorl3		$4,sumlen,temp1
	insv		temp2,temp1,$4,(sumaddr)
/* Clear all flag bits and sum; set zero (will be cleared if appropriate) */
	clrl		flagsum
	bisl2		$PSL_Z,pslloc
/* Loop until both strings run out */
Laddp4add_loop:
	subl2		$4,addlen
	xorl3		$4,addlen,temp1
	jlss		1f
	extzv		temp1,$4,(addaddr),temp2
	movb		temp2,flagsum
	jbr		2f
1:	clrb		flagsum
	bbss		$FLAGV_AOUT,flagsum,2f
2:	subl2		$4,sumlen
	xorl3		$4,sumlen,temp1
	jlss		1f
	extzv		temp1,$4,(sumaddr),temp2
	jbr		2f
1:	clrl		temp2
	bbss		$FLAGV_SOUT,flagsum,2f
2:	addb2		temp2,flagsum
	jbc		$FLAGV_C,flagsum,1f
	incb		flagsum
1:	cmpb		flagsum,$10
	jlss		1f
	subb2		$10,flagsum
	bbss		$FLAGV_C,flagsum,2f
	jbr		2f
1:	bbcc		$FLAGV_C,flagsum,2f
2:	sobgeq		lenleft,1f
	tstb		flagsum
	jneq		Laddp4_overflow
	jbc		$FLAGV_C,flagsum,2f
	jbr		Laddp4_overflow
1:	insv		flagsum,temp1,$4,(sumaddr)
	tstb		flagsum
	jeql		2f
	bicl2		$PSL_Z,pslloc
2:	bicl3		$~(FLAG_AOUT|FLAG_SOUT),flagsum,temp1
	cmpl		temp1,$FLAG_AOUT|FLAG_SOUT
	jeql		Laddp4_done
	bicl2		$FLAG_AOUT|FLAG_SOUT,flagsum
	jbr		Laddp4add_loop
Laddp4_diffsign:
/* Signs differ; subtract */
/* First put the canonical version of the sign in the sum (assume correct) */
	xorl3		$4,sumlen,temp1
	insv		temp2,temp1,$4,(sumaddr)
/* Clear all flag bits and sum; set zero (will be cleared if appropriate) */
	clrl		flagsum
	bisl2		$PSL_Z,pslloc
/* Loop until both strings run out */
Laddp4sub_loop:
	subl2		$4,sumlen
	xorl3		$4,sumlen,temp1
	jlss		1f
	extzv		temp1,$4,(sumaddr),temp2
	movb		temp2,flagsum
	jbr		2f
1:	clrb		flagsum
	bbss		$FLAGV_AOUT,flagsum,2f
2:	subl2		$4,addlen
	xorl3		$4,addlen,temp1
	jlss		1f
	extzv		temp1,$4,(addaddr),temp2
	jbr		2f
1:	clrl		temp2
	bbss		$FLAGV_SOUT,flagsum,2f
2:	subb2		temp2,flagsum
	bbc		$FLAGV_C,flagsum,1f
	decb		flagsum
1:	tstb		flagsum
	jgeq		1f
	addb2		$10,flagsum
	bbss		$FLAGV_C,flagsum,2f
	jbr		2f
1:	bbcc		$FLAGV_C,flagsum,2f
2:	sobgeq		lenleft,1f
	jbr		Laddp4sub_done
1:	insv		flagsum,temp1,$4,(sumaddr)
	tstb		flagsum
	jeql		2f
	bicl2		$PSL_Z,pslloc
2:	bicl3		$~(FLAG_AOUT|FLAG_SOUT),flagsum,temp1
	cmpl		temp1,$FLAG_AOUT|FLAG_SOUT
	jeql		Laddp4_done
	bicl2		$FLAG_AOUT|FLAG_SOUT,flagsum
	jbr		Laddp4sub_loop
Laddp4sub_done:
	bbs		$FLAGV_C,flagsum,1f
	tstb		flagsum
	jneq		Laddp4_overflow
	jbr		Laddp4_done
1:	cmpb		flagsum,$9
	jneq		Laddp4_overflow
/* Okay, we have to negate the result */
/* First, change the sign */
	arguw(3,sumlen)
	movl		sumlen,lenleft
	mull2		$4,sumlen
	bicl2		$4,sumlen
	addl2		$4,sumlen
	xorl3		$4,sumlen,temp1
	extzv		temp1,$4,(sumaddr),temp2
	xorl2		$1,temp2
	insv		temp2,temp1,$4,(sumaddr)
/* Now find the first non-zero digit */
	movl		$10,flagsum
2:	sobgeq		lenleft,1f
	jbr		Laddp4_done
1:	subl2		$4,sumlen
	xorl3		$4,sumlen,temp1
	extzv		temp1,$4,(sumaddr),temp2
	jeql		2b
/* Patch up this digit so we really subtract it from 10 */
	decb		temp2
/* Now run through subtracting each digit from 9 */
2:	subb3		temp2,$9,temp2
	insv		temp2,temp1,$4,(sumaddr)
	sobgeq		lenleft,1f
	jbr		Laddp4_done
1:	subl2		$4,sumlen
	xorl3		$4,sumlen,temp1
	extzv		temp1,$4,(sumaddr),temp2
	jbr		2b
Laddp4_overflow:
	bisl2		$PSL_V,pslloc
Laddp4_done:
/* Fix up minus zero */
	arguw(3,sumlen)
	mull2		$4,sumlen
	bicl2		$4,sumlen
	addl2		$4,sumlen
	xorl3		$4,sumlen,temp1
	bitl		$PSL_Z,pslloc
	jeql		1f
	insv		$12,temp1,$4,(sumaddr)
1:
/* Set N condition code */
	extzv		sumlen,$4,(sumaddr),temp1
	blbc		temp1,1f
	bisl2		$PSL_N,pslloc
1:
/* Pick up saved r4 and r5 */
	argl(6,r5)
	argl(5,r4)
/* Load registers */
	clrl		r0
	argl(2,r1)
	clrl		r2
	argl(4,r3)
	return
#undef addlen
#undef addaddr
#undef sumlen
#undef sumaddr
#undef temp1
#undef temp2
#undef flagsum
#undef FLAG_C
#undef FLAGV_C
#undef FLAG_AOUT
#undef FLAGV_AOUT
#undef FLAG_SOUT
#undef FLAGV_SOUT
#undef lenleft

	.align	1
	.globl	_newEMmovp
_newEMmovp:
/* movp len.rw,srcaddr.ab,dstaddr.ab */
#define len r0
#define srcaddr r1
#define dstaddr r3
#define psl r2
#define ftmp r10
#define ttmp r11
/* Copy return psl for C condition code and clear V */
	movl		oldpsl,psl
	bicl2		$PSL_V,psl
/* Pick up the arguments */
	arguw(1,len)
	argl(2,srcaddr)
	argl(3,dstaddr)
/* Fix length to be in bytes */
	divl2		$2,len
	incl		len
/* Copy the bytes, updating Z condition code as necessary */
	movab		(srcaddr)[len],ftmp
	movab		(dstaddr)[len],ttmp
	bisl2		$PSL_Z,psl
/* First byte is special; it contains the sign as well */
	movb		-(ftmp),-(ttmp)
	bitb		$0xf0,(ttmp)
	jeql		1f
	bicl2		$PSL_Z,psl
1:
/* Loop moving bytes and checking for nonzero */
	sobgtr		len,2f
	jbr		Lmovp_done
2:	movb		-(ftmp),-(ttmp)
	jeql		1b
	bicl2		$PSL_Z,psl
	jbr		1b
Lmovp_done:
/* Fix up minus zero */
	bitl		$PSL_Z,psl
	jeql		1f
	insv		$12,$0,$4,-1(dstaddr)[len]
1:
/* Set N condition code correctly */
	extzv		$0,$4,-1(dstaddr)[len],ttmp
	movzbl		canon_sign[ttmp],ttmp
	insv		ttmp,$0,$4,-1(dstaddr)[len]
	blbc		ttmp,1f
	bisl2		$PSL_N,psl
	jbr		2f
1:	bicl2		$PSL_N,psl
2:	setpsl(psl)
	/* r1 already set to srcaddr */
	/* r3 already set to dstaddr */
	clrl		r0
	clrl		r2
	return
#undef len
#undef srcaddr
#undef dstaddr
#undef psl
#undef ftmp
#undef ttmp

	.align	1
	.globl	_newEMashp
_newEMashp:
/* ashp cnt.rb,srclen.rw,srcaddr.ab,round.rb,dstlen.rw,dstaddr.ab */
#define srclen r0
#define srcaddr r1
#define dstlen r2
#define dstaddr r3
#define lenleft r4
#define temp1 r10
#define temp2 r11
/* Pick up (some of) the arguments */
	arguw(2,srclen)
	argl(3,srcaddr)
	arguw(5,dstlen)
	argl(6,dstaddr)
/* Save r4 in arg3 spot */
	toarg(r4,3)
/* Save lenleft before we lose the low bit */
	movl		dstlen,lenleft
/* Save psl with clear condition codes */
	savepsl
	bicl2		$PSL_ALLCC,pslloc
/* Fix lengths to be in bits */
	mull2		$4,srclen
	bicl2		$4,srclen
	mull2		$4,dstlen
	bicl2		$4,dstlen
/* Copy sign */
	addl2		$4,srclen
	xorl3		$4,srclen,temp1
	extzv		temp1,$4,(srcaddr),temp1
	movzbl		canon_sign[temp1],temp1
	addl2		$4,dstlen
	xorl3		$4,dstlen,temp2
	insv		temp1,temp2,$4,(dstaddr)
/* Get shift count */
	argb(1,temp1)
	jlss		Lashp_negshift
/* Non-negative shift count; put in zeros */
2:	sobgeq		temp1,1f
	jbr		2f
1:	sobgeq		lenleft,1f
	jbr		2f
1:	subl2		$4,dstlen
	xorl3		$4,dstlen,temp2
	insv		$0,temp2,$4,(dstaddr)
	jbr		2b
2:
/* Padded with zeros as appropriate, now copy source */
	bisl2		$PSL_Z,pslloc
3:	subl2		$4,srclen
	xorl3		$4,srclen,temp2
	jgeq		1f
	clrl		temp1
	jbr		2f
1:	extzv		temp2,$4,(srcaddr),temp1
2:	subl2		$4,dstlen
	xorl3		$4,dstlen,temp2
	jgeq		1f
2:	tstl		temp1
	jneq		Lashp_overflow
	tstl		srclen
	jlss		Lashp_done
	jbr		2f
1:	sobgeq		lenleft,1f
	jbr		2b
1:	insv		temp1,temp2,$4,(dstaddr)
	tstl		temp1
	jeql		1f
	bicl2		$PSL_Z,pslloc
1:	jbr		3b
Lashp_overflow:
	bisl2		$PSL_V,pslloc
Lashp_done:
/* Fix minus zero */
	bitl		$PSL_Z,pslloc
	jeql		1f
	arguw(5,dstlen)
	mull2		$4,dstlen
	bicl2		$4,dstlen
	addl2		$4,dstlen
	xorl3		$4,dstlen,temp1
	insv		$12,temp1,$4,(dstaddr)
1:
/* Pick up saved r4 */
	argl(3,r4)
	/* r1 already holds srcaddr */
	/* r3 already holds dstaddr */
	clrl		r0
	clrl		r2
	return
Lashp_negshift:
/* Compute shift in bits, to add to srclen */
	mull2		$4,temp1
/* Shift, by discarding low digits (temp1 is -ve) */
	addl2		temp1,srclen
/* Handle round operand, by loading initial carry */
	xorl3		$4,srclen,temp1
	extzv		temp1,$4,(srcaddr),temp1
	argub(4,temp2)
	addb2		temp2,temp1
	cmpb		temp1,$10
	jlss		1f
	movl		$1,temp1
	jbr		2f
1:	clrl		temp1
2:
/* Now step through copying and carrying */
3:	subl2		$4,srclen
	xorl3		$4,srclen,temp2
	jlss		1f
	extzv		temp2,$4,(srcaddr),temp2
	jbr		2f
1:	clrl		temp2
2:	addl2		temp2,temp1
	cmpl		temp1,$10
	jlss		1f
	addl2		$6,temp1
1:	subl2		$4,dstlen
	xorl3		$4,dstlen,temp2
	jgeq		1f
2:	tstl		temp1
	jneq		Lashp_overflow
	tstl		srclen
	jlss		Lashp_done
	jbr		3b
1:	sobgeq		lenleft,1f
	jbr		2b
1:	insv		temp1,temp2,$4,(dstaddr)
	extzv		$4,$4,temp1,temp1
	jbr		3b
#undef srclen
#undef srcaddr
#undef dstlen
#undef dstaddr
#undef lenleft
#undef temp1
#undef temp2

	.align	1
	.globl	_newEMcvtlp
_newEMcvtlp:
/* cvtlp src.rl,dstlen.rw,dstaddr.ab */
#define src r0
#define dstlen r2
#define dstaddr r3
#define lenleft r1
#define temp1 r10
#define temp2 r11
/* Pick up the arguments */
	argl(1,src)
	arguw(2,dstlen)
	argl(3,dstaddr)
/* Save lenleft before we lose the low bit */
	movl		dstlen,lenleft
/* Save psl with clear condition codes */
	savepsl
	bicl2		$PSL_ALLCC,pslloc
/* Fix length to be in bits */
	mull2		$4,dstlen
	bicl2		$4,dstlen
/* Load correct sign */
	addl2		$4,dstlen
	xorl3		$4,dstlen,temp2
	tstl		src
	jgeq		1f
	movl		$13,temp1
	bisl2		$PSL_N,pslloc
	jbr		2f
1:	movl		$12,temp1
2:	insv		temp1,temp2,$4,(dstaddr)
/* Set up first digit */
	tstl		src
	jgeq		1f
	divl3		$10,src,temp2
	mull2		$10,temp2
	subl3		src,temp2,temp1
	divl2		$10,src
	mnegl		src,src
	jbr		2f
1:	divl3		$10,src,temp2
	mull2		$10,temp2
	subl3		temp2,src,temp1
	divl2		$10,src
2:
/* Loop storing digits */
	bisl2		$PSL_Z,pslloc
3:	subl2		$4,dstlen
	xorl3		$4,dstlen,temp2
	jgeq		1f
2:	bisl2		src,temp1
	jneq		Lcvtlp_overflow
	jbr		Lcvtlp_done
1:	sobgeq		lenleft,1f
	insv		$0,temp2,$4,(dstaddr)
	jbr		2b
1:	insv		temp1,temp2,$4,(dstaddr)
	tstl		temp1
	jeql		1f
	bicl2		$PSL_Z,pslloc
1:	divl3		$10,src,temp2
	mull2		$10,temp2
	subl3		temp2,src,temp1
	divl2		$10,src
	jbr		3b
Lcvtlp_overflow:
	bisl2		$PSL_V,pslloc
Lcvtlp_done:
/* Fix up in case N and Z both set (must be V as well) */
	bitl		$PSL_Z,pslloc
	jeql		1f
	bicl2		$PSL_N,pslloc
1:	/* r3 already contains dstaddr */
	clrq		r0
	clrl		r2
	return
#undef src
#undef dstlen
#undef dstaddr
#undef lenleft
#undef temp1
#undef temp2

	.align	1
	.globl	_newEMcvtpl
_newEMcvtpl:
/* cvtpl srclen.rw,srcaddr.ab,dst.wl */
#define srclen r0
#define srcaddr r1
#define dst r3
#define curbit r2
#define temp1 r10
#define temp2 r11
/* Pick up the (input) arguments */
	arguw(1,srclen)
	argl(2,srcaddr)
/* Save psl with clear condition codes */
	savepsl
	bicl2		$PSL_ALLCC,pslloc
/* Convert length to bits, but subtract 8 (4 'cause acbl takes the branch
   on equal, 4 for the sign).  Actually don't subtract, just don't add. */
	mull2		$4,srclen
	bicl2		$4,srclen
/* Convert the number */
	clrl		curbit
	clrl		dst
2:	xorl3		$4,curbit,temp1
	acbl		srclen,$4,curbit,1f
	jbr		2f
1:	extzv		temp1,$4,(srcaddr),temp2
	mull3		$10,dst,temp1
	addl2		temp2,temp1
	divl3		$10,temp1,temp2
	cmpl		temp2,dst
	jeql		1f
	bisl2		$PSL_V,pslloc
1:	movl		temp1,dst
	jbr		2b
2:	tstl		dst
	movpsl		temp2
	bicl2		$~(PSL_Z|PSL_N),temp2
	bisl2		temp2,pslloc
	extzv		temp1,$4,(srcaddr),temp1
	movzbl		canon_sign[temp1],temp1
	blbc		temp1,1f
	mnegl		dst,dst
1:
/* Done; put result in arg 3 and load registers */
	toarg(dst,3)
	clrl		r0
	/* r1 already holds srcaddr */
	clrq		r2
	return

#define NEGATIVE $13
#define POSITIVE $12
#define NEGATIVEalt $11

/* OLD ROUTINES */
	.align	1
	.globl	_EMaddp4
_EMaddp4:
	toarg(r9,6)		# save register r9 in arg6 spot
	arguw(1,r11)		# (1) source length == r11
	argl(2,r10)		# (2) source address == r10
	arguw(3,r9)		# (3) destination length == r9
	argl(4,r3)		# (4) destination address == r3
			# arg4 will be needed later
			# arg5 holds destination address of LSNibble temporarily
	ashl	$-1,r11,r11
	addl2	r11,r10		# source address of LSNibble
	incl	r11		# source length is in bytes
	ashl	$-1,r9,r9
	addl2	r9,r3		# r3 = destination address of LSNibble
	incl	r9		# destination length is in bytes
	toarg(r3,5)		#    stored in arg5 spot
	extzv	$0,$4,(r3),r2	# set standard +/- indicators in destination
	cmpl	r2,NEGATIVE
	jeql	L112
	cmpl	r2,NEGATIVEalt
	jeql	L111
	insv	POSITIVE,$0,$4,(r3)
	jbr	L112
L111:
	insv	NEGATIVE,$0,$4,(r3)
L112:
	extzv	$0,$4,(r10),r2	# r2 = standard +/- of source
	cmpl	r2,NEGATIVE
	jeql	L114
	cmpl	r2,NEGATIVEalt
	jeql	L113
	movl	POSITIVE,r2
	jbr	L114
L113:
	movl	NEGATIVE,r2
L114:
	cmpl	r11,r9		# if source is longer than destination
	jleq	L115
	movl	r9,r11		#	set source length == destination length
L115:
	extzv	$4,$4,(r3),r9	# r9 = LSDigit of destination
	extzv	$4,$4,(r10),r1	# r1 = LSDigit of source
	extzv	$0,$4,(r3),r0
	cmpl	r0,r2		# if signs of operands are not equal
	jeql	Laddp4_same	#	do a subtraction
	clrl	r2		# r2 is non-zero if result is non-zero
	subl2	r1,r9		# r9 = "addition" of operands' high nibble
	jbr	L119		# jump into addition loop
Laddp4_diff_loop:
	decl	r3
	extzv	$0,$4,(r3),r0
	addl2	r0,r1		# r1 = carry + next (low) nibble of source
	decl	r10
	extzv	$0,$4,(r10),r0
	subl2	r0,r1		# r1 -= next (low) nibble of destination
	jgeq	L121		# if negative result
	mnegl	$1,r9		#	r9 == carry = -1
	addl2	$10,r1		#	r1 == result += 10
	jbr	L122		# else
L121:
	clrl	r9		#	r9 == carry = 0
L122:
	insv	r1,$0,$4,(r3)	# store result low nibble
	bisl2	r1,r2
	extzv	$4,$4,(r3),r0
	addl2	r0,r9		# r9 = carry + next (high) nibble of source
	extzv	$4,$4,(r10),r0
	subl2	r0,r9		# r9 -= next (high) nibble of destination
L119:
	jgeq	L117		# if negative result
	mnegl	$1,r1		#	r1 == carry = -1
	addl2	$10,r9		#	r9 == result += 10
	jbr	L118		# else
L117:
	clrl	r1		#	r1 == carry = 0
L118:
	insv	r9,$4,$4,(r3)	# store result high nibble
	bisl2	r9,r2		# r2 is non-zero if result is non-zero
	decl	r11		# while (--source length)
	jneq	Laddp4_diff_loop
	argl(4,r10)		# r10 = address of destination MSNibble
	jbr	Laddp4_diff_carry
Laddp4_diff_carlop:
	decl	r3
	extzv	$0,$4,(r3),r0
	addl2	r0,r1		# r1 == carry += next (low) nibble
	jgeq	L127		# if less than zero
	movl	r1,r9		#	r9 == carry (must be -1)
	movl	$9,r1		#	r1 == result = 9
	jbr	L128
L127:				# else
	clrl	r9		#	r9 == carry = 0
L128:
	insv	r1,$0,$4,(r3)	# store result
	bisl2	r1,r2
	extzv	$4,$4,(r3),r0
	addl2	r0,r9		# r9 == carry += next (high) nibble
	jgeq	L129		# if less than zero
	movl	r9,r1		# r1 == carry (must be -1)
	movl	$9,r9		# r9 == result = 9
	jbr	L130
L129:
	clrl	r1
L130:
	insv	r9,$4,$4,(r3)	# store result
	bisl2	r9,r2
Laddp4_diff_carry:
	cmpl	r3,r10
	jneq	Laddp4_diff_carlop
	tstl	r1		#	if carry out of MSN then fix up result
	jeql	Laddp4_add_done
	argl(5,r3)		# r3 == address of LSN of destination
	extzv	$0,$4,(r3),r0
	cmpl	r0,NEGATIVE	# switch sign of result
	jneq	L132
	insv	POSITIVE,$0,$4,(r3)
	jbr	L133
L132:
	insv	NEGATIVE,$0,$4,(r3)
L133:
	extzv	$4,$4,(r3),r0	# normalize result (carry out of MSN into LSN)
	subl3	r0,$10,r9	# r9 = 10 - destination LSNibble
	jbr	L134
L137:
	movl	$9,r1
Laddp4_diff_norm:
	insv	r9,$4,$4,(r3)
	cmpl	r3,r10		# while (not at MSNibble)
	jeql	Laddp4_add_done
	decl	r3
	extzv	$0,$4,(r3),r0	# low nibble = (9 + carry) - low nibble
	subl2	r0,r1
	cmpl	r1,$9
	jleq	L135
	clrl	r1
	movl	$10,r9
	jbr	L136
L135:
	movl	$9,r9
L136:
	insv	r1,$0,$4,(r3)
	extzv	$4,$4,(r3),r0	# high nibble = (9 + carry) - high nibble
	subl2	r0,r9
L134:
	cmpl	r9,$9
	jleq	L137
	clrl	r9
	movl	$10,r1
	jbr	Laddp4_diff_norm

Laddp4_same:			# operands are of the same sign
	clrl	r2
	addl2	r1,r9
	jbr	L139
Laddp4_same_loop:
	decl	r3
	extzv	$0,$4,(r3),r0
	addl2	r0,r1		# r1 == carry += next (low) nibble of dest
	decl	r10
	extzv	$0,$4,(r10),r0
	addl2	r0,r1		# r1 += next (low) nibble of source
	cmpl	r1,$9		# if result > 9
	jleq	L141
	movl	$1,r9		#	r9 == carry = 1
	subl2	$10,r1		#	r1 == result -= 10
	jbr	L142
L141:				# else
	clrl	r9		#	r9 == carry = 0
L142:
	insv	r1,$0,$4,(r3)	# store result
	bisl2	r1,r2
	extzv	$4,$4,(r10),r0
	addl2	r0,r9		# ditto for high nibble
	extzv	$4,$4,(r3),r0
	addl2	r0,r9
L139:
	cmpl	r9,$9
	jleq	L143
	movl	$1,r1
	subl2	$10,r9
	jbr	L144
L143:
	clrl	r1
L144:
	insv	r9,$4,$4,(r3)
	bisl2	r9,r2
	decl	r11		# while (--source length)
	jneq	Laddp4_same_loop
	argl(4,r10)		# r10 = destination address of MSNibble
	jbr	Laddp4_same_carry
Laddp4_same_cloop:
	decl	r3
	extzv	$0,$4,(r3),r0	# propagate carry up to MSNibble of destination
	addl2	r0,r1
	cmpl	r1,$10
	jneq	L147
	movl	$1,r9
	clrl	r1
	jbr	L148
L147:
	clrl	r9
L148:
	insv	r1,$0,$4,(r3)
	bisl2	r1,r2
	extzv	$4,$4,(r3),r0
	addl2	r0,r9
	cmpl	r9,$10
	jneq	L149
	movl	$1,r1
	clrl	r9
	jbr	L150
L149:
	clrl	r1
L150:
	insv	r9,$4,$4,(r3)
	bisl2	r9,r2
Laddp4_same_carry:
	cmpl	r3,r10
	jneq	Laddp4_same_cloop

Laddp4_add_done:
	argl(5,r3)		# r3 = destination address of LSNibble
	tstl	r2		# if zero result
	jneq	L151
	savepsl			#	remember that for condition codes
	insv	POSITIVE,$0,$4,(r3) #	make sure sign of result is positive
	jbr	Laddp4_out
L151:				# else
	extzv	$0,$4,(r3),r0
	cmpl	r0,NEGATIVE	#	if result is negative
	jneq	Laddp4_out
	mnegl	r2,r2		#		remember THAT in Cond Codes
	savepsl
Laddp4_out:
	argl(4,r3)
	argl(2,r1)
	clrl	r0
	clrl	r2
	argl(6,r9)		# restore r9 from stack
	return

	.align	1
	.globl	_EMmovp
_EMmovp:
	arguw(1,r11)		# (1) string length == r11
	argl(2,r10)		# (1) source address == r10
	argl(3,r3)		# (1) destination address == r3
			# we will need arg2 and arg3 later
	clrl	r2		# r2 == non-zero if source is non-zero
	ashl	$-1,r11,r11	# length is number of bytes, not nibbles
	jeql	Lmovp_zlen
Lmovp_copy:
	bisb2	(r10),r2	# keep track of non-zero source
	movb	(r10)+,(r3)+	# move two nibbles
	decl	r11		# loop for length of source
	jneq	Lmovp_copy
Lmovp_zlen:
	extzv	$4,$4,(r10),r0	# look at least significant nibble
	bisl2	r0,r2
	extzv	$0,$4,(r10),r0	# check sign nibble
	cmpl	r0,NEGATIVEalt
	jeql	Lmovp_neg
	cmpl	r0,NEGATIVE
	jneq	Lmovp_pos
Lmovp_neg:			# source was negative
	mnegl	r2,r2
Lmovp_pos:
	tstl	r2		# set condition codes
	savepsl
	jeql	Lmovp_zero
	movb	(r10),(r3)	# move last byte if non-zero result
	jbr	Lmovp_out
Lmovp_zero:
	movb	POSITIVE,(r3)	#	otherwise, make result zero and positive
Lmovp_out:
	clrl	r0
	argl(2,r1)
	clrl	r2
	argl(3,r3)
	return

	.align	1
	.globl	_EMashp
_EMashp:
	argb(1,r11)		# (1) scale (number to shift) == r11
	arguw(2,r10)		# (2) source length == r10
	argl(3,r1)		# (3) source address == r1
	argub(4,r2)		# (4) rounding factor == r2
	arguw(5,r3)		# (5) destination length == r3
	toarg(r6,3)	# arg3 holds register 6 from caller
	argl(6,r6)		# (6) destination address == r6
			# we need arg6 for later
			# arg1 is used for temporary storage
			# arg4 is used as general storage
			# arg5 is used as general storage
	ashl	$-1,r3,r0	# destination length is number of bytes
	addl2	r0,r6		# destination address == least sig nibble
	toarg(r6,1)		# save in arg1 spot for later
	ashl	$-1,r10,r0
	addl2	r0,r1		# source address == least sig nibble
	extzv	$0,$4,(r1),r0	# determine sign of source
	cmpl	r0,NEGATIVEalt
	jeql	Lashp_neg
	cmpl	r0,NEGATIVE
	jeql	Lashp_neg
	movb	POSITIVE,(r6)
	jbr	L245
Lashp_neg:
	movb	NEGATIVE,(r6)
L245:				# r3<0> counts digits going into destination
	bisl2	$1,r3		#	and is flip-flop for which nibble to
	tstl	r11		#	write in destination (1 = high, 0 = low)
	jgeq	Lashp_left	#	(it must start out odd)
	addl2	r11,r10		# scale is negative (right shift)
	jgeq	Lashp_right
	clrl	r10		# test for shifting whole number out
	jbr	Lashp_setround
Lashp_right:
	divl3	$2,r11,r0
	addl2	r0,r1		# source address == MSNibble to be shifted off
	jlbc	r11,L249
	extzv	$4,$4,(r1),r0
	addl2	r0,r2		# round = last nibble to be shifted off + round
	jbr	Lashp_setround
L249:
	extzv	$0,$4,(r1),r0
	addl2	r0,r2		# round = last nibble to be shifted off + round
Lashp_setround:			# r11<0> now is flip-flop for which nibble to
	incl	r11		#    read from source (1 == high, 0 == low)
	cmpl	r2,$9		# set rounding factor to one if nibble shifted
	jleq	Lashp_noround	#    off + round argument was 10 or greater
	movl	$1,r2
	jbr	Lashp_shift
Lashp_zloop:
	jlbs	r3,L257		# don't need to clear high nibble twice
	clrb	-(r6)		# clear low (and high) nib of next byte in dest
L257:
	decl	r3		# move to next nibble in destination, but
	jneq	L258		#	don't go beyond the end.
	incl	r3
L258:
	decl	r11
Lashp_left:			# while scale is positive
	jneq	Lashp_zloop
	incl	r11		# r11<0> is flip-plop ... (incl sets it to one)
Lashp_noround:
	clrl	r2		# no more rounding
Lashp_shift:
	clrl	arg4		# arg4 will be used for result condition codes
	tstl	r10
	jeql	Lashp_sethigh
Lashp_shloop:
	jlbc	r11,L260
	extzv	$4,$4,(r1),r0
	jbr	L261
L260:
	decl	r1
	extzv	$0,$4,(r1),r0
L261:
	incl	r11		# flip the source nibble flip/flop
	addl2	r0,r2		# round += next nibble
	cmpl	r2,$10		# if round == 10
	jneq	L262
	clrl	arg5		#	then result = 0 and round = 1
	movl	$1,r2
	jbr	L263
L262:				# else
	movl	r2,arg5		#	store result and round = 0
	clrl	r2
L263:
	bisl2	arg5,arg4	# remember if result was nonzero in arg4
	decl	r3		# move to next nibble early to check
	jgeq	Lashp_noovfl	# if we've moved passed destination limits
	clrl	r3		#	test the result for possible overflow
	tstl	arg5		#	ignore zero nibbles
	jeql	L265		#	if the nibble was non-zero, overflow
	jbr	Lashp_overfl
Lashp_noovfl:			# else
	jlbs	r3,L264
	insv	arg5,$4,$4,(r6)	# put the result into destination (high or low)
	jbr	L265
L264:
	decl	r6
	insv	arg5,$0,$4,(r6)
L265:
	decl	r10		# loop for length of source
	jneq	Lashp_shloop

Lashp_sethigh:
	jlbc	r3,L266		# if we haven't set the high nibble,
	insv	r2,$4,$4,(r6)	# carry the round into the high nibble
	clrl	r2
L266:
	argl(1,r10)		# r10 = address of destination LSNibble
	argl(6,r3)		# r3 = address of destination MSNibble
	movl	arg4,r11	# r11 = non-zero if destination == non-zero
	savepsl
	jbr	L267
Lashp_zerofill:
	cvtlb	r2,-(r6)	# fill up MSNs of destination with carry or zero
	clrl	r2
L267:
	cmpl	r3,r6
	jneq	Lashp_zerofill
	tstl	r2		# if carry beyond destination, overflow
	jneq	Lashp_overfl
	extzv	$0,$4,(r10),r0	# test for negative result
	cmpl	r0,NEGATIVE
	jneq	Lashp_out
	mnegl	r11,r11
	savepsl
	jneq	Lashp_out	# turn -0 into 0
	insv	POSITIVE,$0,$4,(r10)
Lashp_out:
	clrl	r0
	argl(3,r6)		# restore r6 from stack
	return
Lashp_overfl:			#    do overflow
	clrl	r2
	overflowpsl
	jbr	Lashp_out

	.align	1
	.globl	_EMcvtlp
_EMcvtlp:
	arguw(2,r10)		# (2) destination length == r10
	argl(3,r3)		# (3) destination address == r3
	ashl	$-1,r10,r10
	addl2	r10,r3		# destination address points to Least Sig byte
	incl	r10		# length is # of bytes, not nibbles
	argl(1,r11)		# (1) source == r11
	savepsl
	jgeq	Lcvtlp_pos
	movb	NEGATIVE,(r3)	# source is negative
	divl3	$10,r11,r0
	mull3	$10,r0,r1
	subl3	r11,r1,r2	# r2 = source mod 10
	mnegl	r0,r11		# source = -(source / 10)
	jbr	Lcvtlp_cvt
Lcvtlp_pos:
	movb	POSITIVE,(r3)	# source is non-negative
	divl3	$10,r11,r0
	mull3	$10,r0,r1
	subl3	r1,r11,r2	# r2 = source mod 10
	movl	r0,r11		# source = source / 10
Lcvtlp_cvt:
	insv	r2,$4,$4,(r3)	# store least significant digit
	tstl	r11
	jeql	Lcvtlp_zloop
Lcvtlp_loop:			# while source is non-zero
	decl	r10		#   and for length of destination ...
	jeql	Lcvtlp_over
	divl3	$10,r11,r1	# r1 = source / 10
	mull3	$10,r1,r0
	subl2	r0,r11		# source = source mod 10
	movb	r11,-(r3)	# store low "nibble" in next significant byte
	divl3	$10,r1,r11	# source = r1 / 10
	mull3	$10,r11,r0
	subl2	r0,r1		# r1 = source mod 10
	insv	r1,$4,$4,(r3)	# store high nibble
	tstl	r11
	jneq	Lcvtlp_loop	# quit if source becomes zero
Lcvtlp_zloop:			# fill any remaining bytes with zeros
	decl	r10
	jeql	Lcvtlp_out
	clrb	-(r3)
	jbr	Lcvtlp_zloop
Lcvtlp_over:
	overflowpsl
Lcvtlp_out:
	clrl	r1		# r0 is already zero
	clrl	r2
	return


	.align	1
	.globl	_EMcvtpl
_EMcvtpl:
	arguw(1,r11)		# (1) source length == r11
	argl(2,r10)		# (2) source address == r10
	clrl	r3		# r3 == destination
	movl	r10,r1		# r1 set up now for return
	ashl	$-1,r11,r11	# source length is number of bytes
	jeql	Lcvtpl_zero
Lcvtpl_loop:			# for source length
	mull2	$10,r3		# destination *= 10
	extzv	$4,$4,(r10),r0
	addl2	r0,r3		# destination += high nibble
	mull2	$10,r3		# destination *= 10
	extzv	$0,$4,(r10),r0
	addl2	r0,r3		# destination += low nibble
	incl	r10
	decl	r11
	jneq	Lcvtpl_loop
Lcvtpl_zero:			# least significant byte
	mull2	$10,r3
	extzv	$4,$4,(r10),r0
	addl2	r0,r3		# dest = 10 * dest + high nibble
	savepsl
	extzv	$0,$4,(r10),r2	# test sign nibble
	cmpl	r2,NEGATIVE
	jeql	Lcvtpl_neg
	cmpl	r2,NEGATIVEalt
	jneq	Lcvtpl_out
Lcvtpl_neg:			# source was negative - negate destination
	mnegl	r3,r3
	savepsl
Lcvtpl_out:
	toarg(r3,3)
	clrl	r0
	clrl	r2
	clrl	r3
	return

/*
 *	Definitions for Editpc instruction
 *
 *  Here are the commands and their corresponding hex values:
 *
 *	EPend		0x00
 *	EPend_float	0x01
 *	EPclear_signif	0x02
 *	EPset_signif	0x03
 *	EPstore_sign	0x04
 *	EPload_fill	0x40
 *	EPload_sign	0x41
 *	EPload_plus	0x42
 *	EPload_minus	0x43
 *	EPinsert	0x44
 *	EPblank_zero	0x45
 *	EPreplace_sign	0x46
 *	EPadjust_input	0x47
 *	EPfill		0x80
 *	EPmove		0x90
 *	EPfloat		0xa0
 *
 *
 *  r4 is carved up as follows:
 *
 *	------------------------------------------- 
 *     |                                   N Z V C |
 *	-------------------------------------------
 *
 *	fill character is stuffed into arg5 space
 *	sign character is stuffed into arg6 space
 */

#define SIGNIFBIT	$0
#define setsignif	bisl2	$1,r4
#define clsignif	bicl2	$1,r4
#define OVERFLOWBIT	$1
#define setoverflow	bisl2	$2,r4
#define cloverflow	bicl2	$2,r4
#define ZEROBIT		$2
#define setzero		bisl2	$4,r4
#define clzero		bicl2	$4,r4
#define NEGATIVEBIT	$3
#define setnegative	bisl2	$8,r4
#define clnegative	bicl2	$8,r4
#define putfill		movb	arg5,(r5)+
#define setfill(reg)	movb	reg,arg5
#define putsign		movb	arg6,(r5)+
#define setsign(reg)	movb	reg,arg6

	.align	1
	.globl	_EMeditpc
_EMeditpc:
	arguw(1,r11)		# (1) source length == r11
	argl(2,r10)		# (2) source address == r10
	argl(3,r3)		# (3) pattern address == r3
	argl(4,r5)		# (4) destination address == r5
			# we will need arg1 and arg2 later
			# arg5 and arg6 are used for fill and sign - r0 is free
	setfill($32)		# fill character is ' '
	setsign($32)		# sign character is ' '
	clrl	r4		# clear flags
	ashl	$-1,r11,r11	# source length / 2
	addl3	r11,r10,r2
	extzv	$4,$4,(r2),r1	# r1 == least significant nibble of source
L169:
	cmpl	r2,r10
	jeql	L170
	tstb	-(r2)		# loop over source packed decimal number
	jeql	L169
	incl	r1		# r1 is non-zero if source is non-zero
L170:
	addl3	r11,r10,r2
	tstl	r1
	jeql	L172		# source is zero - set flags
	extzv	$0,$4,(r2),r11
	cmpl	r11,NEGATIVEalt
	jeql	L9998		# source is negative - set sign and flags
	cmpl	r11,NEGATIVE
	jneq	L175
L9998:
	setnegative
	setsign($45)		# sign character is '-'
	jbr	L175
L172:
	setzero
L175:
	arguw(1,r2)		# (1) source length == r2
Ledit_case:
	movzbl	(r3)+,r11	# get next edit command (pattern)
	cmpl	r11,$128
	jlss	L180
	extzv	$0,$4,r11,r1	# command has a "count" arg - into r1
	ashl	$-4,r11,r11	# and shift over
L180:
	jbc	$6,r11,L181	# "shift" those commands > 64 to 16 and up
	subl2	$48,r11
L181:
	caseb	r11,$0,$0x18	# "do" the command
				# r11 is available for use, r1 has "count" in it
Lcaseb_label:
	.word	Le_end - Lcaseb_label		# 00
	.word	Le_end_float - Lcaseb_label	# 01
	.word	Le_clear_signif - Lcaseb_label	# 02
	.word	Le_set_signif - Lcaseb_label	# 03
	.word	Le_store_sign - Lcaseb_label	# 04
	.word	Le_end - Lcaseb_label		# 05
	.word	Le_end - Lcaseb_label		# 06
	.word	Le_end - Lcaseb_label		# 07
	.word	Le_fill - Lcaseb_label		# 80
	.word	Le_move - Lcaseb_label		# 90
	.word	Le_float - Lcaseb_label		# a0
	.word	Le_end - Lcaseb_label		# b0
	.word	Le_end - Lcaseb_label		# c0
	.word	Le_end - Lcaseb_label		# d0
	.word	Le_end - Lcaseb_label		# e0
	.word	Le_end - Lcaseb_label		# f0
	.word	Le_load_fill - Lcaseb_label	# 40
	.word	Le_load_sign - Lcaseb_label	# 41
	.word	Le_load_plus - Lcaseb_label	# 42
	.word	Le_load_minus - Lcaseb_label	# 43
	.word	Le_insert - Lcaseb_label	# 44
	.word	Le_blank_zero - Lcaseb_label	# 45
	.word	Le_replace_sign - Lcaseb_label	# 46
	.word	Le_adjust_input - Lcaseb_label	# 47
Le_end:
	arguw(1,r0)
	argl(2,r1)
	clrl	r2
	decl	r3
	setpsl(r4)
	clrl	r4
	return

Le_end_float:
	jbs	SIGNIFBIT,r4,Ledit_case	# if significance not set
	putsign				# drop in the sign
					# fall into...
Le_set_signif:
	setsignif
	jbr	Ledit_case

Le_clear_signif:
	clsignif
	jbr	Ledit_case

Le_store_sign:
	putsign
	jbr	Ledit_case

Le_load_fill:
	setfill((r3)+)
	jbr	Ledit_case

Le_load_plus:
	jbs	NEGATIVEBIT,r4,Lpattern_inc	# if non-negative
					# fall into...
Le_load_sign:
	setsign((r3)+)
	jbr	Ledit_case

Le_load_minus:
	jbs	NEGATIVEBIT,r4,Le_load_sign	# if negative load the sign
	incl	r3			# else increment pattern
	jbr	Ledit_case

Le_insert:
	jbc	SIGNIFBIT,r4,L196	# if significance set, put next byte
	movb	(r3)+,(r5)+
	jbr	Ledit_case
L196:					# else put in fill character
	putfill
					# and throw away character in pattern
Le_replace_sign:			# we don't do anything with
Lpattern_inc:				# replace sign `cause we don't
	incl	r3			# get negative zero
	jbr	Ledit_case

Le_blank_zero:
	jbc	ZEROBIT,r4,Lpattern_inc	# if zero
	movzbl	(r3)+,r11		# next byte is a count
	jeql	Ledit_case
	subl2	r11,r5			# to back up over output and replace
L200:
	putfill				# with fill character
	decl	r11
	jneq	L200
	jbr	Ledit_case

Le_adjust_input:
	movzbl	(r3)+,r0		# get count of nibbles from pattern
	subl3	r2,r0,r11
	jgeq	Ledit_case		# if length of source is > this number
L204:					# discard digits in source
	jlbc	r2,L206			# use low bit of length to choose nibble
	bitb	$0xf0,(r10)		# high nibble
	jeql	L208
	setsignif			# set significance and overflow if
	setoverflow			#    wasted digit is non-zero
	jbr	L208
L206:
	bitb	$0xf,(r10)		# low nibble
	jeql	L209
	setsignif
	setoverflow
L209:
	incl	r10			# increment to next byte
L208:
	decl	r2			# decrement source length
	incl	r11			# continue `till we're out of excess
	jlss	L204
	jbr	Ledit_case

Le_fill:
	tstl	r1			# put (count in r1) fill characters
	jeql	Ledit_case
Le_fill_loop:
	putfill
	decl	r1
	jneq	Le_fill_loop
	jbr	Ledit_case

Le_move:
	tstl	r1			# move (count in r1) characters
	jeql	Ledit_case		# from source to destination
L214:
	jlbc	r2,L215			# read a nibble
	extzv	$4,$4,(r10),r11
	jbr	L216
L215:
	extzv	$0,$4,(r10),r11
	incl	r10
L216:
	decl	r2			# source length CAN go negative here...
	tstl	r11
	jeql	L218			# if non-zero
	setsignif			# set significance
L218:
	jbc	SIGNIFBIT,r4,L219	# if significance set
	addb3	$48,r11,(r5)+		# put '0' + digit into destination
	jbr	L220
L219:					# else put fill character
	putfill
L220:
	decl	r1
	jneq	L214
	jbr	Ledit_case

Le_float:				# move with floating sign character
	tstl	r1
	jeql	Ledit_case
L221:
	jlbc	r2,L222
	extzv	$4,$4,(r10),r11
	jbr	L223
L222:
	extzv	$0,$4,(r10),r11
	incl	r10
L223:
	decl	r2			# source length CAN go negative here...
	tstl	r11
	jeql	L225
	jbs	SIGNIFBIT,r4,L226
	putsign
L226:
	setsignif
L225:
	jbc	SIGNIFBIT,r4,L227
	addb3	$48,r11,(r5)+
	jbr	L228
L227:
	putfill
L228:
	decl	r1
	jneq	L221
	jbr	Ledit_case

#define unimpl(name)			\
	.align	1			;\
	.globl	_EM/**/name		;\
_EM/**/name:				;\
	pushab		1f		;\
	calls		$1,_printf	;\
	return				;\
1:	.ascii	"name\n\0"

unimpl(cvtps)
unimpl(cvtsp)
unimpl(addp6)
unimpl(subp4)
unimpl(subp6)
unimpl(cvtpt)
unimpl(mulp)
unimpl(cvttp)
unimpl(divp)
unimpl(cmpp3)
unimpl(cmpp4)

	.align	1
	.globl	_EMcrc
_EMcrc:
	argl(1,r11)		# (1) table address == r11
	argl(2,r0)		# (2) initial crc == r0
	toarg(r8,1)		# save r8 in arg1 spot
	argl(4,r8)		# (4) source address == r8
	toarg(r1,4)		# save r1 in arg4 spot
	tstl	arg3		# (3) source length == "arg3"
	jeql	Lcrc_out
Lcrc_loop:
	xorb2	(r8)+,r0
	extzv	$0,$4,r0,r10
	extzv	$4,$28,r0,r1
	xorl3	r1,(r11)[r10],r0
	extzv	$0,$4,r0,r10
	extzv	$4,$28,r0,r1
	xorl3	r1,(r11)[r10],r0
	decl	arg3
	jneq	Lcrc_loop
	tstl	r0
Lcrc_out:
	savepsl
	argl(1,r8)
	argl(4,r1)
	return

/*
 * Emulation OpCode jump table:
 *	ONLY GOES FROM 0xf8 (-8) TO 0x3B (59)
 */
#define EMUTABLE	0x43
#define NOEMULATE	.long noemulate
#define	EMULATE(a)	.long _EM/**/a
#define	EMULALT(a)	.long _newEM/**/a
	.globl	_emJUMPtable
_emJUMPtable:
/* f8 */	EMULALT(ashp);	EMULALT(cvtlp);	NOEMULATE;	NOEMULATE
/* fc */	NOEMULATE;	NOEMULATE;	NOEMULATE;	NOEMULATE
/* 00 */	NOEMULATE;	NOEMULATE;	NOEMULATE;	NOEMULATE
/* 04 */	NOEMULATE;	NOEMULATE;	NOEMULATE;	NOEMULATE
/* 08 */	EMULATE(cvtps);	EMULATE(cvtsp);	NOEMULATE;	EMULATE(crc)
/* 0c */	NOEMULATE;	NOEMULATE;	NOEMULATE;	NOEMULATE
/* 10 */	NOEMULATE;	NOEMULATE;	NOEMULATE;	NOEMULATE
/* 14 */	NOEMULATE;	NOEMULATE;	NOEMULATE;	NOEMULATE
/* 18 */	NOEMULATE;	NOEMULATE;	NOEMULATE;	NOEMULATE
/* 1c */	NOEMULATE;	NOEMULATE;	NOEMULATE;	NOEMULATE
/* 20 */	EMULALT(addp4);	EMULATE(addp6);	EMULATE(subp4);	EMULATE(subp6)
/* 24 */	EMULATE(cvtpt);	EMULATE(mulp);	EMULATE(cvttp);	EMULATE(divp)
/* 28 */	NOEMULATE;	EMULATE(cmpc3);	EMULATE(scanc);	EMULATE(spanc)
/* 2c */	NOEMULATE;	EMULATE(cmpc5);	EMULATE(movtc);	EMULATE(movtuc)
/* 30 */	NOEMULATE;	NOEMULATE;	NOEMULATE;	NOEMULATE
/* 34 */	EMULALT(movp);	EMULATE(cmpp3);	EMULALT(cvtpl);	EMULATE(cmpp4)
/* 38 */	EMULATE(editpc); EMULATE(matchc); EMULATE(locc); EMULATE(skpc)

/*
 * The following is called with the stack set up as follows:
 *
 *	  (sp):	Opcode
 *	 4(sp):	Instruction PC
 *	 8(sp):	Operand 1
 *	12(sp):	Operand 2
 *	16(sp):	Operand 3
 *	20(sp):	Operand 4
 *	24(sp):	Operand 5
 *	28(sp):	Operand 6
 *	32(sp):	Operand 7 (unused)
 *	36(sp):	Operand 8 (unused)
 *	40(sp):	Return PC
 *	44(sp):	Return PSL
 *	48(sp): TOS before instruction
 *
 * Each individual routine is called with the stack set up as follows:
 *
 *	  (sp):	Return address of trap handler
 *	 4(sp):	Opcode (will get return PSL)
 *	 8(sp):	Instruction PC
 *	12(sp):	Operand 1
 *	16(sp):	Operand 2
 *	20(sp):	Operand 3
 *	24(sp):	Operand 4
 *	28(sp):	Operand 5
 *	32(sp):	Operand 6
 *	36(sp):	saved register 11
 *	40(sp):	saved register 10
 *	44(sp):	Return PC
 *	48(sp):	Return PSL
 *	52(sp): TOS before instruction
 */

	.globl	_emuvec
_emuvec:
	movl	r11,32(sp)		# save register r11 in unused operand
	movl	r10,36(sp)		# save register r10 in unused operand
	cvtbl	(sp),r10		# get opcode
	addl2	$8,r10			# shift negative opcodes
	subl3	r10,$EMUTABLE,r11	# forget it if opcode is out of range
	bcs	noemulate
	movl	_emJUMPtable[r10],r10	# call appropriate emulation routine
	jsb	(r10)			# routines put return values into r0-r5
	movl	32(sp),r11		# restore register r11
	movl	36(sp),r10		# restore register r10
	insv	(sp),$0,$4,44(sp)	# and condition codes in Opcode spot
	addl2	$40,sp			# adjust stack for return
	rei
noemulate:
	addl2	$48,sp			# adjust stack for
	.word	0xffff			# "reserved instruction fault"

	.globl	__EMend
__EMend:
