:TITLE[Arith.0mc...September 13, 1982  3:37 PM, van Melle];

* LLSH1, op 340:
* Replace TOS with it shifted left one, aborts to UFN on overlow

@LLSH1:
	call[CheckSmallp], lspUFN _ 340c, opcode[340];		* Ufn index
	T _ lsh[Stack, 1], dblgoto[lshFails, lshGetsT, R<0];
lshGetsT:
	Stack _ T, goto[nxiLBL];
lshFails:
	goto[ufnLBL];

* LLSH8, op 341, Replace TOS with it shifted left 8, abort on overflow

@LLSH8:
	call[CheckSmallp], lspUFN _ 341c, opcode[341];
	lu _ lhmask[Stack];
	T _ lsh[Stack, 10], dblgoto[lshFails, lshGetsT, alu#0];



* LRSH1, op 342, Replace TOS with it shifted right one

@LRSH1:
	call[CheckSmallp], lspUFN _ 342c, opcode[342];
	Stack _ rsh[Stack, 1], goto[nxiLBL];


* LRSH8, op 343, Replace TOS with it shifted right 8

@LRSH8:
	call[CheckSmallp], lspUFN _ 343c, opcode[343];
	Stack _ rsh[Stack, 10], goto[nxiLBL];


* Smallpos unbox
* returns TOS in T as integer if it is smallposp, punts otherwise

	onpage[pgArithOps];
CheckSmallp:
	T _ Stack&-1;
	lu _ (Stack&+1) xor (smallpl);
	skip[alu=0];
	  goto[ufnLBL];
lspRetP7:
	return;




* Two arg arithmetic opcodes.  These all go to Unbox to unbox TOS-1 and TOS
* into Int1Hi/Lo and Int2Hi/Lo, then come back here by dispatching thru lspUFN
* For compactness, UFN encodes two 4 bit fields:
* <low 4 bits of opcode>,,<function>
* where <function> provides a (up to) 16-way dispatch on logical function,
* and the low 2 bits are a 4-way dispatch on the possible hi 4 bits of opcode
* (320, 340, 360, with 320 twice).

M@[ArithOp, Or[LShift[And[#1,17],4], #2]];	* ArithOp[opcode, fn]
RV2[Int1Hi, Int1Lo, IP[AC0]];
RV2[Int2Hi, Int2Lo, IP[lspL2]];


* Logical ops.  No overflow.  Low 2 bits = 1

@Logor2:
	goto[Unbox], lspUFN _ ArithOp[344,1]c, opcode[344];
	Int1Lo _ (Int1Lo) or T, at[ArithDisp, 1];
	T _ Int2Hi;
	Int1Hi _ (Int1Hi) or T, goto[IntBoxEasy];


@Logand2:
	goto[Unbox], lspUFN _ ArithOp[345,5]c, opcode[345];
	Int1Lo _ (Int1Lo) and T, at[ArithDisp, 5];
	T _ Int2Hi;
	Int1Hi _ (Int1Hi) and T, goto[IntBoxEasy];


@Logxor2:
	goto[Unbox], lspUFN _ ArithOp[346,11]c, opcode[346];
	Int1Lo _ (Int1Lo) xor T, at[ArithDisp, 11];
	T _ Int2Hi;
	Int1Hi _ (Int1Hi) xor T, goto[IntBoxEasy];


* IGREATERP, op 361; GREATERP, op 363
@IGTRP:
	goto[Unbox], lspUFN _ ArithOp[361,6]c, opcode[361];	* IGREATERP
	goto[Unbox], lspUFN _ ArithOp[363,6]c, opcode[363];	* GREATERP
*
*	Want to see if L0,1 > L2,3.  Do this by subtracting L2,3 - L0,1
*	and testing Carry'.
*
	Int2Hi _ (Int2Hi) xor (100000c), at[ArithDisp, 6];
						* complement sign bits
	T _ (Int1Hi) xor (100000c);		* so compare comes out right
	lu _ (Int2Hi) - T;			* Compare hi halves
	T _ Int1Lo, FreezeResult, skip[alu=0];
	  Stack&-1 _ 0c, dblgoto[Igt, Ilt, No Carry];
	lu _ (Int2Lo) - T;			* if hi equal, compare lo
	Stack&-1 _ 0c, dblgoto[Igt, Ilt, No Carry];
Ilt:	Stack&+1 _ 0c, goto[ArithExit];
Igt:	Stack&+1 _ (KtVal), goto[ArithExit];

* Arithmetic Ops.  Overflow possible.  Low 2 bits = 0

@IPLUS2:
	goto[Unbox], lspUFN _ ArithOp[330,0]c, opcode[330];	* IPLUS2
	goto[Unbox], lspUFN _ ArithOp[324,0]c, opcode[324];	* PLUS2
ArithOps:
	Int1Lo _ (Int1Lo) + T, at[ArithDisp, 0];
	T _ Int2Hi, FreezeResult;
	Int1Hi _ (Int1Hi) + T, UseCoutasCin, goto[IntBox];


@IDIFFERENCE:
	goto[Unbox], lspUFN _ ArithOp[331,4]c, opcode[331];	* IDIFFERENCE
	goto[Unbox], lspUFN _ ArithOp[325,4]c, opcode[325];	* DIFFERENCE

	Int1Lo _ (Int1Lo) - T, at[ArithDisp, 4];
	T _ Int2Hi, FreezeResult;
	Int1Hi _ (Int1Hi) - T, UseCoutasCin, goto[IntBox];



@BOXIPLUS:
	goto[Unbox], lspUFN _ ArithOp[366,2]c, opcode[366];
	Int1Lo _ (Int1Lo) + T, at[ArithDisp, 2];
	T _ Int2Hi, FreezeResult;
	Int1Hi _ (Int1Hi) + T, UseCoutasCin, goto[StuffBox];

@BOXIDIFFERENCE:
	goto[Unbox], lspUFN _ ArithOp[367,12]c, opcode[367];
	Int1Lo _ (Int1Lo) - T, at[ArithDisp, 12];
	T _ Int2Hi, FreezeResult;
	Int1Hi _ (Int1Hi) - T, UseCoutasCin, goto[StuffBox];

StuffBox:	* Check that first arg is large (Unbox set sign bit if so)
	lspUFN, skip[R<0];
	  goto[ArithUfn];
	PStore2[XBuf2, Int1Hi, 0], goto[ArithExit];
				* any fault here has already happened



@MAKENUMBER:
	lspUFN _ 365c, goto[lspUfnxP7], opcode[365];	* MakeNumber

* ITIMES2, op 332; TIMES2, op 326
* This assumes that the hi words are 0 

@ITIMES2:
	goto[Unbox], lspUFN _ ArithOp[332,10]c, opcode[332];	* ITIMES2
	goto[Unbox], lspUFN _ ArithOp[326,10]c, opcode[326];	* TIMES2

*	Algorithm taken from Fiala's alto microcode:
*	On each iteration, shift L0,1 right by one, testing the multiplier
*	bits as they fall out the right.  For each 1 bit, add multiplicand
*	into L0.  Shifting L0,1 right is thus analogous to shifting the
*	multiplicand left (but much easier).  Double-length result is
* 	left in L0,1 when last multiplier bit is shifted out

* Loop time: 8 to 9 cycles on multiplier zeroes, 13 to 15 on multiplier ones

	T _ Int1Hi, at[ArithDisp, 10];		* check that hi words are zero
	lu _ (Int2Hi) or T;
	T _ Int2Lo, goto[MulPunta, alu#0];	* T _ multiplicand
	lspL4 _ 16c;				* set loop counter [even loc]
	call[MulLoop1];				* allocation constraint
MulLoop:
	lspL4 _ (lspL4) - 1, GoTo[MulDone, R<0];
MulLoop1:
	Int1Lo _ RSh[Int1Lo,1], Skip[R Odd];	* shift out a multiplier bit
	  Int1Hi _ RSh[Int1Hi,1], DblGoTo[Mula,Mulb,R Odd];	* no add
	Int1Hi _ (Int1Hi) + T;			* mpr bit=1, do add
	Int1Hi _ RCy[Int1Hi,1], Skip[Carry];	* cycle right, saving low bit
						* as sign bit for one mi
	  Int1Hi _ (Int1Hi) and not (100000C), DblGoTo[Mula,Mulb,ALU<0];
					* no carry, so sign bit is off
	Int1Hi _ (Int1Hi) or (100000C), DblGoTo[Mula,Mulb,ALU<0];
					* carry, or it into sign

Mula:	Int1Lo _ (Int1Lo) or (100000C), Return;	* or lowbit of L0 into sign
Mulb:	Return;					* lowbit of L0 was 0

MulDone:
	lu _ Int1Hi, goto[IntBoxEasy, R>=0];	* Box the result
	  goto[ArithUfn];			* Overflow
MulPunta: goto[ArithUfn];			* not smallpos*smallpos



%  Old version

	lu_ (Int1Hi), at[ArithDisp, 5];
	lu_ (Int2Hi), goto[ITimes5, alu#0];
 	goto[ITimes6, alu#0];		* allocation constraint
	T _ (Int2Lo);
	lspL4_ (0c), call[.+1];
	Int1Lo _ rsh[Int1Lo, 1], goto[Itimes1, ROdd];
	goto[ItimesDN, alu=0];
ITimes3:
	T _ Int2Lo_ lsh[Int2Lo, 1], goto[Itimes4, R<0];
	return;
ITimes1:
	lspL4_ (lspL4) + T;
	goto[ITimes2, carry];
	goto[ITimes3];

ITimes2: goto[ArithUfn];
ITimes4: goto[ArithUfn];
ITimes5: goto[ArithUfn];
ITimes6: goto[ArithUfn];
ITimesDN:
	T _ lspL4;
	Int1Lo _ T;
	T _ Int2Hi;
	Int1Hi _ (Int1Hi) xor T, goto[IntBoxEasy];
%

* IQUOTIENT, IREMAINDER, ops 333, 334; QUOTIENT, op 327

@IQuotient:
	goto[Unbox], lspUFN _ ArithOp[333,14]c, opcode[333];	* IQuotient
@IRemainder:
	goto[Unbox], lspUFN _ ArithOp[334,13]c, opcode[334];	* IRemainder
	goto[Unbox], lspUFN _ ArithOp[327,14]c, opcode[327];	* Quotient

* Divide L0,,L1 by L3, quotient in L1, remainder in L0
* Punt if dividend is negative, divisor is not small, or result is not small
* The compact inner loop here is taken from Fiala's alto microcode
*
	goto[retDiv], at[ArithDisp, 13];

retDiv:	T _ Int2Hi, at[ArithDisp, 14];		* get hi divisor
	lu _ (ldf[Int1Hi, 0, 1]) or T;		* and check sign of dividend
	T _ Int2Lo, goto[DivPunta, alu#0];	* punt if either bad
	lu _ (Int1Hi) - T;
					* compare hi dividend : divisor
	lspL4 _ 16c, goto[DivPuntc, Carry];
				* punt if L0 ge L3, i.e. result is large
				* note this is true if zero divisor, too
	T _ 31c;
	SALUF _ T, T _ Int2Lo;			* SALUF _ A+A+Cy1
	Int2Hi _ (Zero) - T;			* L2 _ -(divisor)

* Algorithm: shift L0,1 left one, subtracting divisor from L0.  If
* subtraction succeeds, shift a 1 quotient bit in on the right of L1, else
* zero.  The instruction at DivLoop shifts L0 and subtracts L3 at the
* same time; the instruction at DivRet has set T the negation of the divisor
* plus the sign bit shifted out of L1 in the previous instruction.  The -1
* at DivRet and the +1 at DivLoop cancel each other, but makes the carry
* come out right for divisor 1 or 177777.

* Loop time: 9 cycles for quotient 1's, 12 for quotient 0's

* Setting up before the loop, L1 gets a "don't care" 1 bit shifted in on
* the right, which will be shifted out the top on the last iteration.

	Int1Lo _ (Int1Lo) SALUFOP T, Call[DivRet];
DivLoop:		* Shift hi dividend left, subtracting divisor
	Int1Hi _ (LSh[Int1Hi,1]) + T + 1, Skip[R>=0];
			* Shift low dividend, bringing in quotient bit 1
	  Int1Lo _ (Int1Lo) SALUFOP T, GoTo[DivSub];
			* Shift low dividend, bringing in quotient bit = 1
			* if subtract carried (hi dividend was ge divisor)
	Int1Lo _ (Int1Lo) SALUFOP T, UseCOutAsCIn, GoTo[DivSub,Carry];

*Subtract failed.  Undo it, lovingly preserving the carry bit down to DivRet.
	T _ Int2Lo, FreezeResult;
	Int1Hi _ (Int1Hi) + T, FreezeResult;

DivSub:			* decrement loop counter, quit if done
	lspL4 _ (lspL4) - 1, FreezeResult, goto[DivDone, R<0];
DivRet:			* T _ -(divisor) + (old sign bit of L1) - 1
	T _ (Int2Hi) - 1, UseCOutAsCIn, Return;		* return to DivLoop

DivDone:				* push result (a smallp) on stack
	lspUFN, skip[R Odd];		* which case was it?
	  T _ Int1Lo, goto[BoxSmallPl];	* even, get quotient
	  T _ Int1Hi, goto[BoxSmallPl];	* odd, get remainder


DivPunta: goto[ArithUfn];
DivPuntc: goto[ArithUfn];
	


onpage[pgArithOps];

* Main unboxing routine.  Put TOS into Int2Hi/Lo, TOS-1 into Int1Hi/Lo.
* Punt if necessary.  Return thru Arithops dispatch with T = L3.

* Cycles thru final disp: 10 + 2 unboxes + upto 6 cycles if Int1 interlocks
* for large Int1Hi/Lo.  Unbox time: 11/Smallpos, 10/SmallNeg, 60/largep

Unbox:
	loadpage[pgHStack], call[CheckElt2P7];
	T _ Stack&-1, loadpage[pgArith];
	Int2Lo _ T;
onpage[pgArith];
	lu _ (Stack) xor (smallNeg);
	lu _ (Stack&-1) xor (smallpl), skip[alu#0];
	  Int2Hi _ (Zero) - 1, goto[UnBoxTopDone];
	Int2Hi _ 0c, goto[UnBoxTopDone, alu=0];
	Stack&+2, call[UnboxType];
	PFetch2[XBuf2, Int2Hi, 0], goto[UnBoxTopDone];

UnBoxTopDone:
	T _ Stack&-1;
	Int1Lo _ T;
	lu _ (Stack) xor (smallNeg);
	lu _ (Stack&+1) xor (smallpl), skip[alu#0];
	  Int1Hi _ (Zero) - 1, goto[UnBoxBotDone];
	Int1Hi _ 0c, goto[UnBoxBotDone, alu=0];
	lspUFN _ (lspUFN) or (100000c), call[UnboxType];
	PFetch2[XBuf2, Int1Hi, 0];
	Stack&+2, goto[UnBoxBotDone];

UnBoxBotDone:
	dispatch[lspUFN, 14, 4];
	T _ Int2Lo, disp[ArithOps];

UnboxType:		* Pop TOS into XBuf2,3 as basereg, punt if not fixp
	T _ Stack&-1;
	XBuf2 _ T;
	T _ lsh[Stack&-1, 10];
	XBuf3 _ T;
	T _ rsh[XBuf2, 11];
	T _ (rsh[XBuf3, 1]) or T;
	PFetch1[MDSTypeBaseBr, lspType];
	T _ (fixpType);			* Doesn't save space, but time
	lu _ (rhmask[lspType]) xor T;
	skip[alu=0];
	  goto[ArithUfn];
	return;


onpage[pgArith];

* Come here to box result.  Alu = Int1Hi at IntBoxEasy, BoxCheck

IntBox:					* check for overflow before boxing
	T _ Int1Lo, skip[no ovf];	* T _ lo half of result
	  goto[ArithUfn];
	lu _ Int1Hi, goto[BoxCheck];

IntBoxEasy:				* Here if no overflow possible
	T _ Int1Lo, FreezeResult, goto[BoxCheck];

BoxCheck:	* Check for smallpos (Int1Hi = 0) and smallneg (Int1Hi = -1)
	lu _ (Int1Hi) + 1, goto[BoxSmallpl, alu=0];
	lspNargs _ 2c, goto[BoxSmallneg, alu=0];

:IF[WithCreateCell];
BoxBig:	loadpage[opPage0];		* Create a new fixp cell
	qBuf _ lshift[fixpType!, 4]c, callp[DoCreateCell];
	PStore2[lspGenBr, Int1Hi, 0];	* Can't fault now
	loadpage[pgRplPtr];
	StkState _ rsh[StkState, 1], gotop[GcExit];

:ELSE;
BoxBig:	* Box big result by pushing halves as smallps and calling Makenumber
	Stack&-1 _ (smallpl);
	T _ Int1Hi;
	Stack&+1 _ T;
	Stack&+1 _ (smallpl);
	T _ Int1Lo;
	Stack&+1 _ T, loadpage[pgFrame];
	lspDefx1 _ (MakeNumber), goto[lspCallFn0];
:ENDIF;


BoxSmallPl:
	Stack&-1 _ (smallpl), goto[box1];

BoxSmallneg:
	Stack&-1 _ (smallNeg), goto[box1];

box1:	Stack&+1 _ T;

ArithExit:
	StkState _ rsh[StkState, 1], goto[nxiLBL];



* Punt here: Dispatch lspUFN thru a table of ufns
* Low 2 bits selects the appropriate hi 4 bits

ArithUfn:
	dispatch[lspUFN, 16, 2];
	lspUFN _ ldf[lspUFN, 10, 4], disp[.+1];
	lspUFN _ (lspUFN) or (320c), goto[ufnLBL], disptable[4];	* 00
	lspUFN _ (lspUFN) or (340c), goto[ufnLBL];			* 01
	lspUFN _ (lspUFN) or (360c), goto[ufnLBL];			* 10
	lspUFN _ (lspUFN) or (320c), goto[ufnLBL];			* 11

% Dispatches are set as follows:

op	  code	disp			op	  code	disp
IPLUS2    330	0			LOGOR	  344	1
 PLUS2    324	0
IDIFFRNCE 331	4			LOGAND	  345	5
 DIFFRNCE 325	4
ITIMES    332	10			LOGXOR	  346	11
 TIMES    326	10
IQUOTIENT 333	14			 ---		15
 QUOTIENT 327	14

BOXIPLUS  366	2			 ---		3

IGREATERP 361	6			 ---		7
 GREATERP 363	6
BOXIDIFF  367	12			IREMAINDER 334	13

 ---		16			 ---		17
%
	:END[Arith];