DIRECTORY
DragOpsCross USING [XopBase, TrapBase, TrapWidthBytes, bytesPerWord, TrapIndex, Word],
--XopBase, TrapBase, TrapWidthBytes, Inst, wordsPerPage, bytesPerWord, charsPerWord, bitsPerByte, bitsPerCharacter, bitsPerWord, logWordsPerPage, logBitsPerByte, logBitsPerChar, logBytesPerWord, logCharsPerWord, logBitsPerWord, logBytesPerPage, PageCount, PageNumber, maxPagesInVM, SixBitIndex, FiveBitIndex, Word, TwoWords, FourBitIndex, Half, ThreeBitIndex, FourHalves, TwoHalves, Byte, ZerosByte, OnesByte, EightBytes, FourBytes, ByteIndex, BytesPerWord, TwoBytes, Comparison, ByteAddress, WordAddress, FieldDescriptor, TrapWidthWords, KernalLimit, TrapIndex, StackUnderflowTrap, IFUPageFaultTrap, ResetTrap, IFUStackOverflowTrap, EUStackOverflowTrap, RescheduleTrap, ALUCondOver, ALUCondBC, ALUCondIL, ALUCondDO, EUPageFault, EUWriteFault, AUFault, euStack, euJunk, euMAR, euField, euConstant, euAux, euBogus, euLast, ifuXBus, ifuStatus, ifuSLimit, ifuYoungestL, ifuYoungestPC, ifuEldestL, ifuEldestPC, ifuBogus, ifuL, ifuS, ifuPC, ifuLast, IFUStatusRec, IFUStackIndex, IFUStackSize, IFUOverflow, EUStackIndex, EUStackSize, EULocalIndex, EULocals, EUAuxIndex, EUAuxRegs, EUConstIndex, EUConstants, IOLocation, ioRescheduleRequest, ioResetRequest
DragOpsCrossUtils USING [IntToWord],
--BytePCToWordAddress, WordAddressToBytePC, IOOperandToCard, CardToIOOperand, FieldDescriptorToCard, CardToFieldDescriptor, StatusToWord, WordToStatus, BytesToWord, BytesToHalf, WordToBytes, HalfToBytes, HalvesToWord, WordToHalves, HighHalf, LowHalf, LeftHalf, RightHalf, SwapHalves, WordToInt, IntToWord, WordToCard, HalfToCard, ByteToCard, CardToWord, CardToHalf, CardToByte, DragAnd, DragOr, DragXor, DragNot, VanillaAdd, VanillaSub, AddDelta, HalfNot, HalfAnd, HalfOr, HalfXor, HalfShift, DoubleWordShiftLeft, SingleWordShiftLeft, SingleWordShiftRight, TrapIndexToBytePC, XopToBytePC
HandCoding,	--Has opcode and register defs.
HandCodingPseudos,	--GenLabel, GenLabelHere, SetLabel, Halt, Pause, MakeLabelGlobal, UseLabel8B, UseLabel16, UseLabel32, ProcedureEntry, ProcedureExit, EnableTraps, IndexedJump, SetupField, ExtractField, ShiftLeft, LoadProcessorReg, StoreProcessorReg, DisableTraps, CauseReschedule, CauseReset, GetSPLimit, SetSPLimit, GetL, SetL, GetYoungestPC, GetYoungestL, GetEldestPC, GetEldestL, SetYoungestPC, SetYoungestL, SetEldestPC, SetEldestL
HandCodingSupport;	--Area, GetCurrentArea, ReserveData, SetOutputPC, GetProc, PutProc, ProcList, NewArea, GenWithArea, Gen1WithArea, ForceOut, GetOutputPC, WordAlign, OutputByte, OutputOneByte, OutputAlphaBeta, OutputAlphaBetaGammaDelta, OutputWord

GenLisp: CEDAR PROGRAM
IMPORTS DragOpsCrossUtils, HandCoding, HandCodingPseudos, HandCodingSupport
= BEGIN OPEN DragOpsCrossUtils, HandCoding, HandCodingPseudos, HandCodingSupport;

Word: TYPE = DragOpsCross.Word;

