DIRECTORY
Basics USING [DoubleShiftLeft],
DragOpsCross USING [Word, XopBase, TrapBase, TrapWidthBytes, bytesPerWord, TrapIndex],
--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 [CardToWord],
--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
GenSFCI:
CEDAR
PROGRAM
IMPORTS Basics, DragOpsCrossUtils, HandCoding, HandCodingPseudos, HandCodingSupport
= BEGIN OPEN DragOpsCrossUtils, HandCoding, HandCodingPseudos, HandCodingSupport;
Word: TYPE = DragOpsCross.Word;
All:
PROC = {
Xops trap at opcode*TrapWidthBytes + xopBase*bytesPerWord = 4,000,000B + 20B * opcode.
FillXop:
PROC [inst:
CARDINAL, dest: Label] = {
SetOutputPC[inst * DragOpsCross.TrapWidthBytes + DragOpsCross.XopBase * DragOpsCross.bytesPerWord];
drJDB[UseLabel16[dest]];
};
A trap's location is TrapIndex*TrapWidthBytes + TrapBase*bytesPerWord =
4,002,000B + 20B * TrapIndex. TrapIndex definitions are in DragOpsCross.
FillTrap:
PROC [tx: DragOpsCross.TrapIndex, dest: Label] = {
SetOutputPC[LOOPHOLE[tx, CARDINAL] * DragOpsCross.TrapWidthBytes + DragOpsCross.TrapBase * DragOpsCross.bytesPerWord];
drJDB[UseLabel16[dest]];
};
Lizard requires that all storage touched by a program be declared in advance. This procedure declares a word that will be touched and initializes its value.
InitializeWord:
PROC [pc, value:
CARD] = {
oldPC: LONG CARDINAL = GetOutputPC[area];
bytePC: LONG CARDINAL ← Basics.DoubleShiftLeft[[lc[pc]], 2].lc;
SetOutputPC[bytePC]; --pc is a byte address
OutputWord[area, CardToWord[value], FALSE];
SetOutputPC[oldPC];
};
area: Area = GetCurrentArea[];
oldPC: LONG CARDINAL;
start: Label = GenLabel[];
dummy: Label = GenLabel[];
initL: Label = GenLabel[];
enterSFCITest: Label = GenLabel[];
GenSFCI:
PROC = {
DoSFCI initializes memLoc to hold a PC, pushes memLoc onto the stack, executes an SFCI opcode, and changes the PC to be the destination PC. Each call to DoSFCI will push another memLoc onto the stack; later accumulated stack values are checked and popped. When a RETN is eventually executed, ADDB[1] at each SFCI return point count to verify that control really passed through the different procedure return points.
DoSFCI:
PROC [destPC, memLoc:
LONG
CARDINAL] ~ {
InitializeWord[memLoc, destPC];
drLIQB[CardToWord[memLoc]];
drSFCI[];
drADDB[1];
drRETN[];
SetOutputPC[destPC];
};
enterSFCITestPC: LONG CARDINAL = 4000B;
endTestPC: LONG CARDINAL = 6000B;
okSFCI: Label = GenLabel[];
okStk: Label = GenLabel[];
badStk: Label = GenLabel[];
endTest: Label = GenLabel[];
exitTest: Label = GenLabel[];
drJQB[UseLabel32[enterSFCITest]];
SetOutputPC[enterSFCITestPC];
SetLabel[enterSFCITest];
Exercise every bit position of the pc address; must avoid the vector for Xops and Traps between byte positions 4000000B and 4004000B.
drLIB[0]; --Counter used to verify that the calls and returns have occurred.
InitializeWord[2777B, 400100B];
drLIQB[CardToWord[2777B]];
drSFCI[];
drJEBBJ[16B, UseLabel8B[okSFCI]]; Pause[]; SetLabel[okSFCI];
drJQB[UseLabel32[exitTest]];
SetOutputPC[400100B];
DoSFCI[ 1000200B, 3000B]; --SFCI does push 3000B, [s] = 16B after the RETN
DoSFCI[ 2000400B, 3001B]; --SFCI does push 3001B, [s] = 15B after the RETN
DoSFCI[ 4010000B, 3002B]; --SFCI does push 3002B, [s] = 14B after the RETN
DoSFCI[ 10002000B, 3003B]; --SFCI does push 3003B, [s] = 13B after the RETN
DoSFCI[ 20004001B, 3004B]; --SFCI does push 3004B, [s] = 12B after the RETN
DoSFCI[ 40001002B, 3005B]; --SFCI does push 3005B, [s] = 11B after the RETN
DoSFCI[ 100020004B, 3006B]; --SFCI does push 3006B, [s] = 10B after the RETN
DoSFCI[ 200040010B, 3007B]; --SFCI does push 3007B, [s] = 07B after the RETN
DoSFCI[ 400100020B, 3010B]; --SFCI does push 3010B, [s] = 06B after the RETN
DoSFCI[ 1000000000B, 3011B]; --SFCI does push 3011B, [s] = 05B after the RETN
DoSFCI[ 2000000000B, 3012B]; --SFCI does push 3012B, [s] = 04B after the RETN
DoSFCI[20000200040B, 3013B]; --SFCI does push 3013B, [s] = 03B after the RETN
DoSFCI[10000000000B, 3014B]; --SFCI does push 3014B, [s] = 02B after the RETN
DoSFCI[ 4000000000B, 3015B]; --SFCI does push 3015B, [s] = 01B after the RETN
A Lizard bug prevents defining Labels at addresses with the high-order bit = 1.
drJQB[UseLabel32[endTest]];
SetOutputPC[endTestPC];
SetLabel[endTest];
drLIQB[CardToWord[3015B]];
drRJEBJ[popSrc, belowSrcPop, UseLabel8B[okStk]];
SetLabel[badStk]; Pause[]; SetLabel[okStk];
drLIQB[CardToWord[3014B]]; drRJNEB[popSrc, belowSrcPop, UseLabel8B[badStk]];
drLIQB[CardToWord[3013B]]; drRJNEB[popSrc, belowSrcPop, UseLabel8B[badStk]];
drLIQB[CardToWord[3012B]]; drRJNEB[popSrc, belowSrcPop, UseLabel8B[badStk]];
drLIQB[CardToWord[3011B]]; drRJNEB[popSrc, belowSrcPop, UseLabel8B[badStk]];
drLIQB[CardToWord[3010B]]; drRJNEB[popSrc, belowSrcPop, UseLabel8B[badStk]];
drLIQB[CardToWord[3007B]]; drRJNEB[popSrc, belowSrcPop, UseLabel8B[badStk]];
drLIQB[CardToWord[3006B]]; drRJNEB[popSrc, belowSrcPop, UseLabel8B[badStk]];
drLIQB[CardToWord[3005B]]; drRJNEB[popSrc, belowSrcPop, UseLabel8B[badStk]];
drLIQB[CardToWord[3004B]]; drRJNEB[popSrc, belowSrcPop, UseLabel8B[badStk]];
drLIQB[CardToWord[3003B]]; drRJNEB[popSrc, belowSrcPop, UseLabel8B[badStk]];
drLIQB[CardToWord[3002B]]; drRJNEB[popSrc, belowSrcPop, UseLabel8B[badStk]];
drLIQB[CardToWord[3001B]]; drRJNEB[popSrc, belowSrcPop, UseLabel8B[badStk]];
drLIQB[CardToWord[3000B]]; drRJNEB[popSrc, belowSrcPop, UseLabel8B[badStk]];
drLIQB[CardToWord[2777B]]; drRJNEB[popSrc, belowSrcPop, UseLabel8B[badStk]];
drRETN[];
SetLabel[exitTest];
};
SetLabel[dummy];
Pause[]; Pause[]; Pause[]; Pause[]; Pause[]; Halt[123B];
Opcodes 0 and 377B are intercepted by the simulator, but make them trap to dummy here anyway.
oldPC ← GetOutputPC[area];
FillTrap[ResetTrap, start];
FillXop[0, dummy]; --opcode 0 = Pause[]
FillXop[377B, dummy]; --opcode 377B = Halt[xxx]
SetOutputPC[oldPC];
ProcedureEntry[initL, 0];
drLIB[1];
SetYoungestL[]; -- L ← 1 on return
spLimit is set with room for 17 overflow words (just in case).
--drLIB[128-16-1];
--SetSPLimit[];
ProcedureExit[0];
WordAlign[area];
Simulator execution begins here on a Reset.
SetLabel[start];
drJQB[UseLabel32[enterSFCITest]];
drLFC[UseLabel16[initL]]; --Initialize L to 1
drASL[255]; --and S to 0.
GenSFCI[];
Halt[177777B]; --Terminate here at the end of the program
END.