{File name LispArith12K.mc
Description:  DandeLion InterLisp Emulator Arith Instructions
Author: Charnley
Last modified: Charnley          11-Jan-84 15:05:16 mod to shifts to save TOS & GetFixP ret mod
Last modified: Charnley 31-Aug-83 10:11:23 modified ufn's to use ufnX's
Created: 15-Aug-83 14:48:53
}
{	OPCODES
	two arg functions
	1	321	vag2	2
	0	324	plus2	2
	7	325	difference	2
	2	326	times2	2
	-	327	quot	2
	0	330	iplus2	2
	7	331	idifference	2
	2	332	itimes2	2
	-	333	iquot	2
	-	334	remainder	2
	4	344	logor2	2
	5	345	logand2	2
	6	346	logxor2	2
	10	361	igreaterp	2
	one arg functions
	0	15	335	addn	1
	0	16	336	subn	1
	0	0	340	llsh1	1
	1	1	341	llsh8	1
	2	2	342	lrsh1	1
	3	3	343	lrsh8	1
}

SetTask[0];

{*************************
	IPLUS2, IDIFF, LOGOR2, LOGAND2, LOGXOR2, VAG2	5%  3 click
**************************}
@PLUS:	opcode[324'b],
	MAR _ [rhS, S + 0], L2 _ L2.plus,	c1;
	Ybus _ TOSH xor smallpl, NZeroBr, GOTO[Arith0]	c2;

@IPLUS2:	opcode[330'b],
	MAR _ [rhS, S + 0], L2 _ L2.iplus,	c1;
	Ybus _ TOSH xor smallpl, NZeroBr, GOTO[Arith0]	c2;

@OR:	opcode[344'b],
	MAR _ [rhS, S + 0], {L2 = L2.or}, GOTO[Arith],	c1;
@AND:	opcode[345'b],
	MAR _ [rhS, S + 0], {L2 = L2.and}, GOTO[Arith],	c1;
@XOR:	opcode[346'b],
	MAR _ [rhS, S + 0], {L2 = L2.xor}, GOTO[Arith],	c1;
@VAG2:	opcode[321'b],
	MAR _ [rhS, S + 0], L2 _ 1, GOTO[Arith],	c1;
@IDIFF2:	opcode[331'b],
	MAR _ [rhS, S + 0], L2 _ L2.idiff,	c1;
	Ybus _ TOSH xor smallpl, NZeroBr, GOTO[Arith0]	c2;

@DIFF:	opcode[325'b],
	MAR _ [rhS, S + 0], L2 _ L2.diff,	c1;
	Ybus _ TOSH xor smallpl, NZeroBr, GOTO[Arith0]	c2;

@IGREATERP:	opcode[361'b],
	MAR _ [rhS, S + 0], L2 _ L2.igreaterp,	c1;
	Ybus _ TOSH xor smallpl, NZeroBr, GOTO[Arith0]	c2;

@GREATERP:	opcode[363'b],
	MAR _ [rhS, S + 0], L2 _ L2.greaterp,	c1;
	Ybus _ TOSH xor smallpl, NZeroBr, GOTO[Arith0],	c2;

Arith:
	Ybus _ TOSH xor smallpl, NZeroBr, GOTO[Arith0]	c2;

Arith0:	Rx _ MD, uTOS _ TOS, L2Disp, BRANCH[$, ArithA1notsmp],	c3;

	MAR _ [rhS, S - 1], DISP4[ArithOp], L0 _ 0{put L2 into L0},	c1;

	TOS _ Rx + TOS, CarryBr, CANCELBR[Arith1, 2],	c2, at[L2.plus, 10, ArithOp];
	TOS _ Rx + TOS, CarryBr, CANCELBR[Arith1, 2],	c2, at[L2.iplus, 10, ArithOp];
	TOS _ Rx or TOS, CANCELBR[Arith1, 2],	c2, at[L2.or, 10, ArithOp];
	TOS _ Rx and TOS, CANCELBR[Arith1, 2],	c2, at[L2.and, 10, ArithOp];
	TOS _ Rx xor TOS, CANCELBR[Arith1, 2],	c2, at[L2.xor, 10, ArithOp];
	TOS _ Rx - TOS, CarryBr, CANCELBR[SubXX, 2],	c2, at[L2.diff, 10, ArithOp];
	TOS _ Rx - TOS, CarryBr, CANCELBR[SubXX, 2],	c2, at[L2.idiff, 10, ArithOp];
	Ybus _ TOS - Rx, CarryBr, CANCELBR[ComXX, 2],	c2, at[L2.greaterp, 10, ArithOp];
	Ybus _ TOS - Rx, CarryBr, CANCELBR[ComXX, 2],	c2, at[L2.igreaterp, 10, ArithOp];
	S _ S - 2, CANCELBR[Vag2XX, 2],	c2, at[01'b, 10, ArithOp];

SubXX:
	TT _ MD xor TOSH, BRANCH[ArithSubCarry, ArithSC1],	  c3;
ComXX:
	TT _ MD xor TOSH, BRANCH[ArithCompNotNil, ArithCompNil],	  c3;
Arith1:
	TT _ MD xor TOSH, BRANCH[ArithSC2, ArithAddCarry],	c3;

{test for zero in low byte by addressing a word in current stack page}
ArithSC1:
	MAR _ [rhS, TT + 0FF], L2 _ L2.0, GOTO[Arith2],	  c1;
ArithSC2:
	MAR _ [rhS, TT + 0FF], L2 _ L2.0, GOTO[Arith2],	c1;

Arith2:
	S _ S - 2, IBDisp, BRANCH[$, ArithShortEr3, 1],	c2;
	PC _ PC + PC16, L2 _ L2.0, DISPNI[OpTable],	c3;

Vag2XX:
	TT _ MD xor TOSH,	c3;

	MAR _ [rhS, TT + 0FF], L2 _ L2.0,	c1;
	TOSH _ Rx, IBDisp, BRANCH[$, ArithShortEr4, 1],	c2;
	PC _ PC + PC16, L2 _ L2.0, DISPNI[OpTable],	c3;

ArithCompNil:
	MAR _ [rhS, TT + 0FF],	c1;
	TOS _ 0, BRANCH[ArithCompC, ArithCompA2notsmp, 1],	c2;

ArithCompNotNil:
	MAR _ [rhS, TT + 0FF],	c1;
	TOS _ KTval, BRANCH[ArithCompC, ArithCompA2notsmp, 1],	c2;
ArithCompC:
	TOSH _ 0,	c3;

	S _ S - 2, GOTO[IB.pc1],	c1;

	{exceptions:}

ArithSubCarry:
{	Subtraction Carry, TOS modified, Arg2 not checked yet }
	TOS _ uTOS, GOTO[ArithShortC2],	c1;

ArithAddCarry:
{	Addition Carry, TOS modified, Arg2 not checked yet }
	TOS _ uTOS, GOTO[ArithShortC2],	c1;

ArithShortC2:
	uTOSH _ TOSH,	c2;
	TOSH _ 0, GOTO[ArithA1done],   c3;

ArithShortEr3:
{	Arg2 not smallp, TOS modified, S modified, L2 modified } 
	TOS _ uTOS, L0Disp, GOTO[ArithErRestore],	c3;

ArithErRestore:
	L2 _ 0{move L0 to L2}, S _ S + 2, DISP4[ArithL2Disp],	c1;

	uTOSH _ TOSH, GOTO[ArithL2Ret],	c*, at[L2.plus, 10, ArithL2Disp];
	uTOSH _ TOSH, GOTO[ArithL2Ret],	c*, at[L2.iplus, 10, ArithL2Disp];
	uTOSH _ TOSH, GOTO[ArithL2Ret],	c*, at[L2.or, 10, ArithL2Disp];
	uTOSH _ TOSH, GOTO[ArithL2Ret],	c*, at[L2.and, 10, ArithL2Disp];
	uTOSH _ TOSH, GOTO[ArithL2Ret],	c*, at[L2.xor, 10, ArithL2Disp];
	uTOSH _ TOSH, GOTO[ArithL2Ret],	c*, at[L2.vag2, 10, ArithL2Disp];
	uTOSH _ TOSH, GOTO[ArithL2Ret],	c*, at[L2.diff, 10, ArithL2Disp];
	uTOSH _ TOSH, GOTO[ArithL2Ret],	c*, at[L2.idiff, 10, ArithL2Disp];
	uTOSH _ TOSH, GOTO[ArithL2Ret],	c*, at[L2.greaterp, 10, ArithL2Disp];
	uTOSH _ TOSH, GOTO[ArithL2Ret],	c*, at[L2.igreaterp, 10, ArithL2Disp];
	uTOSH _ TOSH, GOTO[ArithL2Ret],	c*, at[L2.times, 10, ArithL2Disp];

ArithL2Ret:
	TOSH _ 0, GOTO[ArithA1done],	c3;

ArithShortEr4:
{	VAG2:  Arg2 not smallp, S modified, L2 modified, TOSH modified }
	TOSH _ smallpl,	c3;
	S _ S + 2, GOTO[ufnX2],	c1;

{*********************************
	GENERIC:
*********************************}

	{
	TOS is saved in uTOS
	TOSH is saved in uTOSH
	first arg placed in TOSH . TOS
	second arg placed in TT . Rx
	result placed in TOSH . TOS
		if result is not small, then exit through
		CREATECELL.
		uNewValLo and uNewValHi must be loaded with result
		Q _ (LShift4   Type)  LS4FixpType
		L1 _ appropriate map fault fix value
			{probably L1.fixFV  --  to restore TOS , TOSH}
		L3 _ 4{fpt} used both here during abnormal exits, and after L1.fixFV
		{maybe L3 _ 5 for single arg bytecodes}
	L2 holds operation index
	}

ArithA1notsmp:	{here if first arg not smallpos}
	Ybus _ TOSH xor smallneg, ZeroBr, CANCELBR[$, 0F],	c1;
	uTOSH _ TOSH, BRANCH[ArithA1notsmall, ArithA1Neg],	c2;

ArithCompA2notsmp:
	TOSH _ 0, uTOSH _ TOSH,	c3;

	TOS _ uTOS,	c1;
	TT _ TT xor smallpl,	c2;
	TT _ TT and 0FF, GOTO[ArithCheckA2],	c3;

ArithA1Neg:
	TOSH _ TOSH xor ~TOSH, GOTO[ArithA1done],	c3;

ArithA1done:
	MAR _ [rhS, S - 1],	c1;
	TT _ 0FF, CANCELBR[$, CB2],	c2;
	TT _ TT and MD, GOTO[ArithCheckA2],	c3;

ArithCheckA2:
	Ybus _ TT xor smallpl, ZeroBr,	c1;
	Ybus _ TT xor smallneg, ZeroBr, BRANCH[$, ArithA2Pos],	c2;
	BRANCH[ArithA2notsmall, ArithA2Neg],	c3;

ArithA2Pos:
	TT _ 0, CANCELBR[$],	c3;
	L2Disp, GOTO[ArithDouble],	c1;

ArithA2Neg:
	TT _ TT xor ~TT, L2Disp, GOTO[ArithDouble],	c1;

ArithDouble:
	DISP4[ArithDOp],	c2;
	TOS _ Rx + TOS, CarryBr, GOTO[ArithAddTail],	c3,at[L2.plus,10,ArithDOp];
	TOS _ Rx + TOS, CarryBr, GOTO[ArithAddTail],	c3,at[L2.iplus,10,ArithDOp];
	TOS _ Rx - TOS, CarryBr, GOTO[ArithSubTail],	c3,at[L2.diff,10,ArithDOp];
	TOS _ Rx - TOS, CarryBr, GOTO[ArithSubTail],	c3,at[L2.idiff,10,ArithDOp];
	TOS _ Rx or TOS,	c3, at[L2.or, 10, ArithDOp];
	TOSH _ TT or TOSH, ZeroBr, GOTO[ArithLog],	c1;

	TOS _ Rx and TOS,	c3, at[L2.and, 10, ArithDOp];
	TOSH _ TT and TOSH, ZeroBr, GOTO[ArithLog],	c1;

	TOS _ Rx xor TOS,	c3, at[L2.xor, 10, ArithDOp];{Xor}
	TOSH _ TT xor TOSH, ZeroBr, GOTO[ArithLog],	c1;

	Ybus _ TOS - Rx, CarryBr, GOTO[ArithCompTail],	c3,at[L2.greaterp,10,ArithDOp];
	Ybus _ TOS - Rx, CarryBr, GOTO[ArithCompTail],	c3,at[L2.igreaterp,10,ArithDOp];


	GOTO[ufnZ1],	c3, at[01'b, 10, ArithDOp];{Vag2}
	GOTO[ufnZ1],	c3, at[02'b, 10, ArithDOp];{mul}

ArithAddTail:
	BRANCH[$, ArithAddCar],	c1;
	TOSH _ TT + TOSH, PgCrOvDisp, GOTO[ArithCom],	c2;
ArithAddCar:
	TOSH _ TT + TOSH + 1, PgCrOvDisp, GOTO[ArithCom],	c2;

ArithSubTail:
	BRANCH[$, ArithSubCar],	c1;
	TOSH _ TT - TOSH - 1, PgCrOvDisp, GOTO[ArithCom],	c2;
ArithSubCar:
	TOSH _ TT - TOSH, PgCrOvDisp, GOTO[ArithCom],	c2;


ArithCompTail:
	Ybus _ TOSH xor TT, NegBr, BRANCH[$, ArithCompCar],	c1;
	Ybus _ TOSH - TT - 1, NegBr, BRANCH[ArithCompSSgn, ArithCompDSgn],	c2;

ArithCompCar:
	Ybus _ TOSH - TT, NegBr, BRANCH[ArithCompSSgn, ArithCompDSgn],	c2;

ArithCompSSgn:
	BRANCH[ArithResNIL0, ArithResT0],	c3;

ArithCompDSgn:
	Ybus _ TT, NegBr, CANCELBR[$],	c3;
	S _ S - 2, BRANCH[ArithResT, ArithResNIL],	c1;

ArithResT0:
	S _ S - 2,	c1;
ArithResT:
	TOS _ KTval, GOTO[ArithCompEnd],	c2;
ArithCompEnd:
	TOSH _ 0,	c3;

	PC _ PC + PC16, GOTO[IB.nop],	c1;

ArithResNIL0:
	S _ S - 2,	c1;
ArithResNIL:
	TOS _ 0, GOTO[ArithCompEnd],	c2;

ArithCom:
	BRANCH[ArithNoOv, ArithOv, 2],	c3;

ArithOv:
	GOTO[ufnZ2],	c1;

ArithNoOv:
	Ybus _ TOSH, ZeroBr,	c1;

ArithLog:
	Ybus _ TOSH + 1, ZeroBr, BRANCH[$, ArithResSmPos],	c2;
	BRANCH[ArithResNotSmall, ArithResSmNeg],	c3;

ArithResSmPos:
	TOSH _ smallpl, CANCELBR[ArithShDone1],	c3;

ArithResSmNeg:
	TOSH _ smallneg, GOTO[ArithShDone2],	c1;

ArithResNotSmall:
	{setup exit through CREATECELL }
	uNewValLo _ TOS, L1 _ L1.fixFV,	c1;
	uNewValHi _ TOSH, L3 _ L3.FptArg1,	c2;
	Q _ LS4FixpType, GOTO[CCSubr],	c3;

ArithA1notsmall:
	{setup call to ArithGetFixp }
	L3 _ L3.FptArg1,	c3;

ArithBoxE:
	UXsave _ Rx,	c1;
	TT _ TOSH,	c2;
	Rx _ TOS, CALL[ArithGetFixp],	c3;

	TOS _ Rx,	c1, at[L3.FptArg1, 10, ArithFixpRet];
	TOSH _ TT,	c2;
	Rx _ UXsave, GOTO[ArithA1done],	c3;
	{return to ArithA1done }

ArithA2notsmall:
	{setup call to ArithGetFixp }
	,	c1;
	L3 _ L3.FptArg2,	c2;
	CALL[ArithGetFixp],	c3;

	L2Disp, GOTO[ArithDouble],	c1, at[L3.FptArg2, 10, ArithFixpRet];
	{return to ArithDouble }

ArithShDone2:
	,	c2;
	,	c3;
ArithShDone1:
	L2 _ L2.0, GOTO[Arith2],	c1;

{	*************************** 
	SUBROUTINE ArithGetFixp
	***************************	}

ArithGetFixp:
	{
	TT . Rx contains Lisp Pointer
	value is returned in TT . Rx
	can page fault on value of Fixp
	will ufn if Type not Fixp
	L3 _ L3.FptArg1 or L3.FptArg2 or L3.Sh for tos restoration after page fault
	L3 also used to distinguish caller
	uChain used as a temp
	}

	rhTT _ TT LRot0,	c1;
	,	c2;
	uChain _ Rx,	c3;

	MAR _ Q _ [Rx, TT + 0],	c1;
	Rx _ Q, rhRx _ crhTypeTable, 	c2;
	Rx _ Rx LRot8, L1 _ L1.fixFV,	c3;

	Rx _ Rx RShift1, getTypemsBit,	c1;
	, 	c2;
	Q _ FixpType,	c3;

	MAR _ [rhRx, Rx + 0], L0 _ L0.xRedoArith,	c1;
	TT _ uChain,	c2;
	Q _ MD xor Q,	c3;

	Q _ Q and 0FF,	c1;
	Ybus _ Q, ZeroBr,	c2;
	BRANCH[ArithArgNotFixp, $],	c3;

	Map _ [rhTT, TT],	c1;
	,	c2;
	rhRx _ Rx _ MD, XRefBr,	c3;

	MAR _ Q _ [rhRx, TT + 0], BRANCH[ArithFixpMap, $],	c1, at[L0.xRedoArith, 10, RxMapFixCaller];
	,	c2;
	TT _ MD,	c3;

	MAR _ [rhRx, Q + 1],	c1;
	L3Disp, CANCELBR[$, CB2],	c2;
	RET[ArithFixpRet], Rx _ MD,	c3;

ArithArgNotFixp:
	L2Disp, TOS _ uTOS,	c1;
	TOSH _ uTOSH, DISP4[tryFL, 07],	c2;
	GOTO[ufnZ1],	c3, at[7, 10, tryFL];

	,	c3, at[0F, 10, tryFL];

	Bank _ FPTBank,	c1;
	L3 _ L3.FunSecond,	c2;
	CROSS[FPTCode],	c3;

ArithFixpMap:
	GOTO[RLxMapFix],	c2;

{	end using fixp's }

{*************************
	LLSH1, LLSH8, LRSH1, LRSH8	2%  2 clicks
**************************}
@LLSH1:	opcode[340'b],
	Rx _ TOS LShift1, NegBr, GOTO[NoRots],	c1;
@LLSH8:	opcode[341'b],
	Ybus _ TOS and uFF00, NZeroBr, GOTO[RotTOS],	c1;
@LRSH1:	opcode[342'b],
	Rx _ TOS RShift1, GOTO[NoRots],	c1;
@LRSH8:	opcode[343'b],
	Rx _ TOS and ~0FF, GOTO[Rot],	c1;

RotTOS:	Rx _ TOS LRot8, BRANCH[ArithShOK, ArithShBig],	c2;
Rot:	Rx _ Rx LRot8, GOTO[ArithShOK],	c2;
NoRots:	BRANCH[ArithShOK, ArithShBig],	c2;

ArithShOK:
	Ybus _ TOSH xor smallpl, NZeroBr,	c3;

	uTOSH _ TOSH, BRANCH[$, ArithShNotSmp],	c1;
	TOS _ Rx, IBDisp, L2 _ L2.0, GOTO[DNI.pc1],	c2;

{exceptions:}

ArithShBig:
	{result more than 16 bits, but arg smallp not tested yet}
	Ybus _ TOSH xor smallpl, ZeroBr,	c3;

	uTOSH _ TOSH, BRANCH[$, ArithShAP],	c1;
	Ybus _ TOSH xor smallneg, ZeroBr, GOTO[ArithShCa],	c2;

ArithShAP:
	Rx _ TOS, L2Disp,	c2;
	TT _ 0, uTOS _ TOS, DISP2[ArithSh],	c3;

ArithShNotSmp:
	Ybus _ TOSH xor smallneg, ZeroBr,	c2;

ArithShCa:
	uTOS _ TOS, BRANCH[ArithShAnotsm, ArithShANeg],	c3;

ArithShANeg:
	TT _ TT xor ~TT,	c1;
	Rx _ TOS, L2Disp,	c2;
	DISP2[ArithSh],	c3;

{LEFT 1}
	TOS _ Rx LShift1, NegBr,	c1, at[0, 4, ArithSh];{left 1}
	BRANCH[$, ArithShL1],	c2;
	TT _ TT LShift1, SE _ 0, GOTO[ArithShDone],	c3;
ArithShL1:
	TT _ TT LShift1, SE _ 1, GOTO[ArithShDone],	c3;

{RIGHT 1}
	TT _ TT RShift1, YDisp,	c1, at[2, 4, ArithSh];{right 1}
	BRANCH[$, ArithShR1, 0E],	c2;
	TOS _ Rx RShift1, SE _ 0, GOTO[ArithShDone],	c3;
ArithShR1:
	TOS _ Rx RShift1, SE _ 1, GOTO[ArithShDone],	c3;

{LEFT 8}
	Rx _ Rx LRot8,	c1, at[1, 4, ArithSh];{left 8}
	Q _ Rx and 0FF,	c2;
	TOS _ Rx and ~0FF,	c3;

	TT _ TT LRot8,	c1;
	TT _ TT and ~0FF,	c2;
	TT _ TT or Q, GOTO[ArithShDone],	c3;

{RIGHT 8}
	TT _ TT LRot8,	c1, at[3, 4, ArithSh];{right 8}
	Q _ TT and ~0FF,	c2;
	TT _ TT and 0FF,	c3;

	Rx _ Rx LRot8,	c1;
	Rx _ Rx and 0FF,	c2;
	TOS _ Rx or Q, GOTO[ArithShDone],	c3;

ArithShAnotsm:
	Rx _ TOS, L3 _ L3.Sh,	c1;
	TT _ TOSH,	c2;
	CALL[ArithGetFixp],	c3;

	TOS _ Rx,	c1, at[L3.Sh, 10, ArithFixpRet];
	L2Disp,	c2;
	DISP2[ArithSh],	c3;

ArithShDone:
	Ybus _ TT, ZeroBr,	c1;
	Ybus _ TT + 1, CarryBr, BRANCH[$, ArithShResSp],	c2;
	BRANCH[ArithShResnotsm, ArithShResSn],	c3;

ArithShResSp:
	TOSH _ smallpl, CANCELBR[$],	c3;

	GOTO[ArithShFinis], 	c1;
ArithShFinis:
	IBDisp, L2 _ L2.0, GOTO[DNI.pc1],	c2;

ArithShResSn:
	TOSH _ smallneg, GOTO[ArithShFinis], 	c1;

ArithShResnotsm:
	{setup exit through CREATECELL }
	uNewValLo _ TOS, L1 _ L1.fixFV,	c1;
	uNewValHi _ TT, L3 _ L3.Sh,	c2;
	Q _ LS4FixpType, GOTO[CCSubr],	c3;

@MAKENUMBER:	opcode[365'b],
	MAR _ [rhS, S - 1],	c1;
	Ybus _ TOSH xor smallpl, ZeroBr, CANCELBR[$, 2],	c2;
	Rx _ MD xor TOSH, BRANCH[mnufn1, $],	c3;

	MAR _ [rhS, S + 0],	c1;
	Ybus _ Rx - 1, PgCarryBr,	c2;
	TT _ MD, BRANCH[$, mnufn2],	c3;

	uTOS _ TOS,	c1;
	uTOSH _ TOSH,	c2;
	TOSH _ TT, GOTO[ArithNoOv],	c3;

mnufn1:	GOTO[ufnX2],	c1;

mnufn2:	GOTO[ufnX2],	c1;


{*******************************************************************
	MUL			%  20 clicks
*******************************************************************}
{This code implements a basic add-shift unsigned mulitply.  Q holds the multiplicand  and TOS the mulitplier .  TT holds the loop count.  Rx and Q are the concatenated double word result, with the most significant bits being formed in Rx and the least significant in Q.  The DoubleRightShift1 shifts Cout of the current alu computation into bit 0 of the double length result (Rx,,Q).  At the end, the product replaces the top of stack.  Punts occur if the resultant product is longer than 16 bits, or if either multiplier or multiplicand is not legal.}

@TIMES2:	opcode[326'b],
	MAR _ [rhS, S + 0], L2_L2.times, GOTO[ArithMul],	c1;

@MUL:	opcode[332'b],
	MAR _ [rhS, S + 0], L2_L2.times, GOTO[ArithMul],	c1;
ArithMul:
	Ybus _ TOSH xor smallpl, NZeroBr, GOTO[Arith0],	c2;

	Q _ Rx, CANCELBR[Mul3, CB2],	c2, at[2'b, 10, ArithOp];
Mul3:	TT _ MD xor TOSH,	c3;

	Rx _ TT, NZeroBr,	c1;
	TT _ 10, BRANCH[$, MulUfn3],	c2;
	Ybus_ Q and 1, NZeroBr, GOTO[MulCon],	c3;

MulLoop:	Ybus_ Q and 1, NZeroBr,	c3;

MulCon:	TT _ TT - 1, ZeroBr, BRANCH[MPlier0, MPlier1],	c1;

MPlier0:	Rx _ DARShift1 (Rx+0), BRANCH[MulLoop, MLDEnd],	c2;
MPlier1:	Rx _ DARShift1 (Rx + TOS), BRANCH[MulLoop, MLDEnd],	c2;

MLDEnd:	Ybus _ Rx, ZeroBr,	c3;

	S _ S - 2, BRANCH[MulUfn2, $],	c1;
	TOS _ ~Q {long.low}, L2 _ L2.0, IBDisp,	c2;
	PC _ PC + PC16, L2 _ L2.0, DISPNI[OpTable],	c3;


MulUfn2:
	S _ S + 2, L1 _ L1.fixFV,	c2;{result not smallPos}
	uTOSH _ TOSH, L3 _ L3.FptArg1,	c3;
	
	uNewValHi _ Rx, NegBr,			c1;
	uNewValLo _ ~Q, BRANCH[$, Mulovufn],	c2;
	

	{setup exit through CREATECELL }
	Q _ LS4FixpType, GOTO[CCSubr],	c3;

Mulovufn:

	GOTO[ufnX1],			c3; {Negative}
MulUfn3:
	GOTO[ufnX1],	c3;{A2 not smallPos}

{*******************************************************************
	ADDN, SUBN		%  2 clicks
*******************************************************************}

SUBN:	Q _ ibNA - TOS -1, CarryBr,	c1, opcode[336'b];
	Q _ -Q - 1, BRANCH[addTail, ufnAdd],	c2;

ADDN:	Q _ TOS + ibNA, CarryBr,	c1, opcode[335'b];
	BRANCH[addTail, ufnAdd],	c2;
addTail:	Ybus _ TOSH xor smallpl, NZeroBr,,	c3;

	BRANCH[$, ufnAdd2],	c1;
	TOS _ Q, IBDisp, Xbus _ ib, L2_L2.0,	c2;
	PC _ PC + 1, L2_L2.0, DISPNI[OpTable],	c3;

{exceptions:}
ufnAdd2:	GOTO[ufnX3],	c2;{arg not smallPos}
ufnAdd:	GOTO[ufnX1],	c3;{result not smallPos}


{*******************************************************************
	DIV			%  20 clicks
*******************************************************************}
{This code implements a basic subtract-shift unsigned restoring divide.  TOS holds the divisor  and the concatenation Rx,,Q holds the double length dividend (long).  TT holds the loop count.  The final quotient appears in Q and the remainder in Rx.  The DoubleLeftShift1 shifts Cin into bit 17B of the accumulating quotient.  At the end, Q or Rx is pushed onto the stack.}

IQUOT:
	MAR _ [rhS, S + 0], GOTO[QotS2], {L2 is 0}	c1,opcode[333'b];

QUOT:
	MAR _ [rhS, S + 0], GOTO[QotS2], {L2 is 0}	c1,opcode[327'b];

REMAINDER:
	MAR _ [rhS, S + 0], L2 _ 1'b, {L2 was 0}	c1,opcode[334'b];
QotS2:
	Ybus _ TOSH xor smallpl, NZeroBr,	c2;
	Rx _ MD, BRANCH[$, Qotufn1],	c3;

	MAR _ [rhS, S - 1],	c1;
	Q _ Rx, CANCELBR[$, 2],	c2;
	Rx _ MD xor TOSH,	c3;

	Ybus _ TOS, ZeroBr,	c1;
	Ybus _ Rx, NZeroBr, BRANCH[$, Qotufn3{DivByZero}],	c2;
	TT _ 0F + 1, BRANCH[$, Qotufn1a],	c3;

	Rx _ DLShift1 Rx, SE_0, NegBr, GOTO[QotLoop],	c1;

QotLoop:	Ybus_ Rx - TOS, CarryBr, BRANCH[QuotUnk, QuotIs1],	c2;

QuotIs1:	TT _ TT - 1, ZeroBr, CANCELBR[Quot1],	c3;
QuotUnk:	TT _ TT - 1, ZeroBr, BRANCH[Quot0, Quot1],	c3;

Quot0:	Rx _ DLShift1 Rx, SE_0, NegBr, BRANCH[QotLoop, QotEnd],	c1;
Quot1:	Rx _ DLShift1 (Rx - TOS), SE_1, NegBr, BRANCH[QotLoop, QotEnd],	c1;


QotEnd:	S _ S - 2, L2Disp, BRANCH[RemAdj0, RemAdj1],	c2;

RemAdj0:	Rx _ RShift1 Rx, SE_0, BRANCH[QotDiv, QotRem],	c3;
RemAdj1:	Rx _ RShift1 Rx, SE_1, BRANCH[QotDiv, QotRem],	c3;

QotDiv:
	TOS _ ~Q, GOTO[IB.pc1],	c1;
QotRem:
	TOS _ Rx, GOTO[IB.pc1],	c1;
IB.pc1: {common tail}
	PC _ PC + PC16, L2 _ L2.0, IBDisp, GOTO[DNI.nop],	c2;

Qotufn3:	CANCELBR[$, 1],	c3;{division by zero}
Qotufn1a:	GOTO[ufnX2],	c1;{A2 not smallPos}
Qotufn1:	GOTO[ufnX2],	c1;{A1 not smallPos}


{	begin MulPrep}


{

MulPrep:
	uSign _ 0,	c?;
MulChA2:	{test A2 first to leave TOS alone for ufn}
	Ybus _ TT + 1, ZeroBr,	c?;
	Ybus _ TT, ZeroBr, BRANCH[$, MulA2Neg],	c?;
MulChA1:
	Ybus _ TOSH + 1, ZeroBr, BRANCH[MulA2Large, $],	c?;
	Ybus _ TOSH, ZeroBr, BRANCH[$, MulA1Neg],	c?;
MulChdone:
	BRANCH[MulA1Large, MulProceed],	c?;

MulA2Neg:
	Rx _ 0 - Rx, ZeroBr, CANCELBR[$],	c?;{complement}
	uSign _ TOS xor ~TOS, BRANCH[$, MulA2MaxNeg],	c?;
	Xbus _ 1, XDisp, GOTO[MulChA1],	c?;

MulA1Neg:
	TOS _ 0 - TOS, ZeroBr, CANCELBR[$],	c?;{complement}
	Q _ uSign, BRANCH[$, MulA1MaxNeg],	c?;
	uSign _ ~Q, GOTO[MulChdone],	c?;

MulProceed:
	,	c?;

{ufn's here}
MulA1Large:
	TOSH _ uTOSH, GOTO[ufnX?],	c?;
MulA1MaxNeg:
	TOS _ uTOS,	c?;
	TOSH _ uTOSH, GOTO[ufnX?],	c?;
MulA2Large:
	TOSH _ uTOSH, GOTO[ufnX?],	c?;
MulA2MaxNeg:
	TOSH _ uTOSH, GOTO[ufnX?],	c?;

{	end MulPrep }

{	begin Mul Finish }


{	end Mul Finish }

{	begin DivPrep }
DivPrep:	{A2 is dividend, A1 is the divisor}
	u{Q}Sign _ 0,	c?;
DivChA2:	{test A2 first to leave TOS alone for ufn}
	Ybus _ TT, NegBr,	c?;
	BRANCH[$, DivA2Neg],	c?;
	uRSign _ 0,	c?;
DivChA1:
	Ybus _ TOSH + 1, ZeroBr,	c?;
	Ybus _ TOSH, ZeroBr, BRANCH[$, DivA1Neg],	c?;
DivChdone:
	BRANCH[DivA1Large, DivProceed],	c?;

DivA2Neg:
	Rx _ 0 - Rx, ZeroBr,	c?;{complement}
	u{Q}Sign _ TOS xor ~TOS, BRANCH[$, DivA2Low0],	c?;
	TT _ 0 - TT - 1,	c?;
DivFixRSign:
	uRSign _ TOS xor ~TOS, GOTO[DivChA1],	c?;

DivA2Low0:
	TT _ 0 - TT, GOTO[DivFixRSign],	c?;

DivA1Neg:
	TOS _ 0 - TOS, ZeroBr, CANCELBR[$],	c?;{complement}
	Q _ u{Q}Sign, BRANCH[$, DivA1MaxNeg],	c?;
	u{Q}Sign _ ~Q, GOTO[DivChdone],	c?;

DivProceed:
	Ybus _ TT - TOS, NegBr,	c?;
	BRANCH[DivQuotTooBig, DivOK]


{ufn's here}
DivA1Large:
	TOSH _ uTOSH, GOTO[ufnX?],	c?;
DivA1MaxNeg:
	TOS _ uTOS,	c?;
	TOSH _ uTOSH, GOTO[ufnX?],	c?;
DivA2MaxNeg:
	TOSH _ uTOSH, GOTO[ufnX?],	c?;
DivQuotTooBig:
	TOS _ uTOS,	c?;
	TOSH _ uTOSH, GOTO[ufnX?],	c?;

{	end DivPrep }


}

{	E N D }