aux0: AuxRegSpec = [aux[0]];
aux1: AuxRegSpec = [aux[1]];
aux2: AuxRegSpec = [aux[2]];
aux3: AuxRegSpec = [aux[3]];
aux4: AuxRegSpec = [aux[4]];
aux5: AuxRegSpec = [aux[5]];
aux6: AuxRegSpec = [aux[6]];
aux14: AuxRegSpec = [aux[14]];
aux15: AuxRegSpec = [aux[15]];
const5: ConstSpec = [const[5]];
const6: ConstSpec = [const[6]];
const7: ConstSpec = [const[7]];
const8: ConstSpec = [const[8]];
const9: ConstSpec = [const[9]];
const10: ConstSpec = [const[10]];
const11: ConstSpec = [const[11]];

LMaxNum: INT =  3777777777B;
LMinNum: INT = -4000000000B;

All: PROC = {

FillXop: PROC [inst: CARDINAL, dest: Label] = {
SetOutputPC[inst * DragOpsCross.TrapWidthBytes + DragOpsCross.XopBase * DragOpsCross.bytesPerWord];
drJDB[UseLabel16[dest]];
};

FillTrap: PROC [tx: DragOpsCross.TrapIndex, dest: Label] = {
SetOutputPC[LOOPHOLE[tx, CARDINAL] * DragOpsCross.TrapWidthBytes + DragOpsCross.TrapBase * DragOpsCross.bytesPerWord];
drJDB[UseLabel16[dest]];
};

area: Area = GetCurrentArea[];
savePC: LONG CARDINAL;

start: Label = GenLabel[];
dummy: Label = GenLabel[];
IllegalLispNum: Label = GenLabel[];
LNaNUnexpected: Label = GenLabel[];

enterRLADDTest: Label = GenLabel[];
enterRLSUBTest: Label = GenLabel[];



GenRLADD: PROC = {
RLADDTest: PROC [a, b: INT] ~ {
ax: Word _ IntToWord[a];
bx: Word _ IntToWord[b];
apb: INT _ a + b;
IF a > LMaxNum OR a < LMinNum OR b > LMaxNum OR b < LMinNum OR apb > LMaxNum OR apb < LMinNum THEN {
rlaOK: Label = GenLabel[];
rlaBad: Label = GenLabel[];
drROR[const3, const2, const2];	--Indicate NaN trap expected
drLIQB[bx]; drLIQB[ax];
drRLADD[topDst, reg1, reg0];
Pause[];
drQLADD[pushAtop, reg0];
Pause[]; Pause[];
drLADD[];
Pause[]; Pause[]; Pause[];
drLIQB[ax]; drRJEBJ[popSrc, belowSrcPop, UseLabel8B[rlaOK]]; SetLabel[rlaBad]; Pause[]; SetLabel[rlaOK];
drLIQB[bx]; drRJNEB[popSrc, belowSrcPop, UseLabel8B[rlaBad]];
}
ELSE {
rlaOK: Label = GenLabel[];
rlaBad: Label = GenLabel[];
apbx: Word _ IntToWord[apb];
drROR[const3, const0, const0];	--Indicate no NaN trap expected
drLIQB[bx]; drLIQB[ax];
drQLADD[pushAtop, reg0];
drRLADD[pushDst, reg1, reg0];
drLIQB[apbx]; drRJEBJ[popSrc, belowSrc, UseLabel8B[rlaOK]];
SetLabel[rlaBad]; Pause[];
SetLabel[rlaOK];
drRJNEB[popSrc, belowSrcPop, UseLabel8B[rlaBad]];
drLADD[]; drLIQB[apbx]; drRJNEB[popSrc, belowSrcPop, UseLabel8B[rlaBad]];
drRUADD[pushDst, const0, const0];
drJNEBB[0, UseLabel8B[rlaBad]];
};
};

SetLabel[enterRLADDTest];
RLADDTest[           1B, LMaxNum];	--Just barely overflows
RLADDTest[ LMaxNum,          1B];
RLADDTest[          0B, LMinNum];	--Just barely doesn't underflow
RLADDTest[ LMinNum,          0B];
RLADDTest[           0B, LMaxNum];	--Just barely doesn't overflow
RLADDTest[ LMaxNum,          0B];
RLADDTest[         -1B, LMinNum];	--Just barely underflows
RLADDTest[ LMinNum,         -1B];

RLADDTest[0, 0];		--Other misc. test values
drRUADD[const4, const2, const2];
RLADDTest[ 1252525252B, -1515151515B];
drRUADD[const4, const2, const2];
RLADDTest[-1000000000B, -1000000000B];
drRUADD[const4, const2, const2];
RLADDTest[ LMinNum,  LMaxNum];
RLADDTest[ LMaxNum, LMinNum];
RLADDTest[  777777777B,  1000000000B];
RLADDTest[ 1000000000B,   777777777B];
};

GenRLSUB: PROC = {
RLSUBTest: PROC [a, b: INT] ~ {
ax: Word _ IntToWord[a];
bx: Word _ IntToWord[b];
amb: INT _ a - b;
IF a > LMaxNum OR a < LMinNum OR b > LMaxNum OR b < LMinNum OR amb > LMaxNum OR amb < LMinNum THEN {
rlsOK: Label = GenLabel[];
rlsBad: Label = GenLabel[];
drROR[const3, const2, const2];	--Indicate NaN trap expected
drLIQB[bx]; drLIQB[ax];
drQLSUB[pushAtop, reg0];
Pause[]; Pause[];
drRLSUB[topDst, reg1, reg0];
Pause[];
drEXDIS[]; drLIQB[bx];	--Reverse the args
drLSUB[];
Pause[]; Pause[]; Pause[];
drLIQB[bx]; drRJEBJ[popSrc, belowSrcPop, UseLabel8B[rlsOK]]; SetLabel[rlsBad]; Pause[]; SetLabel[rlsOK];
drLIQB[ax]; drRJNEB[popSrc, belowSrcPop, UseLabel8B[rlsBad]];
}
ELSE {
rlsOK: Label = GenLabel[];
rlsBad: Label = GenLabel[];
ambx: Word _ IntToWord[amb];
drROR[const3, const0, const0];	--Indicate no NaN trap expected
drLIQB[bx]; drLIQB[ax];
drQLSUB[pushAtop, reg0];
drRLSUB[pushDst, reg1, reg0];
drLIQB[ambx]; drRJEBJ[popSrc, belowSrc, UseLabel8B[rlsOK]];
SetLabel[rlsBad]; Pause[];
SetLabel[rlsOK];
drRJNEB[popSrc, belowSrcPop, UseLabel8B[rlsBad]];
drEXDIS[]; drLIQB[bx];	--Reverse the args
drLSUB[];
drLIQB[ambx]; drRJNEB[popSrc, belowSrcPop, UseLabel8B[rlsBad]];
drRUADD[pushDst, const0, const0];
drJNEBB[0, UseLabel8B[rlsBad]];
};
};

SetLabel[enterRLSUBTest];
RLSUBTest[           1B, -LMaxNum];	--Just barely overflows
RLSUBTest[ LMaxNum,         -1B];

RLSUBTest[          -1B, -1-LMinNum];	--Just barely doesn't underflow
RLSUBTest[ LMinNum,          0B];

RLSUBTest[           0B, -LMaxNum];	--Just barely doesn't overflow
RLSUBTest[ -LMaxNum,          0B];

RLSUBTest[        -2B, -1-LMinNum];	--Just barely underflows
RLSUBTest[ LMinNum,          1B];

RLSUBTest[0, 0];		--Other misc. test values
drRUADD[const4, const2, const2];
RLSUBTest[ 1252525252B, 1515151515B];
drRUADD[const4, const2, const2];
RLSUBTest[-1000000000B, -1000000000B];
drRUADD[const4, const2, const2];
RLSUBTest[ LMinNum, -LMaxNum];
RLSUBTest[ LMaxNum, -1-LMinNum];
RLSUBTest[  777777777B,  1000000000B];
RLSUBTest[ 1000000000B,   777777777B];
};

WordAlign[area];
SetLabel[dummy];
Pause[]; Pause[]; Pause[]; Pause[]; Pause[]; Halt[123B];

WordAlign[area]; SetLabel[IllegalLispNum];
drALS[0];  --ALS[1 - nargs], where nargs includes 1 for IFUstatus
drLC3[];
drRJNEB[popSrc, const2, UseLabel8B[LNaNUnexpected]];
GetYoungestPC[];
drRVADD[topDst, topSrc, const6];
SetYoungestPC[];	--Advance return PC by 4
drRETK[377B];  --RETK[nResults - 1]
SetLabel[LNaNUnexpected]; Pause[];
savePC _ GetOutputPC[area];
FillTrap[ResetTrap, start];
FillTrap[ALUCondIL, IllegalLispNum];
FillXop[0, dummy];
FillXop[377B, dummy];
SetOutputPC[savePC];

SetLabel[start];

drASL[255];
drLIQB[IntToWord[-1]];
drROR[const2, topSrc, popSrc];	--Put -1 in const2.
drLIB[4];
drROR[const6, topSrc, popSrc];	--Put 4 in const6 for NaN trap

GenRLADD[];
GenRLSUB[];

Halt[177777B];	--Terminate here at the end of the program
};


