{File name LispArith4K.mc
Description:  DandeLion InterLisp Emulator Arith Instructions
Author: Charnley
Last modified: Charnley   16-Jan-84 11:20:10
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
	0	1	321	vag2	2
	0	4	324	plus2	2
	0	5	325	difference	2
	0	6	326	times2	2
	0	7	327	quot	2
	0	10	330	iplus2	2
	0	11	331	idifference	2
	0	12	332	itimes2	2
	0	13	333	iquot	2
	0	14	334	remainder	2
	4	4	344	logor2	2
	5	5	345	logand2	2
	6	6	346	logxor2	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];
Set[L3.First, 0C];
Set[L3.Second, 9];
RegDef[uA1Hi,	U,	5];
RegDef[uA1Lo,	U,	7];

{*************************
	IPLUS2, IDIFF, LOGOR2, LOGAND2, LOGXOR2, VAG2	5%  3 click
**************************}
@PLUS:	opcode[330'b],
	MAR _ [rhS, S + 0], {L2 = 0}, GOTO[ArithShortC2],	c1;
@IPLUS2:	opcode[324'b],
	MAR _ [rhS, S + 0], {L2 = 0}, GOTO[ArithShortC2],	c1;
@OR:	opcode[344'b],
	uTOS _ TOS, {L2 = 4}, GOTO[ArithC2],	c1;
@AND:	opcode[345'b],
	uTOS _ TOS, {L2 = 5}, GOTO[ArithC2],	c1;
@XOR:	opcode[346'b],
	uTOS _ TOS, {L2 = 6}, GOTO[ArithC2],	c1;
@VAG2:	opcode[321'b],
	MAR _ [rhS, S + 0], GOTO[ArithVag],	c1;
@IDIFF2:	opcode[331'b],
	MAR _ [rhS, S + 0], L2 _ 07'b, GOTO[ArithShortC2],	c1;
@DIFF:	opcode[325'b],
	MAR _ [rhS, S + 0], L2 _ 07'b, GOTO[ArithShortC2],	c1;
@IGREATERP:	opcode[361'b],
	uTOS _ TOS, L2 _ 10'b, GOTO[ArithComp2],	c1;
@GREATERP:	opcode[363'b],
	uTOS _ TOS, L2 _ 10'b, GOTO[ArithComp2],	c1;

ArithShortC2:
	Ybus _ TOSH xor smallpl, ZeroBr,	c2;
	Rx _ MD, uTOS _ TOS, L2Disp, BRANCH[ArithOut1, $],	c3;

	MAR _ [rhS, S - 1], DISP4[ArithShortOp],	c1;

	TOS _ TOS + Rx, CarryBr, CANCELBR[$, 2],	c2, at[00'b, 10, ArithShortOp];{add}
	TT _ MD, BRANCH[$, ArithOut2],	c3;

	Ybus _ TT xor smallpl, ZeroBr, GOTO[ArithShortCom],	c1;

	TOS _ Rx - TOS, CarryBr, CANCELBR[$, 2],	c2, at[07'b, 10, ArithShortOp];{sub}
	TT _ MD, BRANCH[ArithOut3, $],	c3;

	Ybus _ TT xor smallpl, ZeroBr, GOTO[ArithShortCom],	c1;


ArithShortCom:
	BRANCH[ArithOut4, $],	c2;
	TOSH _ smallpl,	c3;

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

ArithOut1:
	TOS _ uTOS, CANCELBR[ArithShort2, 0F],	c1;

ArithOut2:
	TOS _ uTOS, GOTO[ArithShort2],	c1;

ArithOut3:
	TOS _ uTOS, GOTO[ArithShort2],	c1;

ArithOut4:
	GOTO[ArithOut1],	c3;

ArithShort2:
	uTOSH _ TOSH, L3 _ L3.First, GOTO[ArithC3],	c2;

ArithComp2:
	uTOSH _ TOSH, L3 _ L3.First, GOTO[ArithC3],	c2;
ArithSub2:
	uTOSH _ TOSH, L3 _ L3.First, GOTO[ArithC3],	c2;
ArithC2:
	uTOSH _ TOSH, L3 _ L3.First, GOTO[ArithC3]	c2;

ArithC3:	CALL[ArithUnbox],	c3;

ArithUnbox:
	Ybus _ TOSH xor smallpl, ZeroBr, L1 _ L1.fixFV,	c1;
	Ybus _ TOSH xor smallneg, ZeroBr, BRANCH[$, ArgPos],	c2;
	L3Disp, BRANCH[$, ArgNeg],	c3;

	Rx _ TOS, CANCELBR[ArgNotSmall, 0F],{ArgNotSmall}	c1;

ArgPos:
	TOSH _ 0, L3Disp, CANCELBR[ArgSmall],	c3;
ArgNeg:
	TOSH _ TOSH xor ~TOSH, DISP4[UnboxRet],	c1;
ArgSmall:
	DISP4[UnboxRet],	c1;

	,	c1, at[L3.First, 10, EvalGetRet];
	uA1Hi _ TOSH, L3 _ L3.Second,	c2, at[L3.First, 10, UnboxRet];
	uA1Lo _ TOS,	c3;

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

	MAR _ [rhS, S + 0],	c1;
	,	c2;
	TOS _ MD, CALL[ArithUnbox],	c3;

	,	c1, at[L3.Second, 10, EvalGetRet];
	TT _ uA1Hi, L2Disp,	c2, at[L3.Second, 10, UnboxRet];
	Rx _ uA1Lo, DISP4[ArithDoit],	c3;

	TOS _ Rx + TOS, CarryBr, GOTO[ArithAddTail],	c1, at[00'b, 10, ArithDoit];{plus}
	TOS _ TOS - Rx, CarryBr, GOTO[ArithSubTail],	c1, at[07'b, 10, ArithDoit];{idifference}
	TOS _ Rx or TOS,	c1, at[04'b, 10, ArithDoit];{Or}
	TOSH _ TT or TOSH, GOTO[ArithLog],	c2;

	TOS _ Rx and TOS,	c1, at[05'b, 10, ArithDoit];{And}
	TOSH _ TT and TOSH, GOTO[ArithLog],	c2;

	TOS _ Rx xor TOS,	c1, at[06'b, 10, ArithDoit];{Xor}
	TOSH _ TT xor TOSH, GOTO[ArithLog],	c2;

	Ybus _ Rx - TOS, CarryBr, GOTO[ArithCompTail],	c1, at[10'b, 10, ArithDoit];{igreaterp}

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

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

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

ArithCompSSgn:
	TOSH _ 0, BRANCH[ArithResNIL0, ArithResT0],	c1;

ArithCompDSgn:
	Ybus _ TOSH, NegBr, CANCELBR[$],	c1;
	TOSH _ 0, BRANCH[ArithResT, ArithResNIL],	c2;

ArithResT0:
	,	c2;
ArithResT:
	TOS _ KTval, GOTO[ArithEnd],	c3;

ArithResNIL0:
	,	c2;
ArithResNIL:
	TOS _ 0, GOTO[ArithEnd],	c3;

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

ArithLog:
	,	c3;

ArithCom:
	Ybus _ TOSH, ZeroBr, BRANCH[ArithNoOv, ArithOv, 2],	c1;
ArithNoOv:
	Ybus _ TOSH + 1, ZeroBr, BRANCH[$, ArithResSmP],	c2;
	TOSH _ smallneg, BRANCH[$, ArithEnd],	c3;

	GOTO[ufnZ2],{result not small}	c1;

ArithOv:
	CANCELBR[ufnZ3],{overflow}	c2;

ArithResSmP:
	TOSH _ smallpl, CANCELBR[ArithEnd],	c3;

ArithVag:
	,	c2;
	TOSH _ MD, GOTO[ArithEnd]	c3;


ArgNotSmall:
	Q _ 0FF,	c2;
{	GOTO[ufnZ1],	c3;l4ka3:}
	rhRx _ MDSTYPEspaceReal,	c3;

	MAR _ Rx _ [Rx{TOS}, TOSH + 0],{not mem req}	c1;
	Rx _ Rx LRot8,	c2;
	Rx _ Rx RShift1, getTypemsBit,	c3;

	MAR _ [rhRx, Rx + 0],	c1;
	rhTT _ TOSH LRot0,	c2;
	Q _ MD and Q,	c3;

	Q _ Q xor FixpType, ZeroBr,	c1;
	TT _ TOS, BRANCH[ArithArgNotFixp, $],	c2;
	CALL[EvalGet],	c3;

	GOTO[NoFixes],	c3,at[L3.First,10,fvfixup];
	GOTO[NoFixes],	c3,at[L3.Second,10,fvfixup];

ArithArgNotFixp:
	CANCELBR[ufnZ1],	c3;


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

RotTOS:	Rx _ TOS LRot8, BRANCH[Unary, ufnUnary],	c2;
Rot:	Rx _ Rx LRot8, BRANCH[Unary, ufnUnary],	c2;
NoRots:	BRANCH[Unary, ufnUnary],	c2;

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

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


{exceptions:}
ufnUnary2:	GOTO[ufnX3],	c2;{arg not smallPos}
ufnUnary:	GOTO[ufnX1],	c3;{result more than 16 bits}

{	FROM MoreLisp.mc}

{*******************************************************************
	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.}
{	OLD CODE START
@TIMES2:	opcode[326'b],
	MAR _ [rhS, S + 0], GOTO[ArithMul],	c1;

@ITIMES2:	opcode[332'b],
	MAR _ [rhS, S + 0], GOTO[ArithMul],	c1;
ArithMul:
	Ybus _ TOSH xor smallpl, NZeroBr,	c2;
	Rx _ MD, BRANCH[$, Mulufn],	c3;

	MAR _ [rhS, S - 1],	c1;
	Q _ Rx, CANCELBR[Mul3, CB2],	c2;
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, GOTO[DNI.pc1],	c2;
{	PC _ PC + PC16, L2 _ L2.0, DISPNI[OpTable],	c3;}


MulUfn2:	S _ S + 2,	c2;{result not smallPos}
MulUfn3:	GOTO[ufnX1],	c3;{arg 2 not smallPos}
Mulufn:	GOTO[ufnX2],	c1;{arg 1 not smallPos}
	OLD CODE END }
@TIMES2:	opcode[326'b],
	MAR _ [rhS, S + 0], GOTO[ArithMul],	c1;

@ITIMES2:	opcode[332'b],
	MAR _ [rhS, S + 0], GOTO[ArithMul],	c1;
ArithMul:
	Ybus _ TOSH xor smallpl, NZeroBr,	c2;
	TT _ MD, BRANCH[$, Mulufn],	c3;

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

	Ybus _ Rx and 1, NZeroBr, GOTO[firstmore],	c1;
firstmore:
	Ybus _ Q, NZeroBr, BRANCH[ftimes0, ftimes1],	c2;
ftimes1:
	Q _ TT, BRANCH[mulloopA, mulerrA],	c3;
ftimes0:
	Q _ 0, BRANCH[mulloopA, mulerrA],	c3;
mulloop:
	Rx _ RShift1 Rx, SE _ 0, YDisp, BRANCH[mulmore, multhru],	c1;
mulmore:
	TT _ TT + TT, CarryBr, BRANCH[times0, times1, 0D],	c2;
times1:
	Q _ Q + TT, CarryBr, BRANCH[mulloopA, mulerrA],	c3;
times0:
	Ybus _ Rx, ZeroBr, BRANCH[mulloop, mulfin],	c3;
mulloopA:
	Rx _ RShift1 Rx, SE _ 0, YDisp, BRANCH[mulmoreA, mulerr],	c1;
mulmoreA:
	TT _ TT + TT, CarryBr, BRANCH[times0, times1, 0D],	c2;
mulfin:
	BRANCH[mulerrB, multhruB],	c1;
multhru:
	TOS _ Q, CANCELBR[ArithResSmP, 0F],	c2;
multhruB:
	TOS _ Q, GOTO[ArithResSmP],	c2;

mulerr:
	CANCELBR[ufnX3, 0F],	c2;
mulerrA:
	CANCELBR[ufnX2, 1],	c1;
mulerrB:
	GOTO[ufnX3],	c2;
Mulufn:
	GOTO[ufnX2],	c1;

{*******************************************************************
	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}
}
@ADDN:	GOTO[ufnX2],	c1, opcode[336'b];
@SUBN:	GOTO[ufnX2],	c1, opcode[335'b];


{	FROM LispGC.mc}

{*******************************************************************
	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}

{	E N D }