(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "10-Nov-87 16:17:44" {PHYLUM}<CTAMARIN>EMULATOR>EMULATORSUPPORT.;84 46695
changes to%: (FNS MakeCondALst AG)
previous date%: " 4-Nov-87 12:45:28" {PHYLUM}<CTAMARIN>EMULATOR>EMULATORSUPPORT.;82)
(* "
Copyright (c) 1986, 1987 by Xerox Corporation. All rights reserved.
")
(PRETTYCOMPRINT EMULATORSUPPORTCOMS)
(RPAQQ EMULATORSUPPORTCOMS
((* * INIT)
(FNS InitEmulator ExpandBitsMacro InitStackFrames CycleSetup CycleCheck DrawClockPoints
StartDrawClocks MonitorState)
(* * Staus reporting)
(FNS PrintInstStart DoTest)
(* * Tamarin structure representation)
(FNS ZZZ AV AG MakeWord MemoryAccess PrintData PrintMem StoreTamByte)
(* * Logic Functions)
(FNS Decoder ConcatBitsFn ConcatBitsVal EvalEltFn EvalEltSim Mod4 Mod8 PrintBits
PrintExpandBits ModCCodeRec MakeCondALst)
(* * Macros)
(FUNCTIONS Mux-1 Mux-2 Mux-3 Mux-4 SetIBuf LAND LOR LCMP LEQV LNOT LXOR LNOR LNAND TF OZ
ConcatBits EvalElt WithRadix)
(FNS EvaluatePlaMacro MuxBreak DisplayReg RegGet RegSet)
(* ;;; "PLA Functions & Macros")
(FNS MakePlaSpec FixPlaNames FixPlaTerms)
(FUNCTIONS EvaluatePla ExpandBits)
(VARS sigList)))
(* * INIT)
(DEFINEQ
(InitEmulator
[LAMBDA (ReInitial) (* ; "Edited 24-Jul-87 17:57 by krivacic")
[for i in InitGVarLst do (SET i 0)
(if (AND (NEQ i 'X)
(NOT (MEMB i GLOBALVARS)))
then (SETQ GLOBALVARS (CONS i GLOBALVARS]
(for i in InitVarLst do (SET i 0))
(for i in '(↑ + - * $ %# @ < > %: = /) do (CLDISABLE i))
(SETQ STACK-FRAME-MAX 39)
(SETQ IBufReg (ARRAY 8 'POINTER 0 0))
(SETQ RegFile (ARRAY (TIMES 7 64)
'POINTER 0 0))
(SETQ PcRegFile (ARRAY 8 'POINTER 0 0))
(SETQ TosWords (ARRAY 8 'POINTER 0 0))
(SETQ MemoryArray (ARRAY 32768 'POINTER 0 0))
(SETQ MemoryTagArray (ARRAY 32768 'BYTE 0 0))
(SETQ VMCmpArray (ARRAY 8 'POINTER 0 0))
(SETQ VMResArray (ARRAY 8 'POINTER 0 0))
(SETQ KOpcodeStart 128)
(SETQ Maxop 128)
(SETQ Debugging NIL)
(SETQ SimLog NIL)
(SETQ RefreshAfter 500)
(SETQ DoSimLog T)
(ClearMemoryArray)
(MakeCondCodeArray)
(SetBusSizes)
(MakeRamCtlPla)
(MakeMemCtlPla)
(if (NOT ReInitial)
then (InitEmulatorWindow])
(ExpandBitsMacro
[LAMBDA (xx) (* agb%: " 4-Jun-86 09:18")
(if (NEQ (CAAR xx)
'QUOTE)
then 'IGNOREMACRO
else `(PROGN %,@ (FOR i in (CADAR xx) COLLECT `(SETQ %, (CAR i)
(LOADBYTE %, (CADR xx)
%,
(CADR i)
%,
(CADDR i])
(InitStackFrames
[LAMBDA (number) (* ; "Edited 23-Oct-87 17:30 by Krivacic")
(SETQ FreeMemIndex (AddressAdjust FreeMemIndex 32))
(PROG [(Next (TamRep 'NIL]
(for i from 1 to number do (SETQ Next (AddMemFrame Next)))
(RETURN Next])
(CycleSetup
[LAMBDA (startrunning) (* ; "Edited 29-Oct-87 10:18 by Krivacic")
(* if log then (SETQ SimLog
(OPENFILE log (QUOTE OUTPUT))) else
(SETQ SimLog NIL))
(DECLARE (GLOBALVARS *LASTVECTORSECTION* *LASTSECTION* *OPCODE-TRACE* FnCount FrameDumps))
(SETQ *OPCODE-TRACE* NIL)
(SETQ MIR
(create MI
NewTos ← 0
NewArg ← 0
NewArg2 ← 0
Done ← 1
OpLength ← 0
Raddr ← 1))
(SETQ NilMir MIR)
(SETQ SAVEMIR MIR)
(SETQ oldX 100)
(SETQ FnCount 0)
(SETQ FrameDumps 0)
(setall 0)
(queueall)
(SetVal NilMir MI)
(SetVal NilMir MIL)
(SetVal 0 IRQ1)
(SetVal 0 IRQ2)
(SetVal 0 HOLD)
(SetVal 0 REFRESH)
(SetVal 0 RESET)
(StartDrawClocks)
(CLEARW logWindow)
(CLEARW (WINDOWPROP TS.MAINWINDOW 'TRACEWINDOW))
(SETQ TRACESTR NIL) (* PRINT CurrentOpList SimLog)
(WINDOWPROP TS.MAINWINDOW 'CURRENTDISPFRAME 0)
(WINDOWPROP TS.MAINWINDOW 'CURRENTEXECFRAME 0)
[WINDOWPROP TS.MAINWINDOW 'FLAGS (UNION (if startrunning
then '(Go)
else '(UcodeStep))
(LDIFFERENCE (WINDOWPROP TS.MAINWINDOW 'FLAGS)
'(Stopping CycleStep UcodeStep OpcodeStep Exit]
(TS.SETFLAGS)
(TS.FRAMESELECT (WINDOWPROP TS.MAINWINDOW 'FRAMEMENU)
"Frame 0" 0)
(SETQ TamEmulator T)
(SETQ Refreshes 0)
(SETQ RefreshCount 0)
(SETQ Cycles 0)
(SETQ ResetCycle 0)
(SETQ ErrorCycles 0)
(SETQ ErrorCount 0)
(SETQ Reset 0)
(SETQ Hold 0)
(SETQ Irq1 1)
(SETQ Irq2 1)
(SETQ Refresh 0)
(SETQ ExternalStall 0)
(TS.MAINMENUSELECTEDFN 'Reset (WINDOWPROP TS.MAINWINDOW 'MENU3))
(TS.MAINMENUSELECTEDFN 'Irq1 (WINDOWPROP TS.MAINWINDOW 'MENU3))
(TS.MAINMENUSELECTEDFN 'Irq2 (WINDOWPROP TS.MAINWINDOW 'MENU3))
[LET (x)
(for i in '(Stop FRaidStop) when [NOT (FMEMB i (SETQ x (WINDOWPROP TS.MAINWINDOW
'BREAKPOINTS]
do (WINDOWPROP TS.MAINWINDOW 'BREAKPOINTS (CONS i x]
(for i from 0 to (SUB1 (ARRAYSIZE RegFile)) do (SETA RegFile i 0))
(for i from 0 to (SUB1 (ARRAYSIZE VMCmpArray)) do (SETA VMResArray i 0)
(SETA VMCmpArray i 0))
(if (EQ *LASTVECTORSECTION* 'WholeChip)
then (SetupChipVectors])
(CycleCheck
[LAMBDA (clockcycle) (* ; "Edited 13-Oct-87 18:48 by Krivacic")
[if (EQ clockcycle 4)
then (SETQ Cycles (ADD1 Cycles))
(if (TF Reset)
then (SETQ ResetCycle (ADD1 ResetCycle))
(if (GREATERP ResetCycle 3)
then (TS.MAINMENUSELECTEDFN 'Reset (WINDOWPROP TS.MAINWINDOW 'MENU3))
(SETQ Cycles 0)
(SETQ ResetCycle 0]
(if (OR (EQ 4 clockcycle)
(EQ 1 clockcycle))
then (CallPrintInstStart))
(BLOCK)
(if [OR (FMEMB 'CycleStep (WINDOWPROP TS.MAINWINDOW 'FLAGS))
(AND (EQ clockcycle 1)
(FMEMB 'UcodeStep (WINDOWPROP TS.MAINWINDOW 'FLAGS]
then (TS.MAINMENUSELECTEDFN 'Stop (WINDOWPROP TS.MAINWINDOW 'DEBUGMENU)
'LEFT))
(if (FMEMB 'Stopping (WINDOWPROP TS.MAINWINDOW 'FLAGS))
then (DispVars)
(PROG [(m (WINDOWPROP TS.MAINWINDOW 'MENU3]
(for i in (fetch (MENU ITEMS) of m) do (SET i (LNOT (EVAL i)))
(TS.MAINMENUSELECTEDFN i m)))
(SETQ TRACESTR (fetch (MI Ucode) of (fetch (WireRec value) of MIL)))
(TS.BREAKCONTROL)
elseif DoEmulatorVars
then (DispVars])
(DrawClockPoints
[LAMBDA (deltaX flg flg2) (* ; "Edited 17-Jul-87 18:15 by Krivacic")
(PROG (newVal val sWidth invalid)
(if (OR (NOT PlotWin)
(NOT sigList))
then (RETURN))
(if flg
then (if (GREATERP oldX (DIFFERENCE (WINDOWPROP PlotWin 'WIDTH)
50))
then (SETQ oldX 100))
(DSPFILL (create REGION
LEFT ← (PLUS 0 oldX)
WIDTH ← 60)
0 NIL PlotWin)
(for i from 0 to (SUB1 (LENGTH sigList))
do (DRAWLINE (PLUS oldX flg)
(PLUS 13 (TIMES i 20))
(PLUS oldX flg)
(PLUS 17 (TIMES i 20))
NIL NIL PlotWin)))
(if flg2
then (MOVETO (PLUS oldX flg 1)
2 PlotWin)
(PRINTOUT PlotWin (if (GREATERP (NCHARS flg2)
4)
then (SUBSTRING flg2 1 4)
else flg2)))
(SETQ newX (PLUS oldX deltaX))
(for i on lastPos as j on sigList as k from 0
do (SETQ sWidth 1)
(SETQ val (EvalEltSim (CAR j)))
(SETQ invalid (if (OR (NOT (NUMBERP val))
(GREATERP val 1)
(LESSP val 0))
then T
else NIL))
(SETQ newVal (LOGAND 1 val))
[SETQ oldPos (PLUS (TIMES k 20)
(TIMES 10 (CAR i]
(SETQ newPos (PLUS (TIMES k 20)
(TIMES 10 newVal)))
(if invalid
then (MOVETO oldX (TIMES k 20)
PlotWin)
(PRINTOUT PlotWin .FONT '(MODERN 8) (if (GREATERP (NCHARS val)
4)
then (SUBSTRING val 1 4)
else val))
else (if (NEQ oldPos newPos)
then (DRAWLINE oldX oldPos oldX newPos NIL NIL PlotWin))
(DRAWLINE oldX newPos newX newPos sWidth NIL PlotWin)
(RPLACA i newVal)))
(SETQ oldX newX])
(StartDrawClocks
[LAMBDA (InList) (* rtk " 5-Aug-86 19:14")
(PROG NIL
(if (OR (NOT (BOUNDP 'PlotWin))
(NOT (WINDOWP PlotWin)))
then (SETQ PlotWin NIL))
(if (OR (NOT PlotWin)
(NOT sigList))
then (RETURN))
(CLEARW PlotWin)
[SETQ lastPos (for i in sigList as k from 0 collect (MOVETO 0 (TIMES k 20)
PlotWin)
(PRINTOUT PlotWin i)
(LOGAND 1 (EvalEltSim i]
(SETQ oldX 100])
(MonitorState
[LAMBDA (flg) (* ; "Edited 5-May-87 14:36 by rtk")
(if (NOT flg)
then (DrawClockPoints 10)
else (DrawClockPoints 10 5 (fetch (MI Label) of MIR])
)
(* * Staus reporting)
(DEFINEQ
(PrintInstStart
[LAMBDA NIL (* ; "Edited 3-Nov-87 10:14 by Krivacic")
(DefSection ((Accessables (Done D1Bus D2Bus RBus MuxBus Tos RegAddr Clock Clock2 NewOpcode NextPc
uOpLength NewIBufN Mi Mil))
(Code ((DECLARE (GLOBALVARS *LASTVECTORSECTION* *LASTSECTION* *OPCODE-TRACE* FnCount
FrameDumps))
(DisplayReg 'SP (if (GREATERP Tos 0)
then (LOGAND Tos 63)
else 0))
(if [NOT (AND Mil (TYPENAMEP Mil 'MI]
then (SETQ Mil NilMir))
[if (TF Clock)
then (if (EQ (fetch (MI Label) of Mil)
'FnCall)
then (SETQ FnCount (ADD1 FnCount)))
(if (EQ (fetch (MI Label) of Mil)
'DumpFrame)
then (SETQ FrameDumps (ADD1 FrameDumps)))
(if DoSimLog
then (printout SimLog "Executing uInst: " (fetch (MI Label)
of Mil)
T))
(if DoOpcodeTrace
then (printout TS.TRACEWINDOW " uInst: "
(fetch (MI Label) of Mil)
T))
(if (FMEMB (fetch (MI Label) of Mil)
(WINDOWPROP TS.MAINWINDOW 'BREAKPOINTS))
then (TS.MAINMENUSELECTEDFN 'Stop (WINDOWPROP TS.MAINWINDOW
'DEBUGMENU)
'LEFT]
(if DoSimLog
then (PRINTOUT SimLog "D1: " (PrintData D1Bus SimLog)
" D2: "
(PrintData D2Bus SimLog)
" R: "
(PrintData RBus SimLog)
" Mux: " MuxBus " Tos: " Tos " Reg: " RegAddr T))
(if (TF (LAND (LNOT Clock)
Done))
then (SETQ *OPCODE-TRACE* (CONS (ELTX opArray NewOpcode)
*OPCODE-TRACE*))
(if DoSimLog
then (printout SimLog T "New Opcode: " NewOpcode)
(printout SimLog " Length: " uOpLength " N: " NewIBufN
" PC: " NextPc T))
(if DoOpcodeTrace
then (printout TS.TRACEWINDOW (ELTX opArray NewOpcode)
T))
(if (FMEMB (ELTX opArray NewOpcode)
(WINDOWPROP TS.MAINWINDOW 'BREAKPOINTS))
then (TS.MAINMENUSELECTEDFN 'Stop (WINDOWPROP TS.MAINWINDOW
'DEBUGMENU)
'LEFT])
(DoTest
[LAMBDA NIL (* agb "25-Sep-85 08:01")
(ERSETQ (DoCycle '{DSK}SIMLOG))
(CLOSEF '{DSK}SIMLOG)
(LISTFILES {DSK}SIMLOG])
)
(* * Tamarin structure representation)
(DEFINEQ
(ZZZ
[LAMBDA NIL (* agb%: "19-Feb-86 09:00")
NIL])
(AV
[LAMBDA (var) (* rtk "20-Nov-86 17:42")
(if var
then (if (NOT (FMEMB var InitVarLst))
then (SETQ InitVarLst (NCONC1 InitVarLst var)))
(SET var 0])
(AG
[LAMBDA (var) (* rtk "20-Nov-86 17:42")
(if var
then (if (NOT (FMEMB var InitGVarLst))
then (SETQ InitGVarLst (NCONC1 InitGVarLst var)))
(SET var 0])
(MakeWord
[LAMBDA (a b c d) (* edited%: "22-Jul-85 19:32")
(PLUS d (LLSH (PLUS c (LLSH (PLUS b (LLSH a 8))
8))
8])
(MemoryAccess
[LAMBDA (addr val quiet) (* ; "Edited 7-May-87 14:55 by rtk")
(if (AND (NOT quiet)
(NOT DoSimLog))
then (SETQ quiet T))
(PROG (MemAddr v)
[if (IGREATERP addr (MASK.1'S 0 21))
then (if (NOT quiet)
then (printout SimLog "Mem Addr reset: " addr " to " (LOGAND addr
(MASK.1'S 0 21))
T))
(SETQ addr (LOGAND addr (MASK.1'S 0 21]
(if (IGREATERP addr (ARRAYSIZE MemoryArray))
then (if (NOT quiet)
then (if val
then (printout SimLog "Mem write out of range - Adr: " addr
" Value: " (PrintData val)
T)
else (printout SimLog "Mem read out of range - Adr: " addr T)))
(RETURN 0))
(SETQ MemAddr (LOGAND 16777215 addr))
(if (NULL val)
then [SETQ v (ConcatBits '(((Eval (ELTX MemoryArray MemAddr))
0 32 0)
((Eval (ELT MemoryTagArray MemAddr))
32 8 0]
(if (NOT quiet)
then (printout SimLog "DoMemRead - Addr: " addr " Value: " (PrintData v)
T))
else [SETA MemoryArray MemAddr (ConcatBits '((val 0 32 0]
[SETA MemoryTagArray MemAddr (ConcatBits '((val 0 8 32]
(SETQ v val)
(if (NOT quiet)
then (printout SimLog "DoMemWrite - Addr: " addr " Value: " (PrintData val)
T)))
(RETURN v])
(PrintData
[LAMBDA (val window) (* ; "Edited 2-Nov-87 16:17 by Krivacic")
(if (NOT window)
then (SETQ window T))
(WithRadix 16 (PROG (tag tag2 ptrval dataval refcount (addH T))
[SETQ refcount (ConcatBits '((val 0 6 34]
[SETQ tag2 (GetTamTags (PutTamTag (GetTamTag val]
(SETQ tag (GetTamTags val))
(SETQ ptrval (GetTamPtrVal val))
(SETQ dataval (GetTamDataVal val))
[SETQ str (COND
[[OR (EQ (LOGAND tag 112)
(TamTagRep 'Ptr1))
(EQ (LOGAND tag 96)
(TamTagRep 'Ptr2]
(COND
((EQ tag (TamTagRep 'Object))
(CONCAT 'Object/ ptrval))
((EQ tag (TamTagRep 'Cons))
(CONCAT 'Cons/ ptrval))
((EQ tag (TamTagRep 'SmallCons))
(CONCAT 'SmallCons/ ptrval))
((EQ tag (TamTagRep 'Code))
(CONCAT 'Code/ ptrval))
((EQ tag (TamTagRep 'Stack))
(CONCAT 'Stack/ ptrval))
[(EQ tag (TamTagRep 'NoRcSymbol))
(COND
((EQUAL val (TamRep 'NIL))
(SETQ addH NIL)
'NIL)
((EQUAL val (TamRep 'T))
(SETQ addH NIL)
'T)
(T (CONCAT 'NoRcSym/ ptrval]
[(EQ tag (TamTagRep 'Symbol))
(COND
((EQUAL val (TamRep 'NIL))
(SETQ addH NIL)
'NIL)
((EQUAL val (TamRep 'T))
(SETQ addH NIL)
'T)
(T (CONCAT 'Sym/ ptrval]
(T (CONCAT 'Ptr/ val]
[(EQ tag2 (TamTagRep 'Fix))
(Mux-1 [ConcatBits '((dataval 0 1 31]
(CONCAT 'Fix/ dataval)
(CONCAT 'Fix/- (ConcatBits '(((Neg dataval)
0 32 0]
((EQ tag2 (TamTagRep 'Float))
(CONCAT 'Float/ dataval))
((EQ tag2 (TamTagRep 'Imm))
(COND
((EQUAL val (TamRep 'Unbound))
(SETQ addH NIL)
"Unbound")
(T (CONCAT 'Imm/ dataval]
(if (NEQ 0 refcount)
then (SETQ str (CONCAT "[" refcount "] " str)))
(PRINTOUT window str (if addH
then " "
else " "))
(RETURN " "])
(PrintMem
[LAMBDA (k l) (* amd "12-Nov-85 14:04")
(for i from k to l do [SETQ wd (\MAKENUMBER (ELT MemoryArray (ITIMES 2 i))
(ELT MemoryArray (ADD1 (ITIMES 2 i]
(printout T i %, wd %, (LOADBYTE wd 24 8)
%,
(LOADBYTE wd 16 8)
%,
(LOADBYTE wd 8 8)
%,
(LOADBYTE wd 0 8)
T])
(StoreTamByte
[LAMBDA (addr byte) (* rtk " 6-Nov-86 11:30")
[if (GREATERP addr (MASK.1'S 0 23))
then (SETQ addr (LOGAND addr (MASK.1'S 0 23]
(SETA MemoryArray (RSH addr 2)
(DEPOSITBYTE (ELTX MemoryArray (RSH addr 2))
(TIMES 8 (LOGAND addr 3))
8 byte))
(if (AND (BOUNDP 'lastaddr)
(EQ (RSH addr 2)
(RSH lastaddr 2)))
else (SETQ lastaddr addr)
(TERPRI)
(printout T addr ": "))
(PRIN1 " " T)
(PRINTNUM '(FIX 2 16 T) byte T])
)
(* * Logic Functions)
(DEFINEQ
(Decoder
[LAMBDA (Sel Enb Wires) (* ; "Edited 28-May-87 17:25 by rtk")
(BREAK1 NIL T (HELP)
NIL)
(for i in Wires do (SET i 0))
(if (AND (TF Enb)
(CADR (NTH Wires Sel)))
then (SET (CADR (NTH Wires Sel))
1])
(ConcatBitsFn
[LAMBDA (SPEC) (* rtk "13-Jun-86 10:30")
(PROG ((res 0))
[for i in SPEC do (DESTRUCTURING-BIND (VALUE DEST-POS SIZE SOURCE-POS)
i
(SETQ res (DEPOSITBYTE res DEST-POS SIZE (LOADBYTE VALUE
SOURCE-POS SIZE]
(RETURN res])
(ConcatBitsVal
[LAMBDA (Spec Vals) (* ; "Edited 20-Jul-87 16:20 by Krivacic")
(PROG ((res 0))
[for i in Spec as j in Vals do (DESTRUCTURING-BIND (name deposit-pos size source-pos)
i
(SETQ res (DEPOSITBYTE res deposit-pos size
(LOADBYTE (EvalElt j)
source-pos size]
(RETURN res])
(EvalEltFn
[LAMBDA (elt) (* ; "Edited 17-Sep-87 16:23 by Krivacic")
(PROG ((e elt))
(RETURN (if (NUMBERP e)
then e
elseif (EQ e T)
then 1
elseif (NOT e)
then 0
elseif (NLISTP e)
then (SETQ e (EVALV e))
(if (EQ e 'NOBIND)
then (PRINTOUT T "EvalElt - Undef: " elt T)
(SET elt 0))
e
else (SELECTQ (CAR e)
(Eval (EVAL (CADR e)))
(LNot (LOGNOT (EvalElt (CADR e))))
(Not (LNOT (EvalElt (CADR e))))
(And (LAND (EvalElt (CADR e))
(EvalElt (CADDR e))))
(Concat (ConcatBits (CADR e)))
(Mi (RECORDACCESS (CADR e)
(fetch (WireRec value) of MI)))
(Mil (RECORDACCESS (CADR e)
(fetch (WireRec value) of MIL)))
(HELP])
(EvalEltSim
[LAMBDA (name) (* ; "Edited 21-Jul-87 14:47 by Krivacic")
(PROG (y (x (findnode name)))
(RETURN (if x
then (fetch (WireRec value) of x)
else (EvalEltFn name])
(Mod4
[LAMBDA (n) (* agb "17-Sep-85 13:04")
(IREMAINDER (PLUS 100 n)
4])
(Mod8
[LAMBDA (n) (* agb "18-Sep-85 17:13")
(IREMAINDER (PLUS 128 n)
8])
(PrintBits
[LAMBDA (Spec) (* agb%: "21-Apr-86 16:44")
(PROG NIL
(for i in Spec do (PRINTOUT T (CAR i)
" = "
(LOADBYTE (EvalElt (CAR i))
(CADDDR i)
(CADDR i))
" "])
(PrintExpandBits
[LAMBDA (Spec val) (* agb%: "21-Apr-86 15:25")
(for i in Spec do (PRINTOUT T (CAR i)
" = "
(LOADBYTE val (CADR i)
(CADDR i))
" "])
(ModCCodeRec
[LAMBDA (rec field val) (* agb%: "13-May-86 08:29")
(SELECTQ field
(D1 (replace (CondCode D1) of rec with (LOR val (fetch (CondCode D1) of rec))))
(D2 (replace (CondCode D2) of rec with (LOR val (fetch (CondCode D2) of rec))))
(nD1 (replace (CondCode nD1) of rec with (LOR val (fetch (CondCode nD1) of rec))))
(nD2 (replace (CondCode nD2) of rec with (LOR val (fetch (CondCode nD2) of rec))))
(D1xorD2 (replace (CondCode D1xorD2) of rec with (LOR val (fetch (CondCode D1xorD2)
of rec))))
(HELP])
(MakeCondALst
[LAMBDA (ccodearray lst) (* ; "Edited 10-Nov-87 12:08 by Krivacic")
(LET (ccode r)
(for i in lst do [SETQ r (if (LISTP (CADR i))
then (for or-elements in (CDR i) collect (MakeCondEntry
or-elements))
else (MakeCondEntry (CDR i]
[SETQ ccode (CADR (FASSOC (CAR i)
(GETPROP 'dpccode 'uField]
(if ccode
then (SETA ccodearray ccode r)
else (PRINTOUT T "Undefined Condition Code: " (CAR i])
)
(* * Macros)
(DEFMACRO Mux-1 (spec a b) `[CASE ,spec (0 ,a)
(1 ,b)
(CL:OTHERWISE (MuxBreak 1 ,spec])
(DEFMACRO Mux-2 (spec a b c d) `(CASE ,spec (0 ,a)
[1 ,(IF b
THEN b
ELSE '(MuxBreak 2 1]
[2 ,(IF c
THEN c
ELSE '(MuxBreak 2 2]
[3 ,(IF d
THEN d
ELSE '(MuxBreak 2 3]
(CL:OTHERWISE (MuxBreak 2 0))))
(DEFMACRO Mux-3 (spec a b c d e f g h) `(CASE ,spec (0 ,a)
[1 ,(IF b
THEN b
ELSE '(MuxBreak 3 1]
[2 ,(IF c
THEN c
ELSE '(MuxBreak 3 2]
[3 ,(IF d
THEN d
ELSE '(MuxBreak 3 3]
[4 ,(IF e
THEN e
ELSE '(MuxBreak 3 4]
[5 ,(IF f
THEN f
ELSE '(MuxBreak 5]
[6 ,(IF g
THEN g
ELSE '(MuxBreak 3 6]
[7 ,(IF h
THEN h
ELSE '(MuxBreak 3 7]
(CL:OTHERWISE (MuxBreak 3 0))))
(DEFMACRO Mux-4 (&REST x) `(LET (lastii)
(CASE ,(CAR x) ,@(for ii in (CDR x) as n from 0
collect (SETQ lastii ii)
(LIST n ii)) (CL:OTHERWISE lastii))))
(DEFMACRO SetIBuf (ibuf regval setval) `(PROG NIL
(if DoSimLog
then (PRINTOUT SimLog "Writing IBuf word " \,
regval " with " \, setval T))
(SETA \, ibuf \, regval \, setval)))
(DEFMACRO LAND (&REST x) [APPEND (LIST 'LOGAND)
(for ii in x collect `(OZ ,ii])
(DEFMACRO LOR (&REST x) [APPEND (LIST 'LOGOR)
(for ii in x collect `(OZ ,ii])
(DEFMACRO LCMP (a b) `(OZ (IGREATERP (OZ %, a)
(OZ %, b))))
(DEFMACRO LEQV (a b) `[OZ (EQ (OZ ,a)
(OZ ,b])
(DEFMACRO LNOT (a) `(SELECTQ (OZ ,a)
(0 1)
(1 0)
(Emulator.Error)))
(DEFMACRO LXOR (&REST x) [APPEND (LIST 'LOGXOR)
(for ii in x collect `(OZ ,ii])
(DEFMACRO LNOR (&REST x) [LIST 'LNOT (APPEND (LIST 'LOGOR)
(for ii in x collect `(OZ ,ii])
(DEFMACRO LNAND (&REST x) [LIST 'LNOT (APPEND (LIST 'LOGAND)
(for ii in x collect `(OZ ,ii])
(DEFMACRO TF (x) `(NEQ 0 %, x))
(DEFMACRO OZ (x) `(if (NUMBERP ,x)
then ,x
elseif ,x
then 1
else 0))
(DEFMACRO ConcatBits (SPEC)
[if (NEQ (CAR SPEC)
'QUOTE)
then `(ConcatBitsFn ,SPEC)
else (DESTRUCTURING-BIND (FIRST-PARM . OTHER-PARMS)
(CADR SPEC)
(if (NULL FIRST-PARM)
then 0
else (DESTRUCTURING-BIND (VALUE DEST-POS SIZE SOURCE-POS)
FIRST-PARM
`(DEPOSITBYTE (ConcatBits ',OTHER-PARMS)
,DEST-POS
,SIZE
(LOADBYTE (EvalElt ',VALUE)
,SOURCE-POS
,SIZE])
(DEFMACRO EvalElt (elt)
[IF (AND (LISTP elt)
(EQ (CAR elt)
'QUOTE))
THEN
[PROG ((e (CADR elt)))
(RETURN
(if (NUMBERP e)
then e
elseif (EQ e T)
then 1
elseif (NOT e)
then 0
elseif (NLISTP e)
then e
else
(SELECTQ (CAR e)
(Eval (CADR e))
(Neg `[ADD1 (LOGNOT (EvalElt ,(LIST 'QUOTE (CADR e])
(LNot `[LOGNOT (EvalElt ,(LIST 'QUOTE (CADR e])
(TNot `[LOGNOT (EvalElt ,(LIST 'QUOTE (CADR e])
(Not `[LNOT (EvalElt ,(LIST 'QUOTE (CADR e])
(And `[LAND [EvalElt ,(LIST 'QUOTE (CADR e]
(EvalElt ,(LIST 'QUOTE (IF (CDDDR e)
THEN (CONS 'And (CDDR e))
ELSE (CADDR e])
(MI `(fetch (MI ,(CADDR e)) of MI))
(Mi `(fetch (MI ,(CADDR e)) of MI))
(Mil `(fetch (MI ,(CADDR e)) of MIL))
(Concat `[ConcatBits ,(LIST 'QUOTE (CADR e])
(HELP]
ELSE `(EvalEltFn ,elt])
(DEFMACRO WithRadix (r &REST forms) `(LET [(oldradix (RADIX ,r]
(CL:UNWIND-PROTECT (LET NIL ,@forms)
(RADIX oldradix))))
(DEFINEQ
(EvaluatePlaMacro
[LAMBDA (x) (* ; "Edited 20-Jul-87 17:45 by Krivacic")
(PROG (Specs)
(SETQ Specs (EVALV x))
(RETURN `(PROG (in (out 0))
[SETQ in (ConcatBits ',(CAR Specs]
[FOR i in ',(CADDR Specs) when (EQP (CAR i)
(LOGAND in (CADR i)))
DO (SETQ out (LOGOR out (CADDR i]
(ExpandBits ',(CADR Specs) out])
(MuxBreak
[LAMBDA (mux val)
(PRINTOUT T "Mux Error in Mux " mux " With " val T)
(BREAK1 NIL T "MuxError" NIL])
(DisplayReg
[LAMBDA (index VAL) (* rtk "26-Nov-86 13:15")
(PROG (frame offset)
(if (NUMBERP index)
then (SETQ frame (RSH index 6))
(if [AND (FMEMB 'StackFrame (WINDOWPROP TS.MAINWINDOW 'FLAGS))
(EQ frame (WINDOWPROP TS.MAINWINDOW 'CURRENTDISPFRAME]
then (TS.DISPITEM StackFrameWindow index))
else (if (EQ index 'SP)
then (PROG [(LASTSP (WINDOWPROP StackFrameWindow 'LASTSP))
(DLIST (WINDOWPROP StackFrameWindow 'DISPLIST]
[if LASTSP
then (TS.REGIONSET StackFrameWindow (CADR (ELT (CADR DLIST)
LASTSP]
(if (NOT VAL)
then (SETQ VAL 0))
(TS.REGIONSET StackFrameWindow (CADR (ELT (CADR DLIST)
VAL)))
(WINDOWPROP StackFrameWindow 'LASTSP VAL)))
(RETURN VAL])
(RegGet
[LAMBDA (index) (* ; "Edited 7-May-87 15:24 by rtk")
(if (GEQ index 0)
then (ELT RegFile index)
else 0])
(RegSet
[LAMBDA (regnum val writeoctal) (* ; "Edited 2-Oct-87 10:47 by Krivacic")
(if (AND (GEQ regnum 0)
(NOT (TF Reset)))
then (if (TF writeoctal)
then (for i from regnum to (SUB1 (LOGAND (PLUS 8 regnum)
248)) do (RegSet i val 0))
else (SETA RegFile regnum val)
(if DoSimLog
then (PRINTOUT SimLog "Reg[" regnum "] ← " (PrintData val)
T))
(DisplayReg regnum])
)
(* ;;; "PLA Functions & Macros")
(DEFINEQ
(MakePlaSpec
[LAMBDA (in-names out-names terms prop) (* ; "Edited 21-Jul-87 11:53 by Krivacic")
(PROG ((In (FixPlaNames in-names))
(Out (FixPlaNames out-names))
(Terms (FixPlaTerms terms prop)))
(RETURN (LIST In Out
(for i in Terms
collect (LIST (ConcatBitsVal In
(for j in i
collect (if (EQ 'X j)
then 0
else j)))
(ConcatBitsVal In
(for j in i
collect (if (NEQ 'X j)
then -1
else 0)))
(ConcatBitsVal Out (NTH i (PLUS 2 (LENGTH In])
(FixPlaNames
[LAMBDA (names) (* ; "Edited 23-Jul-87 11:18 by Krivacic")
(PROG (size prop (next-pos 0))
(RETURN (for i in names
collect (PROG1 (if (LISTP i)
then (SELECTQ (LENGTH i)
(1 (PRINTOUT T "Illegal Concat Spec" i T)
(Emulator-Error)
(SETQ size 1)
(LIST (CAR i)
next-pos 1 0))
(2 (SETQ size (CADR i))
(LIST (CAR i)
next-pos size 0))
(3 (SETQ size (CADR i))
(LIST (CAR i)
next-pos size (CADDR i)))
(4 (SETQ size (CADDR i))
(if (GREATERP next-pos (CADR i))
then (PRINTOUT T "Illegal Concat Position " i
T)
(Emulator-Error))
(SETQ next-pos (CADR i))
i)
(PROGN (PRINTOUT T "Illegal Concat Spec" i T)
(Emulator-Error)
(SETQ size 1)))
else (if (SETQ prop (GETPROP i 'ConcatSpec))
then (SETQ size (CAR prop))
(LIST i next-pos size 0)
else (SETQ size 1)
(LIST i next-pos 1 0)))
(SETQ next-pos (PLUS next-pos size])
(FixPlaTerms
[LAMBDA (terms prop) (* ; "Edited 21-Jul-87 17:29 by Krivacic")
(PROG ((termlist NIL)
(nextval 0))
(RETURN (for rows in terms
collect (for i in rows
collect (COND
((NUMBERP i)
i)
((EQ 'X i)
'X)
((EQ 'x i)
'X)
(T (if (SETQ val (LISTGET termlist i))
then val
elseif (EQ '* (NTHCHAR i 1))
then [CADR (FASSOC (SUBATOM i 2 (NCHARS i))
(GETPROP prop 'uField]
else (PROG1 (if (LISTP termlist)
then (LISTPUT termlist i nextval)
nextval
else (SETQ termlist (LIST i nextval))
nextval)
(SETQ nextval (ADD1 nextval])
)
(DEFMACRO EvaluatePla (x)
[DESTRUCTURING-BIND (in-spec-list out-spec-list pla-row-values)
(EVALV x)
`(PROG (in (out NIL))
[SETQ in (ConcatBits ',in-spec-list]
(FOR i in ',pla-row-values when (EQP (CAR i)
(LOGAND in (CADR i)))
DO (IF out
THEN (PRINTOUT T "Pla Duplicate " ,(LIST 'QUOTE x) " at " in " to "
(CADDR i)
" and " out T)
(Emulator-Error))
(SETQ out (CADDR i)))
(IF (NULL out)
THEN (PRINTOUT T "Pla Miss " ,(LIST 'QUOTE x) " at " in T))
(ExpandBits ,out-spec-list out])
(DEFMACRO ExpandBits (concatspec value) [APPEND '(PROGN)
(for i in concatspec
collect `(SETQ ,(CAR i) (LOADBYTE
,value
,(CADR i)
,(CADDR i])
(RPAQQ sigList (CLOCK2 CLOCK DPCONDRES IBUFFULL OPVALID WRITECYCLE RASENABLE CASENABLE RDADDR WRADDR
WRIBUF PA RA PHYADDR *memory-addr* (Mil LatchFetchPc)
WRITEOK LATCHFETCHPC DOLATCHPC DONE PCWRITEOK ↑OPLENGTH CURPC NEXTPC
MEMCTLCONDRES NSTALL IDLING HOLDING DATA PCRAS PCCAS (Mil InvertCCode)
UCODESEL NUCODESEL))
(PUTPROPS EMULATORSUPPORT COPYRIGHT ("Xerox Corporation" 1986 1987))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (1389 11849 (InitEmulator 1399 . 2643) (ExpandBitsMacro 2645 . 3273) (InitStackFrames
3275 . 3602) (CycleSetup 3604 . 6490) (CycleCheck 6492 . 7968) (DrawClockPoints 7970 . 10808) (
StartDrawClocks 10810 . 11580) (MonitorState 11582 . 11847)) (11878 15958 (PrintInstStart 11888 .
15757) (DoTest 15759 . 15956)) (16004 24179 (ZZZ 16014 . 16129) (AV 16131 . 16398) (AG 16400 . 16670)
(MakeWord 16672 . 16895) (MemoryAccess 16897 . 18910) (PrintData 18912 . 22905) (PrintMem 22907 .
23555) (StoreTamByte 23557 . 24177)) (24208 30019 (Decoder 24218 . 24555) (ConcatBitsFn 24557 . 25036)
(ConcatBitsVal 25038 . 25644) (EvalEltFn 25646 . 27021) (EvalEltSim 27023 . 27329) (Mod4 27331 .
27479) (Mod8 27481 . 27629) (PrintBits 27631 . 28067) (PrintExpandBits 28069 . 28409) (ModCCodeRec
28411 . 29189) (MakeCondALst 29191 . 30017)) (36768 39647 (EvaluatePlaMacro 36778 . 37354) (MuxBreak
37356 . 37480) (DisplayReg 37482 . 38770) (RegGet 38772 . 38973) (RegSet 38975 . 39645)) (39689 44845
(MakePlaSpec 39699 . 40861) (FixPlaNames 40863 . 43250) (FixPlaTerms 43252 . 44843)))))
STOP