END.


(GenLisp.mesa
Copyright c 1984, 1985 by Xerox Corporation.  All rights reserved.
Edward Fiala February 7, 1986 5:13:45 pm PST

This diagnostic tests the arithmetic opcodes RLADD, RLSUB, LADD, LSUB, QLADD, and QLSUB.  When correctly executed it terminates with a HALT[177777b] at PC = 4014701B on instruction 576 cycle 989.

In this diagnostic, the auxiliary registers are called aux0, aux1, ..., aux15; the locals are called reg0, reg1, ..., reg15; and the constants are called const0, const1, ..., const15.
The Xop trap locations assigned to each opcode are at at opcode*TrapWidthBytes + xopBase*bytesPerWord = 4,000,000B + 20B * opcode, and the trap location assigned to each trap are at TrapIndex*TrapWidthBytes + TrapBase*bytesPerWord = 4,002,000B + 20B * TrapIndex.  The TrapIndex definitions are in DragOpsCross.
Lisp arithmetic: The Carry is not used as an input, and is always set to 0.  If either operand or the result is not in the range [LMinNum..LMaxNum], a Lisp NaN (Not a Number) trap is taken.
This procedure generates tests RLADD, QLADD, and LADD.
A Lisp NaN trap will abort the RLADD, and the trap subroutine will skip over the Pause[] below.
Verify that the registers weren't disturbed.
No Lisp NaN trap should occur; check the result.
Verify that Carry = 0 after a Lisp arithmetic operation.
Set Carry = 1 to verify it has no effect and to test that Carry = 0 after a Lisp arithmetic operation.
This procedure tests RLSUB, QLSUB, and LSUB.
A Lisp NaN trap will abort the RLADD, and the trap subroutine will skip over the Pause[] below.
Verify that the registers weren't disturbed.
No Lisp NaN trap should occur; check the result.
Verify that Carry = 0 after a Lisp arithmetic operation.
Set Carry = 1 to verify it has no effect and to test that Carry = 0 after a Lisp arithmetic operation.
Arrive here with the YoungestPC pointing at an opcode which experienced a Lisp NaN trap; this trap is always enabled, so no special enabling or disabling action is necessary.  Unless const3 = -1 do a Pause[] (Lisp NaN not expected); otherwise, increment the PC by 4 and return.
Advance the PC by 4 without smashing or using Carry (so use RVADD instead of ADDB).
An enableable trap would push IFU status and exit with RETK[nResults - 1].

Opcodes 0 and 377B are intercepted by the simulator, but make them trap to dummy here anyway.
Simulator execution begins here on a Reset.
const0 is in a ROM, so it requires no initialization; const2 is initialized to -1 here; the other constants require no initialization for this diagnostic.
When there is nothing on the stack, S should be at L-1
Κ’–81.25 in leftMargin 1.25 in rightMargin 6.0 in lineLength˜
codeš
œ™Kšœ
Οm
œ7™BK™,K™Kš
œΓ
™Γ
K™—š
Οk	˜	Kšœ
žœEΟcύ˜Τ	KšœžœŸΛ˜πKšœŸ˜+KšœŸ’˜΅KšœŸε
˜ψ
K˜—šœ	žœ
ž˜KšžœD˜KKšœžœ
žœE˜QK˜K–20 sp tabStopsšœžœ˜K–20 sp tabStops˜K–40 sp tabStopsš
œ·
™·
K–40 sp tabStopsš
œ˜K–40 sp tabStopsš
œ˜K–40 sp tabStopsš
œ˜K–40 sp tabStopsš
œ˜K–40 sp tabStopsš
œ˜K–40 sp tabStopsš
œ˜K–40 sp tabStopsš
œ˜K–40 sp tabStopsš
œ˜K–40 sp tabStopsš
œ˜K–40 sp tabStops˜K–40 sp tabStops˜K–40 sp tabStops˜K–40 sp tabStops˜K–40 sp tabStops˜K–40 sp tabStops˜!K–40 sp tabStops˜!K–40 sp tabStops˜K–40 sp tabStopsšœ	žœ˜K–40 sp tabStopsšœ	žœ˜K–20 sp tabStops˜šΟnœžœ˜
K˜Kš
œΆ™Άš œžœžœ˜/Kš
œc˜cKš
œ˜K˜K˜—š œžœ.˜<KšœžœžœU˜vKš
œ˜K˜—K˜Kš
œ˜Kšœžœ
žœ
˜K˜K˜K˜K˜#K˜#K˜K˜#K˜#K˜K˜Kš
œ½
™½
K˜Kš
œ6™6š œžœ˜š 	œžœžœ˜J˜J˜Kšœžœ	˜šžœ
žœ
žœ
žœ
žœžœžœ˜dKš
œ_™_K˜K˜KšœŸ˜;Kš
œ˜Kš
œ˜K˜K˜K˜K˜	K˜Kš
œ,™,K˜hK˜=K˜
—šžœ˜Kš
œ0™0K˜K˜K˜KšœŸ˜>Kš
œ˜K˜Kš
œ˜K˜;K˜K˜K˜1K˜IKš
œ8™8K˜!K˜K˜—K˜—K˜K˜Kšœ#Ÿ˜:K˜!Kšœ"Ÿ˜AK˜!Kšœ#Ÿ˜AK˜!Kšœ"Ÿ˜:K˜!K˜KšœŸ˜+Kš
œf™fKš
œ ˜ K˜&Kš
œ ˜ K˜&Kš
œ ˜ K˜K˜Kš
œ&˜&K˜&K˜—K˜Kš
œ,™,š œžœ˜š 	œžœžœ˜J˜J˜Kšœžœ	˜šžœ
žœ
žœ
žœ
žœžœžœ˜dKš
œ_™_K˜K˜KšœŸ˜;Kš
œ˜Kš
œ˜Kš
œ˜Kš
œ˜K˜KšœŸ˜)K˜	K˜Kš
œ,™,K˜hK˜=K˜
—šžœ˜Kš
œ0™0K˜K˜K˜KšœŸ˜>Kš
œ˜Kš
œ˜Kš
œ˜K˜;K˜K˜K˜1KšœŸ˜)K˜	K˜?Kš
œ8™8K˜!K˜K˜—K˜—K˜K˜Kšœ$Ÿ˜;K˜!K˜Kšœ&Ÿ˜EK˜!K˜Kšœ$Ÿ˜BK˜"K˜Kšœ$Ÿ˜<K˜!K˜KšœŸ˜+Kš
œf™fKš
œ ˜ K˜%Kš
œ ˜ K˜&Kš
œ ˜ K˜K˜ Kš
œ&˜&K˜&K˜—K˜K˜J˜J˜8J˜Kš
œ•™•K˜*KšœŸ6˜AK˜K˜4Kš
œS™SKš
œ˜Kš
œ ˜ KšœŸ˜)KšœŸ˜#K˜"Kš
œJ™JK™Kš
œ]™]Kš
œ˜Kš
œ˜K˜$K˜Kš
œ˜Kš
œ˜K˜Kš
œ+™+K˜K˜Kš
œš
™š
˜Kš
œ6™6—K˜KšœŸ˜2K˜	KšœŸ˜=K˜Jš
œ˜Jš
œ˜J˜JšœŸ*˜9˜K˜——K˜Kšžœ
˜—K˜—…—"ΐ4Š