{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;
Xbus ← TT LRot12, XDisp, c2;
uChain ← Rx, DISP4[ArithTypDisp, 3], c3;
MAR ← Q ← [Rx, TT + 0], c1, at[03,10,ArithTypDisp];
Rx ← Q, rhRx ← MDSTYPEspaceReal, c2;
Rx ← Rx LRot8, L1 ← L1.fixFV, c3;
Rx ← Rx RShift1, SE←1, 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;
GOTO[ufnZ2], c1, at[07,10,ArithTypDisp];
GOTO[ufnZ2], c1, at[0B,10,ArithTypDisp];
GOTO[ufnZ2], c1, at[0F,10,ArithTypDisp];
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, c2;{result not smallPos}
uTOSH ← TOSH, c3;
{setup exit through CREATECELL }
uNewValLo ← ~Q, L1 ← L1.fixFV, c1;
uNewValHi ← Rx, L3 ← L3.FptArg1, c2;
Q ← LS4FixpType, GOTO[CCSubr], c3;
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 }