{File name NewLispArith.mc
Description:  DandeLion InterLisp Emulator Arith Instructions
Author: Charnley
Last modified: Charnley   14-Sep-83 14:50:16
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];

{	FROM Lisp.mc}

{*************************
	IPLUS2, IDIFF, LOGOR2, LOGAND2, LOGXOR2, VAG2	5%  3 click
**************************}
Binary:
	MAR _ [rhS, S + 0], GOTO[Arith], {L2 = 0}	c1, opcode[330'b];{Plus}
	MAR _ [rhS, S + 0], GOTO[Arith], {L2 = 4}	c1, opcode[344'b];{Or}
	MAR _ [rhS, S + 0], GOTO[Arith], {L2 = 5}	c1, opcode[345'b];{And}
	MAR _ [rhS, S + 0], GOTO[Arith], {L2 = 6}	c1, opcode[346'b];{Xor}
	MAR _ [rhS, S + 0], GOTO[Arith], L2 _ 1,	c1, opcode[321'b];{Vag2}
	MAR _ [rhS, S + 0], L2 _ 07'b,	c1, opcode[331'b];{IDIFF}
ArithSub2:
	Ybus _ TOSH xor smallpl, NZeroBr, GOTO[Arith0],	c2;
	MAR _ [rhS, S + 0],GOTO[Arith], {L2 = 0}, 	c1, opcode[324'b];{PLUS2}
	MAR _ [rhS, S + 0], L2 _ 07'b, GOTO[ArithSub2],	c1, opcode[325'b];{DIFF}

Arith:	Ybus _ TOSH xor smallpl, NZeroBr,	c2;
Arith0:	Rx _ MD, uTOS _ TOS, L2Disp, BRANCH[$, ufnNoDisp],	c3;

	MAR _ [rhS, S - 1], DISP4[Add], L3 _ 0, {put L2 into L3}	c1;
	TOS _ Rx + TOS, CarryBr, CANCELBR[Arith1, 0],	c2, at[0'b, 10, Add];{Plus}{Plus2}
	TOS _ Rx or TOS, CANCELBR[Arith1, 0],	c2, at[04'b, 10, Add];{Or}
	TOS _ Rx and TOS, CANCELBR[Arith1, 0],	c2, at[05'b, 10, Add];{And}
	TOS _ Rx xor TOS, CANCELBR[Arith1, 0],	c2, at[06'b, 10, Add];{Xor}
	TOS _ Rx - TOS, CarryBr, CANCELBR[SubXX, 0],	c2, at[07'b, 10, Add];{DIFF}{IDIFF}
SubXX:	  TT _ MD xor TOSH, BRANCH[UfnSubt, $],	  c3;
	  MAR _ [rhS, TT + 0FF], L2 _ L2.0, GOTO[Arith2],	  c1;

Arith1:	TT _ MD xor TOSH, BRANCH[$, UfnOverfl],	c3;

{test for zero in low byte by addressing a word in current stack page}
	MAR _ [rhS, TT + 0FF], L2 _ L2.0,	c1;
Arith2:	S _ S - 2, IBDisp, BRANCH[$, UfnPush, 1],	c2;
Arith3:	PC _ PC + PC16, L2 _ L2.0, DISPNI[OpTable],	c3;

Vag2:	S _ S - 2, CANCELBR[$, 0],	c2, at[01'b, 10, Add];
	TT _ MD xor TOSH,	c3;
	MAR _ [rhS, TT + 0FF], L2 _ L2.0,	c1;
	TOSH _ Rx, IBDisp, BRANCH[Arith3, UfnPush, 1],	c2;


{exceptions:}
ufnNoDisp:	CANCELBR[ufnX2, 0F],	c1;{A1 not smallPos}

UfnSubt:	TOS _ uTOS, CANCELBR[UfnXX, 0F],	c1;{subtract result not smallPos}

UfnPush:	S _ S + 2,	c3;{A2 not smallPos}
UfnOverfl:	TOS _ uTOS,	c1;{add result not smallPos}
UfnXX:	TOSH _ smallpl, GOTO[ufnX3],	c2;


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

TIMES2:	MAR _ [rhS, S + 0], L2_2'b,	c1, opcode[326'b];
	Ybus _ TOSH xor smallpl, NZeroBr, GOTO[Arith0],	c2;


MUL:	MAR _ [rhS, S + 0], L2 _ 2'b,	c1, opcode[332'b];{ITimes}
	Ybus _ TOSH xor smallpl, NZeroBr, GOTO[Arith0],	c2;
{Arith0:	Rx _ MD, uTOS _ TOS, BRANCH[$, ufnNoDisp], L2Disp,	c3;

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

	Q _ Rx, CANCELBR[Mul3, 0],	c2, at[2'b, 10, Add];
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,	c2;{result not smallPos}
MulUfn3:	GOTO[ufnNoDisp],	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}


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

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

{

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

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

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

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

UfnPush:	{here if first arg is smallpos, second is not}
	TT _ TT xor TOSH,	c3;
	uTOSH _ TOSH, TOSH _ 0,	c1;
	TOS _ uTOS,	c2;
	GOTO[ArithCheckA2],	c3;

ArithDouble:
	DISP4[ArithOp], L3 _ 0,{? puts L2 into L3 ?}	c2;
	TOS _ Rx + TOS, CarryBr, GOTO[ArithAddTail],	c3,at[00'b,10,ArithOp];{plus}
	TOS _ Rx - TOS, CarryBr, GOTO[ArithSubTail],	c3,at[07'b,10,ArithOp];{idifference}
	TOS _ Rx or TOS,	c3, at[04'b, 10, ArithOp];{Or}
	TOSH _ TT or TOSH, ZeroBr, GOTO[ArithLog],	c1;

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

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

	,	c3, at[01'b, 10, ArithOp];{Vag2}
	,	c3, at[02'b, 10, ArithOp];{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, PgCrOvDisp, GOTO[ArithCom],	c2;
ArithSubCar:
	TOSH _ TT - TOSH - 1, PgCrOvDisp, GOTO[ArithCom],	c2;

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

ArithOv:
	GOTO[ufnX2],	c1;

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

ArithResSmPos:
	TOSH _ smallpl, GOTO[ArithDone1],	c3;

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

ArithResNotSmall:
	,	c1;
ArithA1notsmall:
	,	c3;
ArithA2notsmall:
	,	c1;
	{44 to here }

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

{	using fixp's }

{	put the 32 bits into some fixed place
	call typ and verify that it is a fixp
	mapping the fixp may fault -- be prepared!
	get the 32 bit value to a fixed place
	return
	}


{	end using fixp's }


}

{	E N D }