(FILECREATED "13-May-87 16:38:04" {ERIS}<TAMARIN>UCODE>EMULATORSUPPORT.;59 40581
changes to: (FNS ShowStats CycleSetup PrintInstStart)
(VARS EMULATORSUPPORTCOMS)
previous date: "12-Sep-86 16:08:05" {ERIS}<TAMARIN>UCODE>EMULATORSUPPORT.;54)
(* Copyright (c) 1986, 1987 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT EMULATORSUPPORTCOMS)
(RPAQQ EMULATORSUPPORTCOMS ((* * INIT)
(FNS ExpandBitsMacro InitStackFrames CycleSetup CycleCheck DrawClocks DrawClockPoints RegMux
ShowStats StartDrawClocks MonitorState MuxCode)
(* * Staus reporting)
(FNS PrintIBufWordWrite PrintRegFileWrite PrintInstStart)
(* * Tamarin structure representation)
(FNS ZZZ AV MakeWord MemoryAccess PrintData PrintMem StoreTamByte TamarinTypeBits TamarinType
TamarinVal)
(* * Logic Functions)
(FNS Mux-1 Mux-2 Mux-3 Mux-4 Decoder LAND LOR LCMP LEQV LNOT TF OZ ConcatBits ConcatBitsVal
ExpandBits ExecuteClock EvalElt EvalEltSim Mod4 Mod8 PrintBits PrintExpandBits
ModCCodeRec MakeCondALst)
(* * PLA Generation)
(FNS EvaluatePLA MakePlaSpec)
(* * Old Code)
(FNS ExecuteClockCopy MakePlaSpecOld)
(* * Macros)
(MACROS ConcatBits ExecuteClock ExpandBits EvalEltX EvaluatePLA LNOT LEQV LCMP LOR LAND
EvalElt Mux-1 Mux-2 Mux-3 Mux-4 OZ TF RegMux)
(FNS ExecuteClockMacro EvalEltXMacro EvaluatePlaMacro Mux-Macro)
(VARS ILr1 ILr4 ILnormal ILreset ILw4)))
(* * INIT)
(DEFINEQ
(ExpandBitsMacro
[LAMBDA (xx) (* agb: " 4-Jun-86 09:18")
(if (NEQ (CAAR xx)
(QUOTE QUOTE))
then (QUOTE IGNOREMACRO)
else (BQUOTE (PROGN ,@ (FOR i in (CADAR xx) COLLECT (BQUOTE
(SETQ , (CAR i)
(LOADBYTE ,
(CADR
xx)
,
(CADR
i)
,
(CADDR
i])
(InitStackFrames
[LAMBDA (number) (* rtk "19-May-86 15:33")
(PROG [(Next (TamRep (QUOTE NIL]
(for i from 1 to number do (SETQ Next (AddMemFrame Next)))
(RETURN Next])
(CycleSetup
[LAMBDA NIL (* edited: "13-May-87 12:45")
(CLEARW logWindow)
(CLEARW (WINDOWPROP TS.MAINWINDOW (QUOTE TRACEWINDOW)))
(PRINT CurrentOpList SimLog)
(WINDOWPROP TS.MAINWINDOW (QUOTE CURRENTDISPFRAME)
0)
(WINDOWPROP TS.MAINWINDOW (QUOTE CURRENTEXECFRAME)
0)
[WINDOWPROP TS.MAINWINDOW (QUOTE FLAGS)
(UNION (QUOTE (Stopping))
(WINDOWPROP TS.MAINWINDOW (QUOTE FLAGS]
(TS.SETFLAGS)
(for i from 0 to 39 do (TF.SETREGABS (ELT STACKFRAMES 0)
i 0))
(TS.FRAMESELECT (WINDOWPROP TS.MAINWINDOW (QUOTE FRAMEMENU))
"Frame 0" 0)
(SETQ TamEmulator T)
(SETQ Refreshes 0)
(SETQ RefreshCount 0)
(SETQ Cycles 0)
(SETQ ResetCycle 0)
(SETQ RefreshEnable NIL)
(SETQ ErrorCycles 0)
(SETQ ErrorCount 0)
(SETQ FrameLoads 0)
(SETQ FrameDumps 0)
(SETQ FnCount 0)
(SETQ IBufLoads 0)
(SETQ Reset 1)
(SETQ JustReset T)
(SETQ OpcodeCounter (ARRAY 256 (QUOTE POINTER)
0 0))
(for i from 0 to (DIFFERENCE (ARRAYSIZE EvenRegFile)
1)
do (SETA EvenRegFile i 4294967295)
(SETA OddRegFile i 4294967295))
(ResetVMM])
(CycleCheck
[LAMBDA NIL (* rtk "25-Jul-86 18:15")
(SETQ Cycles (ADD1 Cycles))
(SETQ RefreshCount (ADD1 RefreshCount))
(if RefreshEnable
then (SETQ Refresh 0))
(if (AND RefreshEnable (GREATERP RefreshCount RefreshAfter))
then (SETQ Refresh 1)
(SETQ RefreshCount 0)
(SETQ Refreshes (ADD1 Refreshes)))
(BLOCK)
(TS.PUTFRAMEPROP (ELT STACKFRAMES #TopCxt)
(QUOTE SP)
#Tos)
(if (FMEMB (QUOTE CycleStep)
(WINDOWPROP TS.MAINWINDOW (QUOTE FLAGS)))
then (TS.MAINMENUSELECTEDFN (QUOTE Stop)
(WINDOWPROP TS.MAINWINDOW (QUOTE DEBUGMENU))
(QUOTE LEFT)))
(if (FMEMB (QUOTE Stopping)
(WINDOWPROP TS.MAINWINDOW (QUOTE FLAGS)))
then (DispVars)
(PROG [(m (WINDOWPROP TS.MAINWINDOW (QUOTE MENU3]
(for i in (fetch (MENU ITEMS) of m)
do (SET i (LNOT i))
(TS.MAINMENUSELECTEDFN i m)))
(SETQ TRACESTR (fetch (MI Ucode) of #MIR))
(TS.BREAKCONTROL)
elseif DoEmulatorVars
then (DispVars])
(DrawClocks
[LAMBDA (InList) (* agb: "18-May-86 11:43")
(PROG NIL
(CLEARW PlotWin)
(SETQ xClock 0)
(SETQ xPre 0)
[SETQ lastPos (for i in sigList as k from 0
collect (MOVETO 0 (TIMES k 20)
PlotWin)
(PRINTOUT PlotWin i)
(LOGAND 1 (EvalElt i]
(SETQ oldX 100)
(SETQ *NClockState 0)
(SETQ Reset 0)
(SETQ Hold 0)
(SETQ #Fault 0)
(SETQ #Trap 0)
(SETQ Cycle 0)
(for e in InList
do [for elt in e do (SET (CADR elt)
(EvalElt (CAR elt]
(SETQ xClock 1)
(ClockClock)
(DoClock)
(DrawClockPoints 0)
(DrawClockPoints 10)
(SETQ xClock 0)
(DoClock)
(DrawClockPoints 0)
(DrawClockPoints 4)
(SETQ xPre 1)
(PrechargeClock)
(DoClock)
(DrawClockPoints 0)
(DrawClockPoints 10)
(SETQ xPre 0)
(DoClock)
(DrawClockPoints 0)
(DrawClockPoints 4 2 *NClockState])
(DrawClockPoints
[LAMBDA (deltaX flg flg2) (* agb: "28-Aug-86 22:19")
(PROG NIL
(if (OR (NOT PlotWin)
(NOT sigList))
then (RETURN))
(if flg
then (if (GREATERP oldX (DIFFERENCE (WINDOWPROP PlotWin (QUOTE 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 flg2))
(SETQ newX (PLUS oldX deltaX))
(for i on lastPos as j on sigList as k from 0
do [SETQ newVal (LOGAND 1 (EvalEltSim (CAR j]
[SETQ oldPos (PLUS (TIMES k 20)
(TIMES 10 (CAR i]
(SETQ newPos (PLUS (TIMES k 20)
(TIMES 10 newVal)))
(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])
(RegMux
[LAMBDA (itm lst) (* agb: "10-Jun-86 19:03")
(EVAL (MuxCode itm lst])
(ShowStats
[LAMBDA NIL (* edited: "13-May-87 16:26")
NIL
(PRINTOUT T "Opcode Stats: " T)
(PRINTOUT T "Cycles: " Cycles T)
(PRINTOUT T "IBufLoads: " IBufLoads T)
(PRINTOUT T "FunctionCalls: " FnCount T)
(PRINTOUT T "FrameDumps: " FrameDumps T)
(PRINTOUT T "FrameLoads: " FrameLoads T)
(for i from 0 to 255 do (if (GREATERP (ELT OpcodeCounter i)
0)
then (PRINTOUT T (CAR (ELT OpPlaArray i))
": "
(ELT OpcodeCounter i)
T])
(StartDrawClocks
[LAMBDA (InList) (* rtk " 5-Aug-86 19:14")
(PROG NIL
(if (OR (NOT (BOUNDP (QUOTE 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 24Q)
PlotWin)
(PRINTOUT PlotWin i)
(LOGAND 1 (EvalEltSim i]
(SETQ oldX 144Q])
(MonitorState
[LAMBDA (flg) (* agb: "18-May-86 20:56")
(if (NOT flg)
then (DrawClockPoints 10)
else (DrawClockPoints 10 5 *NClockState])
(MuxCode
[LAMBDA (var sel) (* rtk "12-Jun-86 16:02")
(PROG (spec)
(SETQ spec (ASSOC var RegMuxSpec))
(RETURN
(BQUOTE
(SETQ , (CAR spec)
(LOGAND
,
(SUB1 (EXPT 2 (CADDR spec)))
(LOGNOT
(Mux-4
, sel ,@
(for i in (CDDDR spec)
collect
(if (LISTP i)
then
[BQUOTE
(ConcatBits
(QUOTE , (for j in i collect
(LIST (CAR j)
(DIFFERENCE (CADR j)
(CADR spec))
(CADDR j)
(PLUS (OR (CAR (CDDDDR j))
0)
(DIFFERENCE (CADDDR j)
(CADR spec]
elseif (EQ NIL i)
then 0
else i])
)
(* * Staus reporting)
(DEFINEQ
(PrintIBufWordWrite
[LAMBDA (reg d2) (* agb: " 4-Jun-86 09:03")
(if DoSimLog
then (PRINTOUT SimLog "Writing IBuf word " reg " with " d2 T])
(PrintRegFileWrite
[LAMBDA (i val flg) (* agb: " 4-Jun-86 09:29")
(PROG (j)
(SETQ j (PLUS flg (TIMES 2 i)))
(if DoSimLog
then (PRINTOUT SimLog "Writing Reg " j " with " # (PrintData val)
T))
(TS.PUTFRAMEPROP (ELT STACKFRAMES (LRSH i 5))
(LOGAND 63 j)
val])
(PrintInstStart
[LAMBDA NIL (* edited: "13-May-87 12:38")
(if DoSimLog
then (PRINTOUT SimLog "D1: " # (PrintData D1)
" D2: " # (PrintData D2)
" Tos: " #Tos " RegAddr: " (LOGOR *RegAddr (LSH @RegCxt 6))
T))
(if (AND DoTransSim errortracefile)
then (PRINTOUT errortracefile " *pre/*clock/*op/*micro/*firstcy/*secondcy: " *Pre *Clock
*Op *Micro *FirstCy *SecondCy " $Opcode: " $Opcode " #$Opcode " #$Opcode
" #NCurPc: "
#NCurPc T)
(PRINTOUT errortracefile "D1: " # (PrintData D1)
" D2: " # (PrintData D2)
" Tos: " #Tos " RegAddr: " (LOGOR *RegAddr (LSH @RegCxt 6))
T))
[if (AND (TF *Micro)
(TF $NewOp))
then (if [NOT (OR (EQ (fetch (MI Label) of #MIR)
(QUOTE dumpframe))
(EQ (fetch (MI Label) of #MIR)
(QUOTE loadframe))
(EQ (fetch (MI Label) of #MIR)
(QUOTE loadibuf]
then (SETA OpcodeCounter #$Opcode (PLUS (ELT OpcodeCounter #$Opcode)
1)))
(if (AND DoTransSim errortracefile)
then (printout errortracefile "New Opcode: " #$Opcode " Length: " #OpLength
" Data: "
#
(PrintData #IBufData)
" N: " #IBufN " PC: " (LOGAND #CurPc 65535)
" OldOpLength: " #$OpLength T))
(if DoSimLog
then (printout SimLog T "New Opcode: " #$Opcode)
(printout SimLog " Length: " #OpLength " Data: " # (PrintData #IBufData)
" N: " #IBufN " PC: " (LOGAND #CurPc 65535)
" OldOpLength: " #$OpLength T))
(if DoOpcodeTrace
then (printout TS.TRACEWINDOW (CAR (ELT OpPlaArray #Opcode))
T))
(if [OR (FMEMB (CAR (ELT OpPlaArray #Opcode))
(WINDOWPROP TS.MAINWINDOW (QUOTE BREAKPOINTS)))
(FMEMB (QUOTE OpcodeStep)
(WINDOWPROP TS.MAINWINDOW (QUOTE FLAGS]
then (TS.MAINMENUSELECTEDFN (QUOTE Stop)
(WINDOWPROP TS.MAINWINDOW (QUOTE DEBUGMENU))
(QUOTE LEFT]
[if (TF *Micro)
then (if (EQ (fetch (MI Label) of #MIR)
(QUOTE fncall))
then (SETQ FnCount (ADD1 FnCount)))
(if (EQ (fetch (MI Label) of #MIR)
(QUOTE dumpframe))
then (SETQ FrameDumps (ADD1 FrameDumps)))
(if (EQ (fetch (MI Label) of #MIR)
(QUOTE loadframe))
then (SETQ FrameLoads (ADD1 FrameLoads)))
(if (EQ (fetch (MI Label) of #MIR)
(QUOTE loadibuf))
then (SETQ IBufLoads (ADD1 IBufLoads)))
(if DoSimLog
then (printout SimLog "Executing uInst: " (fetch (MI Label) of #MIR)
":" #uPC T))
(if (AND DoTransSim errortracefile)
then (printout errortracefile "Executing uInst: " (fetch (MI Label)
of #MIR)
":" #uPC T)
(printout errortracefile "#MIR: " (fetch (MI Ucode) of #MIR)
T))
(if DoOpcodeTrace
then (printout TS.TRACEWINDOW " uInst: " (fetch (MI Label) of #MIR)
":" #uPC T))
(if [OR (FMEMB (QUOTE UcodeStep)
(WINDOWPROP TS.MAINWINDOW (QUOTE FLAGS)))
(FMEMB (fetch (MI Label) of #MIR)
(WINDOWPROP TS.MAINWINDOW (QUOTE BREAKPOINTS]
then (TS.MAINMENUSELECTEDFN (QUOTE Stop)
(WINDOWPROP TS.MAINWINDOW (QUOTE DEBUGMENU))
(QUOTE LEFT]
(if (AND (TF *Micro)
(TF $NewOp))
then (if DoEmulatorLog
then (printout logWindow ", " #$Opcode)))
(if (TF *Micro)
then (if DoEmulatorLog
then (printout logWindow "/" #uPC)))
(SETQ nxtop NIL])
)
(* * Tamarin structure representation)
(DEFINEQ
(ZZZ
[LAMBDA NIL (* agb: "19-Feb-86 09:00")
NIL])
(AV
[LAMBDA (var) (* agb: "21-Apr-86 13:37")
(SETQ InitVarLst (NCONC1 InitVarLst 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: "11-Sep-86 20:00")
(if (AND (NOT quiet)
(NOT DoSimLog))
then (SETQ quiet T))
(PROG (MemAddr v)
[if (IGREATERP addr (MASK.1'S 0 25Q))
then (if (NOT quiet)
then (printout SimLog "Mem Addr reset: " addr " to "
(LOGAND addr (MASK.1'S 0 25Q))
T))
(SETQ addr (LOGAND addr (MASK.1'S 0 25Q]
(if (IGREATERP addr (QUOTIENT (ARRAYSIZE MemoryArray)
2))
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 (ITIMES 2 (LOGAND 77777777Q addr)))
(if (NOT val)
then (SETQ v (PLUS (ELT MemoryArray (ADD1 MemAddr))
(LSH (ELT MemoryArray MemAddr)
20Q)))
(if (NOT quiet)
then (printout SimLog "DoMemRead - Addr: " addr " Value: " #
(PrintData v)
T))
(* if (AND breakonwrite (LESSP addr 144Q)) then (printout SimLog "DoMemRead - Addr: " addr " Value: " #
(PrintData v) T) (BREAK1 NIL T (Read) NIL))
else (if (BITTEST val (MASK.1'S 37Q 1))
then (SETQ val (DIFFERENCE val 40000000000Q)))
(SETA MemoryArray MemAddr (\HINUM val))
(SETA MemoryArray (ADD1 MemAddr)
(\LONUM val))
(if (NOT quiet)
then (printout SimLog "DoMemWrite - Addr: " addr " Value: " #
(PrintData val)
T))
(* if (AND breakonwrite (OR (LESSP addr 144Q) (GREATERP addr 10542Q))) then (printout SimLog "DoMemWrite - Addr: "
addr " Value: " # (PrintData val) T) (BREAK1 NIL T (Write) NIL))
)
(RETURN v])
(PrintData
[LAMBDA (val) (* rtk " 8-Aug-86 10:13")
(PROG (tag tag2)
(SETQ tag (LOADBYTE val 36Q 2))
(SETQ tag2 (LOADBYTE val 30Q 6))
(COND
((AND (EQ tag 0)
(EQ tag2 10Q)
(ILESSP (LOADBYTE val 0 30Q)
3))
(PRIN1 (SELECTQ (LOADBYTE val 0 30Q)
(7000Q (QUOTE NIL))
(7020Q (QUOTE T))
NIL))
(RETURN)))
(SELECTQ tag
(0 (PRIN1 (SELECTQ tag2
(0 "Object/")
(1 "Stack/")
(2 "Object/")
(3 "Number/")
(4 "List/")
(6 "Code/")
(10Q "Atm/")
(42Q "Unbound/")
(PROGN (PRIN1 "Ptr-")
(PRIN1 tag2)
"/")))
(PRIN1 (LOADBYTE val 0 33Q)))
(1 (PRIN1 "Int/")
(PRIN1 (LOADBYTE val 0 36Q)))
(2 (PRIN1 "Float/")
(PRIN1 (LOADBYTE val 0 36Q)))
[3 (if (EQP 7777777777Q (LOADBYTE val 0 36Q))
then (PRIN1 "--")
else (PRIN1 "XType/")
(PRIN1 (LOADBYTE val 0 36Q]
(PROGN (PRIN1 tag)
(PRIN1 "/")
(PRIN1 (LOADBYTE val 0 36Q])
(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) (* edited: "22-Aug-86 17:12")
[if (GREATERP addr (MASK.1'S 0 27Q))
then (SETQ addr (LOGAND addr (MASK.1'S 0 27Q]
(if DoIBufSwap
then (SETQ byte (LOGXOR byte 377Q))
[SETQ wrd (PROG (wrd (offset (DIFFERENCE 3 (LOGAND addr 3)))
(raddr (TIMES (IQUOTIENT addr 4)
2)))
(SETQ wrd (ELT MemoryArray raddr))
[for i from 0 to 3 do (SETQ wrd
(DEPOSITBYTE
wrd
(PLUS offset (TIMES i 4))
1
(LOADBYTE byte
(IPLUS i 4)
1]
(SETA MemoryArray raddr wrd)
(SETQ wrd (ELT MemoryArray (ADD1 raddr)))
[for i from 0 to 3 do (SETQ wrd
(DEPOSITBYTE
wrd
(PLUS offset (TIMES i 4))
1
(LOADBYTE byte i 1]
(SETA MemoryArray (ADD1 raddr)
wrd)
(PRINTOUT T addr ": " byte T)
(RETURN (ELT MemoryArray (IQUOTIENT addr 2]
else (SETA MemoryArray (IQUOTIENT addr 2)
(SETQ wrd (DEPOSITBYTE (ELT MemoryArray (IQUOTIENT addr 2))
(if (ODDP addr)
then 0
else 10Q)
10Q byte)))
(if (AND (BOUNDP (QUOTE lastaddr))
(NUMBERP lastaddr)
(NEQ (IQUOTIENT addr 2)
(IQUOTIENT lastaddr 2)))
then (SETQ lastaddr NIL)
(printout T addr ": " lastwrd ", " (LOADBYTE lastwrd 10Q 10Q)
,
(LOADBYTE lastwrd 0 10Q)
, T))
(if (ODDP addr)
then (SETQ lastaddr NIL)
(printout T addr ": " wrd ", " (LOADBYTE wrd 10Q 10Q)
,
(LOADBYTE wrd 0 10Q)
, T)
else (SETQ lastaddr addr)
(SETQ lastwrd wrd])
(TamarinTypeBits
[LAMBDA (X) (* rtk " 7-May-86 16:39")
(LOGAND (LSH X -24)
192])
(TamarinType
[LAMBDA (x flagbit) (* rtk " 8-May-86 15:00")
(LOGAND (RSH x 24)
(if flagbit
then 255
else 254])
(TamarinVal
[LAMBDA (v) (* agb "25-Sep-85 11:01")
v])
)
(* * Logic Functions)
(DEFINEQ
(Mux-1
[LAMBDA (in a0 a1) (* agb: " 1-May-86 13:15")
(PROG (x)
(SETQ x (SELECTQ in
(0 a0)
(1 a1)
(Emulator.error)))
(if (NOT x)
then (Emulator.error))
(RETURN x])
(Mux-2
[LAMBDA (in a0 a1 a2 a3) (* agb: " 1-May-86 13:15")
(PROG (x)
(SETQ x (SELECTQ in
(0 a0)
(1 a1)
(2 a2)
(3 a3)
(Emulator.error)))
(if (NOT x)
then (Emulator.error))
(RETURN x])
(Mux-3
[LAMBDA (in a0 a1 a2 a3 a4 a5 a6 a7) (* agb: " 1-May-86 13:14")
(PROG (x)
(SETQ x (SELECTQ in
(0 a0)
(1 a1)
(2 a2)
(3 a3)
(4 a4)
(5 a5)
(6 a6)
(7 a7)
(Emulator.error)))
(if (NOT x)
then (Emulator.error))
(RETURN x])
(Mux-4
[LAMBDA (in a0 a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15)
(* agb: " 1-May-86 13:13")
(PROG (x)
(SETQ x (SELECTQ in
(0 a0)
(1 a1)
(2 a2)
(3 a3)
(4 a4)
(5 a5)
(6 a6)
(7 a7)
(8 a8)
(9 a9)
(10 a10)
(11 a11)
(12 a12)
(13 a13)
(14 a14)
(15 a15)
(Emulator.error)))
(if (NOT x)
then (Emulator.error))
(RETURN x])
(Decoder
[LAMBDA (Sel Enb Wires) (* agb: "16-Apr-86 20:46")
(for i in Wires do (SET i 0))
(if (TF Enb)
then (SET (CADR (NTH Wires Sel))
1])
(LAND
[LAMBDA (a b) (* agb: "16-Apr-86 09:57")
(LOGAND (OZ a)
(OZ b])
(LOR
[LAMBDA (a b) (* agb: "16-Apr-86 09:57")
(LOGOR (OZ a)
(OZ b])
(LCMP
[LAMBDA (a b) (* agb: "16-Apr-86 10:02")
(OZ (IGREATERP (OZ a)
(OZ b])
(LEQV
[LAMBDA (a b) (* agb: "16-Apr-86 09:58")
(OZ (EQ (OZ a)
(OZ b])
(LNOT
[LAMBDA (a) (* agb: " 1-May-86 22:22")
(SELECTQ (EvalElt a)
(0 1)
(1 0)
(Emulator.Error])
(TF
[LAMBDA (x) (* agb: "18-Dec-85 20:09")
(NEQ 0 x])
(OZ
[LAMBDA (x) (* agb: "20-Dec-85 16:57")
(if (NUMBERP x)
then x
elseif (NOT x)
then 0
else 1])
(ConcatBits
[LAMBDA (Spec) (* agb: "20-May-86 20:02")
(* * Each spec in a SpecList is (var depPos size loadPos) where bit 0 is rightmost.)
(PROG ((xxres 0))
[for i in Spec do (SETQ xxres (DEPOSITBYTE xxres (CADR i)
(CADDR i)
(LOADBYTE (EvalElt (CAR i))
(CADDDR i)
(CADDR i]
(* if (GEQ res 2147483648) then
(SETQ res (PLUS -2147483648
(LOGAND 2147483647 res))))
(* if (EQ (QUOTE BIGNUM) (TYPENAME res)) then
(HELP))
(RETURN xxres])
(ConcatBitsVal
[LAMBDA (Spec Vals) (* rtk "13-Jun-86 10:30")
(PROG ((res 0))
[for i in Spec as j in Vals do (SETQ res (DEPOSITBYTE res (CADR i)
(CADDR i)
(LOADBYTE
(EvalElt j)
(CADDDR i)
(CADDR i]
(RETURN res])
(ExpandBits
[LAMBDA (Spec val) (* agb: "18-Dec-85 19:01")
(for i in Spec do (SET (CAR i)
(LOADBYTE val (CADR i)
(CADDR i])
(ExecuteClock
[LAMBDA (k) (* agb: "16-May-86 08:57")
(for v in k do (if (for i in (CAR v) always (TF (EvalElt i)))
then (for j in (CDR v)
do (if (CADR j)
then (SET (CADR j)
(EvalElt (CAR j)))
else (EvalElt (CAR j)))
(ZZZ)
(* if (EQ (QUOTE *) (CAR j)) then NIL elseif (AND (CADR j) (ATOM (CADR j))) then (SET (CADR j)
(EvalElt (CAR j))) else (EVAL j))
])
(EvalElt
[LAMBDA (elt) (* rtk "16-Aug-86 13:09")
(PROG (x)
(RETURN (if (NUMBERP elt)
then elt
elseif (EQ elt T)
then -1
elseif (NOT elt)
then 0
elseif (LISTP elt)
then [SELECTQ (CAR elt) (* 1)
[Not (LNOT (EvalElt (CADR elt]
[LNot (LOGNOT (EvalElt (CADR elt]
[And (LAND (EvalElt (CADR elt))
(EvalElt (CADDR elt]
(Eval (EVAL (CADR elt)))
[Rec (RECORDACCESS (CADDDR elt)
(EVALV (CADR elt]
(Concat (ConcatBits (CADR elt)))
(RECORDACCESS (CADR elt)
(EVALV (CAR elt]
else (SETQ x (EVALV elt))
(if (EQ x (QUOTE NOBIND))
then (PRINTOUT T "EvalElt - Undef: " elt T)
(SETQ InitVarLst (NCONC1 InitVarLst elt))
(SET elt 0)
else x])
(EvalEltSim
[LAMBDA (name) (* agb: "28-Aug-86 22:19")
(PROG (y (x (findnode name)))
(SETQ sWidth 1)
(RETURN (if x
then (SETQ y (ELT potto01array (fetch (node npot) of x)))
(if (EQ y 2)
then (SETQ sWidth 4))
y
else (EvalElt 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 (lst) (* rtk "14-Jul-86 13:40")
(for i in lst
do (SETQ r
(create CondCode
D1 ← 0
D2 ← 0
nD1 ← 0
nD2 ← 0
D1xorD2 ← 0))
(for j on (CDR i) by (CDDR j)
do [SETQ vl (OR (NUMBERP (CADR j))
(TamRep (CADR j]
(SELECTQ (CAR j)
(noop (SETQ r (QUOTE noop)))
(condc (SETQ r (QUOTE condc)))
[tagD1 (ModCCodeRec r (QUOTE nD1)
(LOGAND tagmsk vl))
(ModCCodeRec r (QUOTE D1)
(LOGAND tagmsk (LOGNOT vl]
[fulltagD1 (ModCCodeRec r (QUOTE nD1)
(LOGAND fulltagmsk vl))
(ModCCodeRec r (QUOTE D1)
(LOGAND fulltagmsk (LOGNOT vl]
[fulltag&flagD1 (ModCCodeRec r (QUOTE nD1)
(LOGAND fulltag&flagmsk vl))
(ModCCodeRec r (QUOTE D1)
(LOGAND fulltag&flagmsk (LOGNOT
vl]
[tagD2 (ModCCodeRec r (QUOTE nD2)
(LOGAND tagmsk vl))
(ModCCodeRec r (QUOTE D2)
(LOGAND tagmsk (LOGNOT vl]
[fulltagD2 (ModCCodeRec r (QUOTE nD2)
(LOGAND fulltagmsk vl))
(ModCCodeRec r (QUOTE D2)
(LOGAND fulltagmsk (LOGNOT vl]
[fulltag&flagD2 (ModCCodeRec r (QUOTE nD2)
(LOGAND fulltag&flagmsk vl))
(ModCCodeRec r (QUOTE D2)
(LOGAND fulltag&flagmsk (LOGNOT
vl]
[valD2<2:28> (ModCCodeRec r (QUOTE nD2)
(LOGAND 7777777770Q vl))
(ModCCodeRec r (QUOTE D2)
(LOGAND 7777777770Q (LOGNOT vl]
(bitD1 (ModCCodeRec r (QUOTE nD1)
vl))
(notbitD1 (ModCCodeRec r (QUOTE D1)
vl))
(bitD2 (ModCCodeRec r (QUOTE nD2)
vl))
(wordEq (ModCCodeRec r (QUOTE D1xorD2)
vl))
(wordNEq (ModCCodeRec r (QUOTE D1xorD2)
vl))
(D1Eq (ModCCodeRec r (QUOTE D1)
(LOGAND (MASK.1'S 0 36Q)
(LOGNOT vl)))
(ModCCodeRec r (QUOTE nD1)
(LOGAND (MASK.1'S 0 36Q)
vl)))
(D2Eq (ModCCodeRec r (QUOTE D2)
(LOGAND (MASK.1'S 0 36Q)
(LOGNOT vl)))
(ModCCodeRec r (QUOTE nD2)
(LOGAND (MASK.1'S 0 36Q)
vl)))
(HELP)))
(SETA CondAArray [CADR (FASSOC (CAR i)
(GETPROP (QUOTE condcode)
(QUOTE uField]
r])
)
(* * PLA Generation)
(DEFINEQ
(EvaluatePLA
[LAMBDA (Specs name) (* agb: "20-May-86 21:32")
(PROG (in (out 0))
(SETQ in (ConcatBits (CAR Specs)))
[for i in (CADDR Specs) as q from 0 when (EQ (CAR i)
(LOGAND in (CADR i)))
do (if (NEQ 0 out)
then (ZZZ))
(SETQ out (LOGOR out (CADDR i] (* PRINTOUT T "PLA name= " name " in= " in " out = "
out T)
(ExpandBits (CADR Specs)
out)
(if (MEMB name (QUOTE NIL))
then (PRINTOUT T "PLA name= " name " ")
(PrintBits (CAR Specs))
(PRINTOUT T T "output ")
(PrintExpandBits (CADR Specs)
out)
(PRINTOUT T T])
(MakePlaSpec
[LAMBDA (In Out Terms) (* rtk "13-Jun-86 10:31")
(LIST In Out (for i in Terms collect (LIST (ConcatBitsVal
In
(for j in i
collect (if (EQ (QUOTE X)
j)
then 0
else j)))
(ConcatBitsVal
In
(for j in i
collect (if (NEQ (QUOTE X)
j)
then -1
else 0)))
(ConcatBitsVal Out
(NTH i
(PLUS
2
(LENGTH In])
)
(* * Old Code)
(DEFINEQ
(ExecuteClockCopy
[LAMBDA (k) (* agb: "16-May-86 08:57")
(for v in k do (if (for i in (CAR v) always (TF (EvalElt i)))
then (for j in (CDR v)
do (if (CADR j)
then (SET (CADR j)
(EvalElt (CAR j)))
else (EvalElt (CAR j)))
(ZZZ)
(* if (EQ (QUOTE *) (CAR j)) then NIL elseif (AND (CADR j) (ATOM (CADR j))) then (SET (CADR j)
(EvalElt (CAR j))) else (EVAL j))
])
(MakePlaSpecOld
[LAMBDA (In Out Terms) (* agb: "23-Dec-85 16:28")
(LIST In Out (for i in Terms collect
(LIST (ConcatBitsVal In (CAR i))
[if (CADDR i)
then (ConcatBitsVal In (CADR i))
else (ConcatBitsVal
In
(for j in (CAR i)
collect (if (NEQ (QUOTE X)
j)
then -1
else 0]
(ConcatBitsVal Out (OR (CADDR i)
(CADR i])
)
(* * Macros)
(DECLARE: EVAL@COMPILE
[PUTPROPS ConcatBits MACRO (XX (if (NEQ (CAAR XX)
(QUOTE QUOTE))
then
(QUOTE IGNOREMACRO)
elseif
(NOT (CAADAR XX))
then 0 else
(BQUOTE (DEPOSITBYTE (ConcatBits (QUOTE , (CDADAR XX)))
,
(CADR (CAADAR XX))
,
(CADDR (CAADAR XX))
(LOADBYTE [EvalElt
(QUOTE , (CAR (CAADAR XX]
,
(CADDDR (CAADAR XX))
,
(CADDR (CAADAR XX]
(PUTPROPS ExecuteClock MACRO (X (ExecuteClockMacro X)))
(PUTPROPS ExpandBits MACRO (XX (ExpandBitsMacro XX)))
(PUTPROPS EvalEltX MACRO (X (EvalEltXMacro X)))
(PUTPROPS EvaluatePLA MACRO (XX (EvaluatePlaMacro XX)))
[PUTPROPS LNOT MACRO (LAMBDA (a)
(* agb: " 1-May-86 22:22")
(SELECTQ (EvalElt a)
(0 1)
(1 0)
(Emulator.Error]
[PUTPROPS LEQV MACRO (LAMBDA (a b)
(* agb: "16-Apr-86 09:58")
(OZ (EQ (OZ a)
(OZ b]
[PUTPROPS LCMP MACRO (LAMBDA (a b)
(* agb: "16-Apr-86 10:02")
(OZ (IGREATERP (OZ a)
(OZ b]
[PUTPROPS LOR MACRO (LAMBDA (a b)
(* agb: "16-Apr-86 09:57")
(LOGOR (OZ a)
(OZ b]
[PUTPROPS LAND MACRO (LAMBDA (a b)
(* agb: "16-Apr-86 09:57")
(LOGAND (OZ a)
(OZ b]
[PUTPROPS EvalElt MACRO (XX (if (EQ (QUOTE QUOTE)
(CAAR XX))
then
(EvalEltXMacro (CDAR XX))
else
(QUOTE IGNOREMACRO]
(PUTPROPS Mux-1 MACRO (XX (Mux-Macro XX)))
(PUTPROPS Mux-2 MACRO (XX (Mux-Macro XX)))
(PUTPROPS Mux-3 MACRO (XX (Mux-Macro XX)))
(PUTPROPS Mux-4 MACRO (XX (Mux-Macro XX)))
(PUTPROPS OZ MACRO [LAMBDA (x)
(* agb: "20-Dec-85 16:57")
(if (NUMBERP x)
then x elseif (NOT x)
then 0 else 1])
(PUTPROPS TF MACRO [LAMBDA (x)
(* agb: "18-Dec-85 20:09")
(NEQ 0 x])
[PUTPROPS RegMux MACRO (X (MuxCode (CADAR X)
(CADADR X]
)
(DEFINEQ
(ExecuteClockMacro
[LAMBDA (X) (* agb: " 3-Jun-86 20:55")
(CONS (QUOTE PROGN)
(for exp in (CADAR X)
collect
(BQUOTE (IF [AND (\,@ (for jj in (CAR exp)
collect (BQUOTE (TF (EvalElt
(QUOTE (\, jj]
THEN (\,@ (for jj in (CDR exp)
collect
(if (CADR jj)
then [BQUOTE
(SETQ (\, (CADR jj))
(EvalElt (QUOTE (\, (CAR jj]
else (BQUOTE (EvalElt
(QUOTE (\, (CAR jj])
(EvalEltXMacro
[LAMBDA (x) (* edited: "11-Sep-86 17:16")
(PROG (e)
(SETQ e (CAR x))
(RETURN (if (NUMBERP e)
then e
elseif (EQ e T)
then 1
elseif (NLISTP e)
then e
elseif (EQ (CAR e)
(QUOTE Eval))
then (CADR e)
elseif (EQ (CAR e)
(QUOTE Not))
then [BQUOTE (LNOT (EvalElt , (LIST (QUOTE QUOTE)
(CADR e]
elseif (EQ (CAR e)
(QUOTE LNot))
then [BQUOTE (LOGNOT (EvalElt , (LIST (QUOTE QUOTE)
(CADR e]
elseif (EQ (CAR e)
(QUOTE And))
then [BQUOTE (LAND (EvalElt , (CADR e))
(EvalElt , (CADDR e]
elseif (EQ (CAR e)
(QUOTE Rec))
then (BQUOTE (fetch (MI , (CADDDR e)) of , (CADR e)))
elseif (EQ (CAR e)
(QUOTE Concat))
then [PRINT (BQUOTE (ConcatBits (QUOTE , (CADR e]
elseif (AND (LISTP e)
(CADR e)
(NOT (CADDR e))
(LISTP (CADR e)))
then (BQUOTE (fetch , (CADR e) of , (CAR e)))
elseif (AND (LISTP e)
(CADR e)
(NOT (CADDR e)))
then (BQUOTE (fetch (MI , (CADR e)) of , (CAR e)))
else (QUOTE IGNOREMACRO])
(EvaluatePlaMacro
[LAMBDA (x) (* agb: " 4-Jun-86 08:56")
(PROG (Specs)
(SETQ Specs (EVALV (CAR x)))
(RETURN (BQUOTE (PROG (in (out 0))
[SETQ in (ConcatBits (QUOTE , (CAR Specs]
[FOR i in (QUOTE , (CADDR Specs))
when (EQP (CAR i)
(LOGAND in (CADR i)))
DO (SETQ out (LOGOR out (CADDR i]
(ExpandBits (QUOTE , (CADR Specs))
out])
(Mux-Macro
[LAMBDA (x) (* agb: " 4-Jun-86 08:52")
(BQUOTE (SELECTQ ,
(CAR x)
,@
(for ii in (CDR x)
as n from 0 when ii collect (LIST n ii))
(HELP])
)
(RPAQQ ILr1 (((1 Reset))
NIL NIL ((1 Cycle))
NIL NIL NIL NIL NIL))
(RPAQQ ILr4 (NIL NIL ((2 Cycle))
NIL NIL NIL NIL NIL))
(RPAQQ ILnormal (((0 Cycle))
NIL NIL NIL NIL NIL))
(RPAQQ ILreset (((1 Reset))
NIL NIL NIL NIL NIL))
(RPAQQ ILw4 (NIL NIL ((4 Cycle))
NIL NIL NIL NIL NIL))
(PUTPROPS EMULATORSUPPORT COPYRIGHT ("Xerox Corporation" 1986 1987))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1429 10023 (ExpandBitsMacro 1439 . 1944) (InitStackFrames 1946 . 2218) (CycleSetup 2220
. 3629) (CycleCheck 3631 . 4917) (DrawClocks 4919 . 6118) (DrawClockPoints 6120 . 7565) (RegMux 7567
. 7707) (ShowStats 7709 . 8302) (StartDrawClocks 8304 . 8914) (MonitorState 8916 . 9142) (MuxCode
9144 . 10021)) (10052 14662 (PrintIBufWordWrite 10062 . 10266) (PrintRegFileWrite 10268 . 10663) (
PrintInstStart 10665 . 14660)) (14708 21589 (ZZZ 14718 . 14828) (AV 14830 . 15004) (MakeWord 15006 .
15211) (MemoryAccess 15213 . 17290) (PrintData 17292 . 18606) (PrintMem 18608 . 19070) (StoreTamByte
19072 . 21116) (TamarinTypeBits 21118 . 21274) (TamarinType 21276 . 21471) (TamarinVal 21473 . 21587))
(21618 32391 (Mux-1 21628 . 21906) (Mux-2 21908 . 22210) (Mux-3 22212 . 22562) (Mux-4 22564 . 23093)
(Decoder 23095 . 23336) (LAND 23338 . 23485) (LOR 23487 . 23631) (LCMP 23633 . 23793) (LEQV 23795 .
23941) (LNOT 23943 . 24131) (TF 24133 . 24251) (OZ 24253 . 24452) (ConcatBits 24454 . 25252) (
ConcatBitsVal 25254 . 25643) (ExpandBits 25645 . 25872) (ExecuteClock 25874 . 26475) (EvalElt 26477 .
27524) (EvalEltSim 27526 . 27914) (Mod4 27916 . 28061) (Mod8 28063 . 28208) (PrintBits 28210 . 28526)
(PrintExpandBits 28528 . 28794) (ModCCodeRec 28796 . 29591) (MakeCondALst 29593 . 32389)) (32419 33923
(EvaluatePLA 32429 . 33249) (MakePlaSpec 33251 . 33921)) (33945 35153 (ExecuteClockCopy 33955 . 34560
) (MakePlaSpecOld 34562 . 35151)) (37056 40152 (ExecuteClockMacro 37066 . 37740) (EvalEltXMacro 37742
. 39309) (EvaluatePlaMacro 39311 . 39891) (Mux-Macro 39893 . 40150)))))
STOP