(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "10-Nov-87 16:06:51" {PHYLUM}<CTAMARIN>EMULATOR>TAMARINEMULATOR.;197 107733
changes to%: (PROPS (dpccode uField)
(euop uField)
(k uField))
(FNS MakeCondCodeArray TamTagRep AdderEUop MakeCondEntry TamRep UCodeCtl)
(VARS InitGVarLst)
previous date%: " 4-Nov-87 12:40:09" {PHYLUM}<CTAMARIN>EMULATOR>TAMARINEMULATOR.;192)
(* "
Copyright (c) 1985, 1986, 1987 by Xerox Corporation. All rights reserved.
")
(PRETTYCOMPRINT TAMARINEMULATORCOMS)
(RPAQQ TAMARINEMULATORCOMS
((* * Top Level - Abbreviations ↑ = Latched on Rising Edge (usually read state))
(FNS DoCycle DoSave SetClocks UpdateClocks MakeClocksVal ClockBit)
(OPTIMIZERS ClockBit)
(* * Register Mux & Context)
(FNS RegMux RegMuxSet Context)
(* * Register Access)
(FNS RegisterFile)
(* * Special Registers)
(FNS SpecialRegs)
(* * Program Counter control)
(FNS PcLogic)
(* * Next Opcode Functions)
(FNS IBufLogic SelectIBufByte)
(* * Memory)
(FNS MemCtl TLB AddrSel MemBuffer MemoryPins Memory)
(* * Execution Units)
(FNS ExecutionUnits ShiftEUop AdderEUop LogicalEUop PriorityEUop TagShifter TagLogic)
(* * Micro Control)
(FNS UCode UCodeCtl)
(* * Condition Codes)
(FNS DpCc EvalDpCc MakeCondCodeArray MakeCondEntry)
(* * Config)
(FNS TamRep TamTagRep TamSignBit GetTamTag GetTamTags GetTamTagLow GetTamTagsLow
GetTamDataVal GetTamPtrVal PutTamTag PutTamTags TamLogic)
(* * Section Definitions)
(FNS SetSectionInfo SetBusSizes)
(* * Old Procs)
(FNS CCodeMux UCodeMux PreCond OldMemCtl OldMemCtl2 MakeMemCtlPla MakeRamCtlPla)
(FUNCTIONS SetMemFlags)
(* * UCode fields)
(PROP uField addr label altcxt newbotcxt rcxt rd1addr rd2addr pcsrc wcxt memop euop tag
w2addr dswap raddr waddr newarg newarg2 newtopcxt newtos k k2 muxbus writet writef
jumpt jumpf misc aside bside oplength opmask memoffset dpccode euccode muxccode
memccode writeoctal clroplength latchpc latchfetchpc memlatchsrc physaddrsrc byteaddr
writedata writetags setflags clrflags forcedone)
(* * OpPla Fields)
(PROP uField2 forcenewop opname opnbr precond start preconditions unistart multistart)
(RECORDS MI OpD CondCode)
(VARS InitVarLst InitGVarLst fulltagmsk tagmsk fulltag&flagmsk VarsList MapConst)
(GLOBALVARS InitVarLst InitGVarLst fulltagmsk tagmsk fulltag&flagmsk VarsList MapConst
UCodeRomA UCodeRomB)
(FNS ADDMOD SUBMOD)))
(* * Top Level - Abbreviations ↑ = Latched on Rising Edge (usually read state))
(DEFINEQ
(DoCycle
[LAMBDA (startrunning) (* ; "Edited 6-May-87 12:48 by rtk")
(PROG NIL
(CycleSetup startrunning)
L1 (SetClocks 1)
(SetClocks 2)
(SetClocks 3)
(SetClocks 4 T)
(GO L1])
(DoSave
[LAMBDA NIL (* ; "Edited 13-Oct-87 16:22 by Krivacic")
(DECLARE (GLOBALVARS *LASTVECTORSECTION* *LASTSECTION*))
(SETQ *LASTVECTORSECTION* 'WholeChip)
(DoCycle T])
(SetClocks
[LAMBDA (clockcycle flg) (* ; "Edited 16-Oct-87 10:38 by Krivacic")
(DECLARE (GLOBALVARS *LASTVECTORSECTION* *LASTSECTION*))
(SetVal Reset RESET)
(SetVal Hold HOLD)
(SetVal Irq1 IRQ1)
(SetVal Irq2 IRQ2)
(SetVal 0 CLOCK2)
(SetVal 0 CLOCK)
(SELECTQ clockcycle
(1 (SetVal 1 CLOCK2)
(SetVal 1 CLOCK))
(2 (SetVal 1 CLOCK))
(3 (SetVal 1 CLOCK2))
(4 NIL)
NIL)
(UpdateClocks)
(if (OR Debugging)
then (PRINTOUT T "Cycle: " clockcycle T))
(NodelessSimStep (OR (EQ clockcycle 1)
(EQ clockcycle 3)))
(MonitorState flg)
(CycleCheck clockcycle])
(UpdateClocks
[LAMBDA (clock2 clock writeok done) (* ; "Edited 22-Jun-87 11:04 by Krivacic")
(SetVal (MakeClocksVal (OR clock2 (fetch (WireRec newvalue) of CLOCK2)
0)
(OR clock (fetch (WireRec newvalue) of CLOCK)
0)
(OR writeok (fetch (WireRec newvalue) of WRITEOK)
0)
(OR done (fetch (WireRec newvalue) of DONE)
0))
CLOCKS])
(MakeClocksVal
[LAMBDA (clock2 clock writeok done forceclocks) (* ; "Edited 19-Jun-87 14:29 by Krivacic")
(if forceclocks
then (SetVal clock2 CLOCK2)
(SetVal clock CLOCK)
(SetVal writeok WRITEOK)
(SetVal done DONE))
(ConcatBits '((clock2 (ClockBit 'Clock2)
1 0)
(clock (ClockBit 'Clock)
1 0)
(writeok (ClockBit 'WriteOk)
1 0)
((Not clock)
(ClockBit 'nClock)
2 0)
((Not clock2)
(ClockBit 'nClock2)
2 0)
(done (ClockBit 'Done)
1 0])
(ClockBit
[LAMBDA (name) (* ; "Edited 19-Jun-87 14:31 by Krivacic")
(SELECTQ name
(Clock2 5)
(Clock 4)
(WriteOk 3)
(Done 0)
(nClock 2)
(nClock2 1)
(HELP])
)
(DEFOPTIMIZER ClockBit (name) (IF [AND (LISTP name (EQ (CAR name)
'QUOTE]
THEN (SELECTQ (CADR name)
(Clock2 5)
(Clock 4)
(WriteOk 3)
(Done 0)
(nClock 2)
(nClock2 1)
(HELP))
ELSE 'IGNOREMACRO))
(* * Register Mux & Context)
(DEFINEQ
(RegMux
[LAMBDA NIL (* ; "Edited 3-Sep-87 11:39 by Krivacic")
(DefSection ((Inputs (D2Bus NewIBufN NewOpcode nStall Clocks Mi Mil))
(Outputs (RegAddr MuxBus Argis0 ArgisMux))
(Mi (K Raddr))
(Mil (NewTos NewArg NewArg2 OpMask Waddr MuxBus))
[↑Latches (((Clock)
(NextTos Tos)
(NextArg Arg)
(NextArg2 Arg2)
(NewRegMuxK ↑RegMuxK)
(NewRegMuxOpcode ↑RegMuxOpcode)
(NewRegMuxIBufN ↑RegMuxIBufN]
(Code ((LET (Load LoadK NewOp)
(DECLARE (LOCALVARS Load LoadK NewOp))
(* ;; "Set the Load Controls")
(SETQ NewOp (LAND Done (LNOT Clock)))
(SETQ LoadK (LAND nStall (LNOT Clock)))
[SETQ Load (LOR Clock (LAND WriteOk (LNOT Clock]
(* ;; "Do the Load Muxing")
(SETQ NewRegMuxOpcode (Mux-1 NewOp ↑RegMuxOpcode NewOpcode))
(SETQ NewRegMuxIBufN (Mux-1 NewOp ↑RegMuxIBufN NewIBufN))
(SETQ NewRegMuxK (Mux-1 LoadK ↑RegMuxK Mi-K))
(* ;; "Set The MuxBus ")
(SETQ MuxBus (Mux-4 Mil-MuxBus NIL Tos Arg Arg2 ↑RegMuxIBufN
(LOGAND ↑RegMuxOpcode
(Mux-2 Mil-OpMask 255 255 15 7))
↑RegMuxK
[ConcatBits '((D2Bus 0 8 0]
NIL))
(* ;; "Set The New Reg Values")
(SETQ NextTos (RegMuxSet Tos Mil-NewTos MuxBus Load))
(SETQ NextArg (RegMuxSet Arg Mil-NewArg MuxBus Load))
(SETQ NextArg2 (RegMuxSet Arg2 Mil-NewArg2 MuxBus Load))
(* ;; "Compute RegAddr")
(SETQ RegAddr (Mux-4 (Mux-1 Clock Mi-Raddr Mil-Waddr)
NIL NextTos NextArg NextArg2 NewRegMuxIBufN
[ConcatBits '((NewRegMuxOpcode 0 4 0]
[ConcatBits '((NewRegMuxK 0 6 0]
NIL))
(* ;; "Set Condition Code Flags ")
(SETQ Argis0 (OZ (EQ Arg 0)))
[SETQ ArgisMux (AND MuxBus (OZ (EQ Arg MuxBus]
(if Debugging
then (PRINTOUT T "RegAddr:" RegAddr " WriteOk:" WriteOk " Clock: "
Clock T])
(RegMuxSet
[LAMBDA (value selector muxbus ok) (* ; "Edited 2-Sep-87 16:45 by Krivacic")
(* ;; "selector bits:")
(* ;; " 3 = Select Register, 0 - 0, 1 - Reg ")
(* ;; " 21 = Select B operand / Operation, ")
(* ;; " 00= A + c")
(* ;; " 01= A + B + c")
(* ;; " 10 = A - B + c")
(* ;; " 0 = Select Carry, 0 - NoCarry, 1 - Carry")
(* ;; " Formula: (Select Register +- Select Value + Select Carry)")
(PROG* [(muxval (if muxbus
then muxbus
else 0))
[selectreg (ConcatBits '((selector 0 1 3]
[selectop (ConcatBits '((selector 0 2 1]
[selectcarry (ConcatBits '((selector 0 1 0]
(selreg (Mux-1 selectreg 0 value))
(selval (Mux-2 selectop 0 muxval (LOGNOT muxval)
NIL))
(result (Mux-1 ok value (ConcatBits '(((Eval (PLUS selreg selval selectcarry))
0 8 0]
(RETURN result])
(Context
[LAMBDA NIL (* ; "Edited 15-Sep-87 14:40 by Krivacic")
(DefSection ((Inputs (WriteOk Clock Mi Mil))
(Outputs (RegCxt FramesEmpty FramesFull))
(Mi (AltCxt RCxt K))
(Mil (WCxt NewTopCxt NewBotCxt))
[↑Latches (((Clock)
(NewTopCxt TopCxt)
(NewBotCxt BotCxt)
(NewAltCxt AltCxt]
(Code ((SETQ NewTopCxt (Mux-1 WriteOk TopCxt (Mux-1 Mil-NewTopCxt TopCxt AltCxt)))
(SETQ NewBotCxt (Mux-1 WriteOk BotCxt (Mux-1 Mil-NewBotCxt BotCxt AltCxt)))
(SETQ NewAltCxt (Mux-4 Mi-AltCxt NewTopCxt (ADDMOD NewTopCxt)
(SUBMOD NewTopCxt)
NewBotCxt
(ADDMOD NewBotCxt)
(SUBMOD NewBotCxt)
[ConcatBits '((Mi-K 0 3 6]
4))
(SETQ RegCxt (Mux-1 Clock (Mux-1 Mi-RCxt NewTopCxt NewAltCxt)
(Mux-1 Mil-WCxt TopCxt AltCxt)))
(* ;; "Set Condition Flags")
(SETQ FramesEmpty (LEQV TopCxt BotCxt))
(SETQ FramesFull (LEQV (ADDMOD TopCxt)
BotCxt])
)
(* * Register Access)
(DEFINEQ
(RegisterFile
[LAMBDA NIL (* ; "Edited 1-Oct-87 18:55 by Krivacic")
(DefSection ((Inputs (RBus WriteOk RegAddr RegCxt Clocks Mil))
(Outputs (D1Bus D2Bus))
(Mil (RD1addr RD2addr Dswap Waddr WriteOctal))
[↑Latches (((Clock)
(FullRegAddr ReadAddr))
(((Not Clock))
(FullRegAddr WriteAddr]
(Code (PROG [temp (writeback (OZ (NEQ Mil-Waddr 0)))
(d1 (RegGet ReadAddr))
(d2 (RegGet (SUB1 ReadAddr]
(DECLARE (GLOBALVARS *LATCHREGD1* *LATCHREGD2*))
[SETQ FullRegAddr (ConcatBits '((RegAddr 0 6 0)
(RegCxt 6 3 0]
(SETQ D1Bus (Mux-1 Clock *LATCHREGD1* (Mux-4 Mil-RD1addr
(Mux-1 Mil-Dswap d1 d2)
NIL)))
(SETQ D2Bus (Mux-1 Clock *LATCHREGD2* (Mux-4 Mil-RD2addr
(Mux-1 Mil-Dswap d2 d1)
NIL)))
(SETQ *LATCHREGD1* D1Bus)
(SETQ *LATCHREGD2* D2Bus)
(if (TF (LAND WriteOk writeback (LNOT Clock2)
(LNOT Clock)))
then (RegSet WriteAddr RBus Mil-WriteOctal])
)
(* * Special Registers)
(DEFINEQ
(SpecialRegs
[LAMBDA NIL (* ; "Edited 23-Oct-87 11:41 by Krivacic")
(DefSection ((Inputs (RBus MuxBus Clocks Mil))
(Outputs (D1Bus D2Bus))
(Mil (RD1addr RD2addr W2addr))
[↑Latches (((Clock WriteOk)
(NewTemp1 ↑Temp1]
(Code ((SETQ D1Bus (Mux-1 [ConcatBits '((Mil-RD1addr 0 1 3]
NIL
(Mux-4 [ConcatBits '((Mil-RD1addr 0 3 0]
↑Temp1 MuxBus (TamRep 0)
(TamRep -1)
NIL)))
(SETQ D2Bus (Mux-1 [ConcatBits '((Mil-RD2addr 0 1 3]
NIL
(Mux-4 [ConcatBits '((Mil-RD2addr 0 3 0]
↑Temp1 MuxBus (TamRep 'NIL)
(TamRep 'T)
(TamRep 0)
(TamRep 'Unbound)
(TamRep 'Symbol)
(TamRep 'PtrMask)
NIL)))
(SETQ NewTemp1 (Mux-1 (OZ (EQ Mil-W2addr 7))
↑Temp1 RBus])
)
(* * Program Counter control)
(DEFINEQ
(PcLogic
[LAMBDA NIL (* ; "Edited 1-Oct-87 17:24 by Krivacic")
(DefSection ((Inputs (D1Bus MuxBus PcWriteOk DoLatchPc ↑OpLength Clocks Mil))
(Outputs (D2Bus RdAddr))
(Mil (RD2addr PcSrc))
[↑Latches (((Clock)
(NextPc CurPc]
(Props (PcSrc RD2addr))
(Code (
(* ;; " Next Pc Values")
(LET (pcmux readpc)
(* ;; "Set the Pc Mux Value")
(SETQ pcmux (COND
((AND (EQ Mil-PcSrc PcSrc-D1)
(TF PcWriteOk))
3)
((AND (EQ Mil-PcSrc PcSrc-MuxBus)
(TF PcWriteOk))
2)
([AND (EQ Mil-PcSrc PcSrc-NextPc)
(TF (LOR Done (LAND DoLatchPc nStall]
1)
(T 0)))
(* ;; "Set the Next Pc Latch Value")
(SETQ readpc (PLUS ↑OpLength CurPc))
(SETQ NextPc (Mux-2 pcmux CurPc readpc
[ConcatBits '((CurPc 8 24 8)
(MuxBus 0 8 0]
D1Bus))
(* ;; "Check Read Pc Addrs")
(if (EQ RD2addr-NextPc Mil-RD2addr)
then (SETQ D2Bus readpc))
(* ;; "Set IBuf Read Addr ")
[SETQ RdAddr (ConcatBits '((readpc 0 5 0]
(* PRINTOUT T "pcmux " pcmux " PcSrc " Mil-PcSource " NxPc " NextPc " readpc "
readpc " ↑OpLn " ↑OpLength " Pc " CurPc " D1 " D1Bus " Mux " MuxBus T)
])
)
(* * Next Opcode Functions)
(DEFINEQ
(IBufLogic
[LAMBDA NIL (* ; "Edited 2-Oct-87 15:49 by Krivacic")
(DefSection ((Inputs (XBus WrAddr RdAddr WrIBuf Done Clocks Mil))
(Outputs (D1Bus NewIBufN NewOpcode OpValid IBufFull))
(Mil (RD1addr))
(Accessables (Clock))
[↑Latches (((Clock Done)
(NewIBufData ↑IBufData]
(Code ([if (TF (LAND WrIBuf (LNOT Clock)))
then (* PRINTOUT T "IBuf[" WrAddr "]←"
(ConcatBits (QUOTE (
(XBus 0 32 0)))) T)
(SETA IBufReg WrAddr (ConcatBits '((XBus 0 32 0]
(SETQ NewIBufN (SelectIBufByte RdAddr 1))
[SETQ NewIBufData (ConcatBits '((NewIBufN 0 8 0)
((Eval (SelectIBufByte RdAddr 2))
8 8 0)
((Eval (SelectIBufByte RdAddr 3))
16 8 0)
((Eval (SelectIBufByte RdAddr 4))
24 8 0]
(SETQ NewOpcode (SelectIBufByte RdAddr 0))
(* ;; " Set D1 to Masked ↑IBufData")
(SETQ D1Bus
(Mux-4 [ConcatBits '((Mil-RD1addr 0 2 2]
NIL
[ConcatBits '((↑IBufData 0
(Mux-4 [ConcatBits '((Mil-RD1addr 0 2 0]
24 32 8 16)
0]
NIL NIL))
(* ;; "Set condition flags")
(LET [(RdWord (ConcatBits '((RdAddr 0 3 2]
(SETQ IBufEmpty (OZ (EQ RdWord WrAddr)))
[SETQ IBufFull (OZ (EQ [ConcatBits '(((Eval (SUB1 RdWord))
0 3 0]
(ConcatBits '(((Eval (ADD1 WrAddr))
0 3 0]
(SETQ OpValid (LAND (LNOT IBufEmpty)
(OZ (NEQ [ConcatBits '(((Eval (ADD1 RdWord))
0 3 0]
WrAddr])
(SelectIBufByte
[LAMBDA (Pc byteoffset) (* ; "Edited 8-May-87 12:03 by rtk")
(PROG (wordindex offset)
[SETQ wordindex (ConcatBits '(((Eval (PLUS Pc byteoffset))
0 3 2]
[SETQ offset (ConcatBits '(((Eval (PLUS Pc byteoffset))
0 2 0]
(RETURN (ConcatBits '(((Eval (ELT IBufReg wordindex))
0 8 (TIMES 8 offset])
)
(* * Memory)
(DEFINEQ
(MemCtl
[LAMBDA NIL (* ; "Edited 5-Oct-87 18:27 by Krivacic")
(DefSection ((Inputs (DpCondRes IBufFull Reset Hold Clocks Mil))
(Outputs (MemCtlCondRes nStall HoldA EnbBufs WriteCycle RasEnable CasEnable WrIBuf))
(Mil (MemOp MemCCode WriteTags WriteData))
[↑Latches (((Clock (Not Reset))
(nxPcRas PcRas)
(nxPcCas PcCas)
(nxData Data)
(nxHold Holding)
(nxIdle Idling))
((Clock Reset)
(0 PcRas)
(0 PcCas)
(1 Data)
(0 Holding)
(0 Idling]
(Props (MemOp))
(Code ((DECLARE (GLOBALVARS MemOp=Cas MemOp=Ras MemOp=Map MemOp=Pc nMemOp=Pc nHold
nIBufFull nPhi0 Phi1 LastRasEnable ClrRas SetRas))
(* ;; "setup Combinatoial logic")
(SETQ nPhi0 (LNAND Clock Clock2))
(SETQ Phi1 (LAND Clock (LNOT Clock2)))
(SETQ MemOp=Cas (OZ (EQ Mil-MemOp MemOp-Cas)))
(SETQ MemOp=Ras (OZ (EQ Mil-MemOp MemOp-Ras)))
(SETQ MemOp=Map (OZ (EQ Mil-MemOp MemOp-Map)))
(SETQ MemOp=Pc (OZ (EQ Mil-MemOp MemOp-Pc)))
(SETQ nMemOp=Pc (LNOT MemOp=Pc))
(SETQ nHold (LNOT Hold))
(SETQ nIBufFull (LNOT IBufFull))
(* ;; "setup next latch states")
(SETQ nxPcRas (LAND Idling MemOp=Pc nHold nIBufFull))
(SETQ nxPcCas (LOR PcRas (LAND PcCas MemOp=Pc nHold)))
(SETQ nxData (LOR (LAND Idling nMemOp=Pc nHold)
(LAND Data nMemOp=Pc)))
(SETQ nxHold (LOR (LAND Idling Hold)
(LAND PcCas Hold)
(LAND MemOp=Pc Data Hold)
(LAND Holding Hold)))
(SETQ nxIdle (LOR (LAND Idling MemOp=Pc IBufFull nHold)
(LAND Data MemOp=Pc nHold)
(LAND PcCas nMemOp=Pc nHold)
(LAND Holding nHold)))
(SETQ nStall (LOR nxData MemOp=Pc))
(SETQ HoldA nxHold)
(SETQ WrIBuf (LAND nIBufFull PcCas))
(SETQ CasEnable (LAND nPhi0 (LOR (LAND MemOp=Cas Data)
WrIBuf)))
(* SETQ SetRas (LAND Phi1
(LOR (LAND MemOp=Pc PcRas) MemOp=Ras)))
(SETQ SetRas (LAND Phi1 (LOR PcRas MemOp=Ras)))
[SETQ ClrRas (LAND Phi1 (LOR Idling Holding (LAND Data MemOp=Map]
(SETQ RasEnable LastRasEnable)
(if (TF SetRas)
then (SETQ RasEnable 1))
(if (TF ClrRas)
then (SETQ RasEnable 0))
(SETQ LastRasEnable RasEnable)
(SETQ MemCtlCondRes 1)
(SETQ EnbBufs (LNOT HoldA))
(SETQ WriteCycle (LAND EnbBufs (LOR Mil-WriteTags Mil-WriteData])
(TLB
[LAMBDA NIL (* ; "Edited 8-Sep-87 17:27 by Krivacic")
(DefSection ((Inputs (D1Bus XBus ClockTlb Clocks Mil))
(Outputs (MapAddr PageFault TlbMiss RWAccess))
[↑Latches (((Clock)
(NewTLBIndex TLBIndex]
(Mil (MemOp WriteTags WriteData ByteAddr))
(Props (MemOp))
(Code ((LET [(matchpage 0)
(pagevalid 0)
(pagedirty 0)
(tlbhit 0)
(memread (LAND (LNOT Mil-WriteTags)
(LNOT Mil-WriteData]
(* ;; "Initial Address setup")
[SETQ MapAddr (Mux-1 Mil-ByteAddr D1Bus
(ConcatBits '((D1Bus 0 28 2]
[SETQ vmpage (ConcatBits '((MapAddr 0 16 10]
[SETQ RealAddr (OZ (EQ 0 (ConcatBits '((MapAddr 0 4 22]
(* ;; "Write New TLB entry")
[if [TF (LAND ClockTlb (LNOT (OR Clock2 Clock]
then (SETA VMCmpArray TLBIndex vmpage)
[SETA VMResArray TLBIndex (ConcatBits '((XBus 0 16 0]
(SETQ NewTLBIndex (ConcatBits '(((Eval (ADD1 TLBIndex))
0 3 0]
(* ;; "TLB lookup")
[for i from 0 to (SUB1 (ARRAYSIZE VMCmpArray))
when (AND (TF (LNOT RealAddr))
(EQ vmpage (ELT VMCmpArray i)))
do [SETQ matchpage (ConcatBits '(((Eval (ELT VMResArray i))
0 12 0]
(SETQ tlbhit 1)
[SETQ pagevalid (ConcatBits '(((Eval (ELT VMResArray i))
0 1 12]
[SETQ pagedirty (ConcatBits '(((Eval (ELT VMResArray i))
0 1 13]
(SETQ MapAddr (ConcatBits '((matchpage 10 13 0)
(MapAddr 0 10 0]
(* ;; "Return Results & Flags")
(SETQ TlbMiss (LNOT (LOR RealAddr tlbhit)))
[SETQ PageFault (LNOT (LOR RealAddr TlbMiss (Mux-1 memread pagedirty
pagevalid]
(SETQ RWAccess (LOR RealAddr TlbMiss (LAND pagedirty pagevalid)))
(if (TF PageFault)
then (HELP])
(AddrSel
[LAMBDA NIL (* ; "Edited 10-Sep-87 17:34 by Krivacic")
(DefSection ((Inputs (MapAddr MuxBus WrIBuf Clocks Mil))
(Outputs (PhyAddr WrAddr))
(Mil (MemOp MemOffset PhysAddrSrc MemLatchSrc K2 LatchFetchPc))
[↑Latches (((Clock LatchPhys)
(NewLatchAddrHi PhysHi)
(NewLatchAddrLo PhysLo))
((Clock LatchFetchPc)
(NewLatchAddrHi FetchPcHi)
(NewLatchAddrLo FetchPcLo]
(Internals (LatchFetchPc LatchPhys))
(Code ((LET (mem-offset phys-addr phys-addr-hi phys-addr-lo addr-input-lo)
(* ;; " Select Physical Address")
(SETQ phys-addr-lo (Mux-1 Mil-PhysAddrSrc FetchPcLo PhysLo))
(SETQ phys-addr-hi (Mux-1 Mil-PhysAddrSrc FetchPcHi PhysHi))
[SETQ PhyAddr (ConcatBits '((phys-addr-hi 8 24 0)
(phys-addr-lo 0 8 0]
(* ;; "Select Adder Input for Add")
(SETQ mem-offset (Mux-1 Mil-MemOffset Mil-K2 MuxBus))
[SETQ addr-input-lo (Mux-2 Mil-MemLatchSrc phys-addr-lo 0
(ConcatBits '((MapAddr 0 8 0]
(* ;; "Do the Add & Create the New Addrs for the latches")
[SETQ NewLatchAddrHi (Mux-2 Mil-MemLatchSrc phys-addr-hi phys-addr-hi
(ConcatBits '((MapAddr 0 24 8]
[SETQ NewLatchAddrLo (ConcatBits '(((Eval (PLUS mem-offset addr-input-lo
))
0 8 0]
(* ;; "Perform the Combinatorial Logic")
[SETQ WrAddr (ConcatBits '((FetchPcLo 0 3 0]
[SETQ LatchPhys (LAND WriteOk (OZ (NEQ 0 Mil-MemOp]
(SETQ LatchFetchPc (LNAND (LNOT WrIBuf)
(LNAND WriteOk Mil-LatchFetchPc])
(MemBuffer
[LAMBDA NIL (* ; "Edited 23-Oct-87 12:31 by Krivacic")
(DefSection ((Inputs (D2Bus XBus WriteCycle Mil))
(Outputs (RBus XBus))
(Mil (EUop))
(Code (
(* ;; "Drive RBus if reading")
[SETQ RBus (Mux-1 [OZ (EQ 0 (ConcatBits '((Mil-EUop 0 3 4]
NIL
(Mux-1 [ConcatBits '((Mil-EUop 0 1 0]
[ConcatBits '((XBus 0 34 0]
(ConcatBits '((XBus 0 6 34]
(* ;; "Drive XBus if writing")
(SETQ XBus (Mux-1 WriteCycle NIL (ConcatBits '((D2Bus 0 34 0)
(D2Bus 34 6 0])
(MemoryPins
[LAMBDA NIL (* ; "Edited 17-Sep-87 15:53 by Krivacic")
(DefSection ((Inputs (PhyAddr RasEnable CasEnable Mil))
(Outputs (nRas nCas Ra Pa))
(Mil (WriteTags WriteData))
(Code ((SETQ nRas (LNOT RasEnable))
(SETQ nCas (LNOT CasEnable))
[SETQ Ra (ConcatBits '((PhyAddr 0 2 20]
(LET [[RasPa (ConcatBits '((PhyAddr 0 10 10]
(CasPa (ConcatBits '((PhyAddr 0 10 0]
(SETQ Pa (Mux-1 RasEnable NIL (Mux-1 CasEnable RasPa CasPa])
(Memory
[LAMBDA NIL (* ; "Edited 23-Oct-87 18:24 by Krivacic")
(DefSection
((Inputs (nRas nCas Ra Pa WriteCycle XBus Reset Clocks Mil))
(Outputs (XBus))
(Mil (WriteTags WriteData))
(Code
((DECLARE (GLOBALVARS (*memory-data* *memory-addr*)))
(* ;; " This code dummies External Memory")
(if (NOT (TF Reset))
then
(LET [[memoryactive (TF (LNOT (LAND nRas nCas]
(cascycle (TF (LNOT nCas)))
(rascycle (TF (LNOT nRas]
(if (TF (LNOT Clock))
then [if cascycle
then [SETQ *memory-addr* (ConcatBits '((Pa 0 10 0)
(*memory-addr* 10 12 10]
elseif rascycle
then (SETQ *memory-addr* (ConcatBits '((Pa 10 10 0)
(Ra 20 2 0]
(if cascycle
then (SETQ *memory-data* (MemoryAccess [ConcatBits
'((*memory-addr* 0 22 0]
NIL
(TF WriteCycle)))
(if (TF WriteCycle)
then [SETQ *memory-data*
(ConcatBits '(((Eval (Mux-1 Mil-WriteData *memory-data*
XBus))
0 34 0)
((Eval (Mux-1 Mil-WriteTags *memory-data*
XBus))
34 6 34]
(MemoryAccess *memory-addr* *memory-data*)
(SETQ XBus NIL)
else (SETQ XBus *memory-data*))
else (SETQ XBus NIL))
else (SETQ XBus NIL])
)
(* * Execution Units)
(DEFINEQ
(ExecutionUnits
[LAMBDA NIL (* ; "Edited 28-Oct-87 10:03 by Krivacic")
(DefSection ((Inputs (D1Bus D2Bus MuxBus Mil))
(Outputs (RBus EuCondRes))
(Mil (EUop EuCCode Tag))
(Code ((PROG [carry overflow greaterp r TagBits
(EuCtl (ConcatBits '((Mil-EUop 0 4 0]
(DECLARE (CL:SPECIAL carry overflow greaterp))
(* ;; "compute flags (sets Specials)")
(SETQ r (AdderEUop EuCtl D2Bus D1Bus))
(SETQ r (SELECTQ [ConcatBits '((Mil-EUop 0 3 4]
(1 r)
(2 (LogicalEUop EuCtl D1Bus D2Bus))
(3 (ShiftEUop D1Bus D2Bus MuxBus))
(4 (PriorityEUop D1Bus))
(5 (TagShifter EuCtl D1Bus D2Bus))
(6 (LdMult D1Bus D2Bus))
(7 (UnLdMult))
NIL))
(* ;; "setup result tag")
(SETQ TagBits (TagLogic Mil-Tag D1Bus D2Bus))
(* ;; "return result")
[if r
then (SETQ RBus (ConcatBits '((TagBits 32 2 0)
(r 0 32 0]
(SETQ EuCondRes (Mux-2 Mil-EuCCode 1 (LNOT overflow)
carry greaterp 0 0 0 0])
(ShiftEUop
[LAMBDA (Top Bottom ShiftAmount) (* ; "Edited 28-Oct-87 10:02 by Krivacic")
(LET* [[shiftsize (if (EQ 32 ShiftAmount)
then ShiftAmount
else (ConcatBits '((ShiftAmount 0 5 0]
(toppos shiftsize)
(topwidth (DIFFERENCE 32 shiftsize))
(botwidth shiftsize)
(botstart (DIFFERENCE 32 shiftsize))
(Top (ConcatBits '((Top 0 32 0]
(ConcatBits '((Top toppos topwidth 0)
(Bottom 0 botwidth botstart])
(AdderEUop
[LAMBDA (Adderop a b) (* ; "Edited 9-Nov-87 12:44 by Krivacic")
(DECLARE (CL:SPECIAL carry overflow greaterp))
(PROG (r [ashort (ConcatBits '((a 0 32 0]
[bshort (ConcatBits '((b 0 32 0]
[bshort2 (ConcatBits '((b 0 32 0]
(asignbit (TamSignBit a))
(bsignbit (TamSignBit b))
(bspsign (TamSignBit b)))
(* * compute result)
(SETQ r (SELECTQ Adderop
(* ;; " a + b")
(0 (IPLUS ashort bshort))
(* ;; " a + b + carry")
(1 (IPLUS ashort bshort 1))
(* ;; " a - b + carry (2s compliment)")
(9 (SETQ bshort (ADD1 (LOGXOR bshort 4294967295)))
(SETQ bspsign (LOGXOR bspsign 1))
(IPLUS ashort bshort))
(* ;; " a - b (1s compliment)")
(8 (SETQ bshort (LOGXOR bshort 4294967295))
(SETQ bspsign (LOGXOR bspsign 1))
(IPLUS ashort bshort))
0))
(* * compute flags)
(SETQ carry (LOADBYTE r 32 1))
[SETQ overflow (LAND (LEQV bspsign asignbit)
(LNOT (LEQV (TamSignBit r)
bspsign]
(SETQ greaterp (Mux-1 (LOR (LAND asignbit (LNOT bspsign))
(LAND (LNOT asignbit)
bspsign))
bsignbit carry))
(* * return result)
(RETURN (ConcatBits '((r 0 32 0])
(LogicalEUop
[LAMBDA (LuEUop Op1 Op2) (* ; "Edited 17-Jul-87 12:50 by Krivacic")
(PROG [r [DD1 (ConcatBits '((Op1 0 32 0]
(DD2 (ConcatBits '((Op2 0 32 0]
(* * compute result)
(RETURN (SELECTQ LuEUop
(1 (LOGAND DD1 DD2))
(6 (LOGXOR DD1 DD2))
(7 (LOGOR DD1 DD2))
(8 (LOGNOT (LOGOR DD1 DD2)))
(14 (LOGNOT (LOGAND DD1 DD2)))
(3 DD1)
(5 DD2)
0])
(PriorityEUop
[LAMBDA (Value) (* ; "Edited 10-Jun-87 17:16 by Krivacic")
(PROG [(Val (ConcatBits '((Value 0 32 0]
(RETURN (for i from 31 to 0 by -1 while [EQ 0 (ConcatBits '((Value 0 1 i] count 1])
(TagShifter
[LAMBDA (EuCtl D1Bus D2Bus) (* ; "Edited 6-Oct-87 10:48 by Krivacic")
(* ;; " 1 Merge Subtype (D2<7> | D1 < 27>)")
(* ;; " 0 Get Type D1<7> RSH 27")
(SELECTQ EuCtl
(0 (GetTamTags D1Bus))
(1 (PutTamTags (GetTamTagsLow D2Bus)
D1Bus))
NIL])
(TagLogic
[LAMBDA (↑uTag D1Bus D2Bus) (* ; "Edited 5-Oct-87 16:43 by Krivacic")
(Mux-4 ↑uTag (GetTamTag D2Bus)
(GetTamTag D1Bus)
(GetTamTagLow D2Bus)
(GetTamTagLow (TamTagRep 'Int])
)
(* * Micro Control)
(DEFINEQ
(UCode
[LAMBDA NIL (* ; "Edited 8-Jul-87 11:09 by Krivacic")
(DefSection ((Inputs (nStall NewOpcode PreCondAddr UCodeSel nUCodeSel Clocks))
(Outputs (Mi Mil))
(Accessables (Mil))
(Mil (NextInstA NextInstB))
[↑Latches (((Clock)
(Mi Mil]
(Code ((LET (aaddr)
(SETQ aaddr (SELECTQ nUCodeSel
(7 (OR (AND (NUMBERP Mil-NextInstA)
Mil-NextInstA)
0))
(11 PreCondAddr)
(13 [ConcatBits '((NewOpcode 3 5 3])
(14 NewOpcode)
0))
(* PRINTOUT T "aaddr " aaddr " nUCodeSel " nUCodeSel " nStall " nStall " UCodeSel "
UCodeSel T)
[SETQ MIR (Mux-1 nStall Mil (Mux-1 UCodeSel (ELTMI UCodeRomB
Mil-NextInstB)
(ELTMI UCodeRomA aaddr]
(if [NOT (AND MIR (TYPENAMEP MIR 'MI]
then (SETQ MIR NilMir))
(SETQ Mi MIR])
(UCodeCtl
[LAMBDA NIL (* ; "Edited 4-Nov-87 17:49 by Krivacic")
(DefSection ((Inputs (Argis0 ArgisMux FramesEmpty FramesFull EuCondRes DpCondRes MemCtlCondRes
NewOpcode PreConds nStall Mil))
(Outputs (PreCondAddr UCodeSel nUCodeSel WriteOk Done))
(Mil (InvertCCode MuxCCode WriteT WriteF Done ForceDone))
(Code ((LET (ForceNewOp SelPreCond CondRes done-or RegMuxCondRes)
(SETQ RegMuxCondRes (Mux-4 Mil-MuxCCode 1 FramesFull FramesEmpty 0
ArgisMux (LNOT ArgisMux)
Argis0
(LNOT Argis0)))
(* ;; "CCodeMux")
(SETQ CondRes (LAND RegMuxCondRes EuCondRes DpCondRes MemCtlCondRes))
(* ;; "Precondition Logic")
(SETQ PreCondAddr (COND
([TF (ConcatBits '((PreConds 0 1 7]
1)
([TF (ConcatBits '((PreConds 0 1 6]
2)
([TF (ConcatBits '((PreConds 0 1 5]
4)
([TF (ConcatBits '((PreConds 0 1 4]
8)
([TF (ConcatBits '((PreConds 0 1 3]
16)
([TF (ConcatBits '((PreConds 0 1 2]
32)
(T 0)))
[SETQ ForceNewOp (ConcatBits '((PreConds 0 1 7]
(SETQ SelPreCond (OZ (NEQ PreConds 0)))
(* ;; "UCode Ctl Logic")
(SETQ Done (LAND (LOR (LAND Mil-Done (LXOR CondRes Mil-InvertCCode))
Mil-ForceDone)
(LNOT ForceNewOp)
nStall))
(SETQ done-or (LOR (LAND (LXOR CondRes Mil-InvertCCode)
Mil-Done)
ForceNewOp Mil-ForceDone))
(SETQ WriteOk (LAND (LOR (LAND CondRes Mil-WriteT)
(LAND (LNOT CondRes)
Mil-WriteF))
nStall))
(SETQ UCodeSel (LOR ForceNewOp (LXOR CondRes Mil-InvertCCode)
Mil-ForceDone))
(LET* [[singleop (ConcatBits '((NewOpcode 0 1 7]
(term1 (LNOT (LAND done-or SelPreCond)))
[term2 (LNOT (LAND done-or (LNOT SelPreCond)
(LNOT singleop]
(term3 (LNOT (LAND done-or (LNOT SelPreCond)
singleop]
(* ;; "above placed in terms to compile faster")
(SETQ nUCodeSel (ConcatBits '((done-or 3 1 0)
(term1 2 1 0)
(term2 1 1 0)
(term3 0 1 0])
)
(* * Condition Codes)
(DEFINEQ
(DpCc
[LAMBDA NIL (* ; "Edited 6-Oct-87 18:34 by Krivacic")
(DefSection ((Inputs (D1Bus D2Bus RBus Mil))
(Outputs (DpCondRes))
(Mil (DpCCode))
(Code ((PROG (r)
(SETQ r (ELT CondAArray Mil-DpCCode))
(SETQ DpCondRes 0)
(if (LISTP r)
then [for or-elements in r until (TF DpCondRes)
do (SETQ DpCondRes (LOR DpCondRes (EvalDpCc or-elements
D1Bus D2Bus]
else (SETQ DpCondRes (EvalDpCc r D1Bus D2Bus])
(EvalDpCc
[LAMBDA (dp-ccode-info d1-bus d2-bus) (* ; "Edited 24-Aug-87 14:44 by Krivacic")
(OZ (EQ 0 (LOGOR (LOGAND (LOGNOT d1-bus)
(fetch (CondCode D1) of dp-ccode-info))
(LOGAND (LOGNOT d2-bus)
(fetch (CondCode D2) of dp-ccode-info))
(LOGAND d1-bus (fetch (CondCode nD1) of dp-ccode-info))
(LOGAND d2-bus (fetch (CondCode nD2) of dp-ccode-info))
(LOGAND (LOGXOR d1-bus d2-bus)
(fetch (CondCode D1xorD2) of dp-ccode-info])
(MakeCondCodeArray
[LAMBDA NIL (* ; "Edited 10-Nov-87 14:18 by Krivacic")
(SETQ CondAArray
(ARRAY 64 'POINTER
(create CondCode
D1 ← 0
D2 ← 0
nD1 ← 0
nD2 ← 0
D1xorD2 ← 0)
0))
[MakeCondALst CondAArray '((FixP tagD1 Fix)
(FixPD2 tagD2 Fix)
(FixPD1D2 tagD1 Fix tagD2 Fix)
(PosFixP tagD1 Fix notbitD1 SignBitMask)
(PosFixPD2 tagD2 Fix notbitD2 SignBitMask)
(PosFixP<=32D2 (tagD2n 29 Fix)
(D2Eq 32))
(MinFixD2 D2Eq 536870912)
(FloatP tagD1 Float)
(FloatPD1D2 tagD1 Float tagD2 Float)
(FixPD1D2orFloatPD1D2 (tagD1 Fix tagD2 Fix)
(tagD1 Float tagD2 Float))
(ImmediateP tagD1n 3 Imm)
(UnboundP D1Eq Unbound)
(PointerP (tagD1n 3 Ptr1)
(tagD1 Ptr2))
(RefCountPtr (tagD1n 4 RcPtr1)
(tagD1 RcPtr2))
(PointerPD2 (tagD2n 4 Ptr1)
(tagD2 Ptr2))
(RefCountPtrD1orD2 (tagD1n 4 RcPtr1)
(tagD1 RcPtr2)
(tagD2n 4 RcPtr1)
(tagD2 RcPtr2))
(FixPD1PointerPD2 (tagD1 Fix tagD2n 3 Ptr1)
(tagD1 Fix tagD2 Ptr2))
(SymbolP tagmaskD1 (Symbol NoRcSymbol))
(FixPFloatPImmPSymbolPNumberPD1orD2 (tagmaskD1 (Symbol NoRcSymbol))
(tagD1 Fix)
(tagD1 Float)
(tagD1n 3 Imm)
(tagD1n 5 Number)
(tagmaskD2 (Symbol NoRcSymbol))
(tagD2 Fix)
(tagD2 Float)
(tagD2n 3 Imm)
(tagD2n 5 Number))
(CCodeP fulltagD1 Code)
(ClosureP fulltagD1 Closure)
(MethodP fulltagD1 Method)
(ConsP (fulltagD1 Cons)
(fulltagD1 SmallCons))
(SmallConsP fulltagD1 List)
(StackP fulltagD1 Stack)
(LastStackP fulltagD1 Stack)
(NumberP (tagD1 Fix)
(tagD1n 5 Number))
(NumberPD1D2 (tagD1 Fix tagD2 Fix)
(tagD1n 5 Number tagD2n 5 Number)
(tagD1n 5 Number tagD2 Fix)
(tagD1 Fix tagD2n 5 Number))
(D1=D2 wordEq 17179869183)
(D1FixLess8 tagD1 Fix valD1less8 0)
(D2<4>=15 D2Eqn 4 15)
(D2<4>=0or1 (D2Eqn 4 0)
(D2Eqn 4 1))
(D1<tags>=D2<tags> wordEq 17045651456)
(NilD2 D2Eq NIL)
(D1<8>=D2<8> wordEq 255)
(MVokD2 D2Eq 8)
(D2=Int<8&D1=Atom tagD2 Fix valD2less8 0 fulltagD1 Atm)
(D2=Int<8&D1=CCodeP tagD2 Fix valD2less8 0 fulltagD1 Code)
(NumberPD1D2orCharacterPD1D2 (tagD1n 5 Number tagD2n 5 Number)
(fulltagD1 Character fulltagD2 Character))
(CharacterPD1D2&D1<8>=D2<8> fulltagD1 Character fulltagD2 Character
wordEq 255)
(NumberPD1D2&D1<low2tags>=D2<low2tags> tagD1n 5 Number tagD2n 5 Number
wordEq 402653184)
[NotSlowReturnPD2 notbitD2 (EVAL (UProp 'SlowReturnMask 'k]
(SymbolPCCodePClosurePorMethodPD1&D2<8 (tagmaskD1 (Method Closure Code
)
tagD2n 31 Fix)
(tagmaskD1 (Symbol NoRcSymbol)
tagD2n 31 Fix))
(D2>127 bitD2 128]
(SETQ CondALst (for i from 0 to (SUB1 (ARRAYSIZE CondAArray)) collect (ELT CondAArray i])
(MakeCondEntry
[LAMBDA (cond-code-elt) (* ; "Edited 6-Nov-87 18:14 by Krivacic")
(LET (ccode r vl bits (count 3))
(SETQ r
(create CondCode
D1 ← 0
D2 ← 0
nD1 ← 0
nD2 ← 0
D1xorD2 ← 0))
(for j on cond-code-elt by (NTH j count)
do (SETQ count 3)
[SETQ vl (OR (NUMBERP (CADR j))
(AND (LISTP (CADR j))
(OR (AND (EQ (CAADR j)
'EVAL)
(EVAL (CADR j)))
(CADR j)))
(TamRep (CADR j]
(SELECTQ (CAR j)
(noop (SETQ r 'noop))
(tagD1 (ModCCodeRec r 'D1 (PutTamTag (GetTamTag vl)))
[ModCCodeRec r 'nD1 (PutTamTag (LOGNOT (GetTamTag vl])
(fulltagD1 (ModCCodeRec r 'D1 (PutTamTags (GetTamTags vl)))
[ModCCodeRec r 'nD1 (PutTamTags (LOGNOT (GetTamTags vl])
(tagD1n [LET ((bits vl)
(startbit (DIFFERENCE 34 vl)))
(SETQ count 4)
[SETQ vl (OR (NUMBERP (CADDR j))
(TamRep (CADDR j]
[ModCCodeRec r 'D1 (ConcatBits '((vl startbit bits startbit]
(ModCCodeRec r 'nD1 (ConcatBits '(((TNot vl)
startbit bits startbit])
(tagmaskD1 [LET (mask (mask1 4294967295)
(mask0 4294967295))
[for i in (CADR j)
collect (LET [(val (OR (NUMBERP i)
(TamRep i]
(SETQ mask1 (LOGAND mask1 val))
(SETQ mask0 (LOGAND mask0 (LOGNOT val]
[ModCCodeRec r 'D1 (ConcatBits '((mask1 27 7 27]
(ModCCodeRec r 'nD1 (ConcatBits '((mask0 27 7 27])
(tagmaskD2 [LET (mask (mask1 4294967295)
(mask0 4294967295))
[for i in (CADR j)
collect (LET [(val (OR (NUMBERP i)
(TamRep i]
(SETQ mask1 (LOGAND mask1 val))
(SETQ mask0 (LOGAND mask0 (LOGNOT val]
[ModCCodeRec r 'D2 (ConcatBits '((mask1 27 7 27]
(ModCCodeRec r 'nD2 (ConcatBits '((mask0 27 7 27])
(tagD2 (ModCCodeRec r 'D2 (PutTamTag (GetTamTag vl)))
[ModCCodeRec r 'nD2 (PutTamTag (LOGNOT (GetTamTag vl])
(tagD2n [LET ((bits vl)
(startbit (DIFFERENCE 34 vl)))
(SETQ count 4)
[SETQ vl (OR (NUMBERP (CADDR j))
(TamRep (CADDR j]
[ModCCodeRec r 'D2 (ConcatBits '((vl startbit bits startbit]
(ModCCodeRec r 'nD2 (ConcatBits '(((TNot vl)
startbit bits startbit])
(fulltagD2 (ModCCodeRec r 'D1 (PutTamTags (GetTamTags vl)))
[ModCCodeRec r 'nD1 (PutTamTags (LOGNOT (GetTamTags vl])
(valD1less8 (ModCCodeRec r 'D1 0)
(ModCCodeRec r 'nD1 1073741816))
(valD2less8 (ModCCodeRec r 'D2 0)
(ModCCodeRec r 'nD2 1073741816))
(bitD1 (ModCCodeRec r 'D1 vl))
(notbitD1 (ModCCodeRec r 'nD1 vl))
(notbitD2 (ModCCodeRec r 'nD2 vl))
(bitD2 (ModCCodeRec r 'D2 vl))
(wordEq (ModCCodeRec r 'D1xorD2 vl))
(D1Eq [ModCCodeRec r 'nD1 (ConcatBits '(((TNot vl)
0 34 0]
[ModCCodeRec r 'D1 (ConcatBits '((vl 0 34 0])
(D2Eq [ModCCodeRec r 'nD2 (ConcatBits '(((TNot vl)
0 34 0]
[ModCCodeRec r 'D2 (ConcatBits '((vl 0 34 0])
(D1Eqn [LET ((bits vl))
(SETQ count 4)
[SETQ vl (OR (NUMBERP (CADDR j))
(TamRep (CADDR j]
[ModCCodeRec r 'D1 (ConcatBits '((vl 0 bits 0]
(ModCCodeRec r 'nD1 (ConcatBits '(((TNot vl)
0 bits 0])
(D2Eqn [LET ((bits vl))
(SETQ count 4)
[SETQ vl (OR (NUMBERP (CADDR j))
(TamRep (CADDR j]
[ModCCodeRec r 'D2 (ConcatBits '((vl 0 bits 0]
(ModCCodeRec r 'nD2 (ConcatBits '(((TNot vl)
0 bits 0])
(Emulator.Error)))
r])
)
(* * Config)
(DEFINEQ
(TamRep
[LAMBDA (itm offset) (* ; "Edited 5-Nov-87 12:28 by Krivacic")
(PLUS [ConcatBits '(((Eval (OR offset 0))
0 32 0]
(SELECTQ itm
(SignBitMask [ConcatBits '((1 31 1 0])
(PtrMask (MASK.1'S 0 27))
(MVArgBit (TamRep 16))
(NIL (TamRep 'NoRcSymbol 3584))
(T (TamRep 'NoRcSymbol 3600))
(COND
[(NUMBERP itm)
(TamRep 'Fix (ConcatBits '((itm 0 32 0]
(T (PutTamTags (TamTagRep itm])
(TamTagRep
[LAMBDA (itm offset) (* ; "Edited 10-Nov-87 12:02 by Krivacic")
(* ;; "Returns 7 bit tag info:")
(* ;; " 2 bits of tag")
(* ;; " 5 bits of subtype")
(PLUS (OR offset 0)
(SELECTQ itm
(Int 0)
(Fix 0)
(Float 32)
(Imm 64)
(Unbound 65)
(Character 66)
(Ptr1 80)
(NoRcSymbol 86)
(RcPtr1 88)
(SmallCons 88)
(List 90)
(Cons 90)
(Atm 94)
(Symbol 94)
(Ptr 96)
(Ptr2 96)
(RcPtr2 96)
(Number 96)
(Code 104)
(Closure 106)
(Method 108)
(Object 112)
(Stack 114)
(LastStack 115)
(SymbolpCCodePClosurePorMethodPD1&D2<8
116)
(Emulator.Error])
(TamSignBit
[LAMBDA (val) (* ; "Edited 6-May-87 16:36 by rtk")
(ConcatBits '((val 0 1 31])
(GetTamTag
[LAMBDA (val) (* ; "Edited 5-Oct-87 16:27 by Krivacic")
(ConcatBits '((val 0 2 32])
(GetTamTags
[LAMBDA (val) (* ; "Edited 6-Oct-87 10:45 by Krivacic")
(ConcatBits '((val 0 7 27])
(GetTamTagLow
[LAMBDA (val) (* ; "Edited 6-Oct-87 10:46 by Krivacic")
(ConcatBits '((val 0 2 5])
(GetTamTagsLow
[LAMBDA (val) (* ; "Edited 6-Oct-87 10:47 by Krivacic")
(ConcatBits '((val 0 7 0])
(GetTamDataVal
[LAMBDA (val) (* ; "Edited 6-Oct-87 11:25 by Krivacic")
(ConcatBits '((val 0 32 0])
(GetTamPtrVal
[LAMBDA (val) (* ; "Edited 6-Oct-87 11:37 by Krivacic")
(ConcatBits '((val 0 27 0])
(PutTamTag
[LAMBDA (tags) (* ; "Edited 6-Oct-87 11:12 by Krivacic")
(ConcatBits '((tags 32 2 0])
(PutTamTags
[LAMBDA (tags val) (* ; "Edited 6-Oct-87 10:50 by Krivacic")
(ConcatBits '((tags 27 7 0)
((Eval (OR val 0))
0 27 0])
(TamLogic
[LAMBDA NIL (* ; "Edited 16-Oct-87 14:36 by Krivacic")
(DefSection ((Inputs (Reset Interrupt OpValid StackRefill RefCount Hold Refresh DpCondRes nStall
MuxBus Mi Mil))
(Outputs (PreConds DoLatchPc PcWriteOk IrqOut))
(Mi (OpLength))
(Mil (RD1addr RD2addr LatchPc ClrFlags SetFlags))
(Props (RD1addr RD2addr))
(Internals (LatchOpLength))
[↑Latches (((Clock LatchOpLength nStall)
(Mi-OpLength ↑OpLength))
((Clock)
(NextFlagLatch FlagLatch)
(NextIrq1 NextNextIrq1)
(NextIrq2 NextNextIrq2)
(Irq1 NextIrq1)
(Irq2 NextIrq2]
(Code (
(* ;; " Temporary Place for Logic till it finds a home!")
(SETQ PcWriteOk (LAND nStall DpCondRes))
(SETQ DoLatchPc (LAND Mil-LatchPc nStall))
(SETQ LatchOpLength (Mux-4 Mi-OpLength 1 1 1 1 1 1 0 0))
[LET (IsIrq1 IsIrq2 FlagBits IrqEnable FlagMux)
(SETQ IsIrq1 (LAND NextIrq1 (LNOT NextNextIrq1)))
(SETQ IsIrq2 (LAND NextIrq2 (LNOT NextNextIrq2)))
[SETQ FlagBits (ConcatBits '((MuxBus 0 4 0)
(IsIrq1 5 1 0)
(IsIrq2 4 1 0]
[SETQ FlagMux (ConcatBits '((Mil-SetFlags 1 1 0)
(Mil-ClrFlags 0 1 0]
[SETQ NextFlagLatch (ConcatBits
'(((Eval (Mux-2 FlagMux FlagLatch
(LOGAND FlagLatch (LOGNOT FlagBits)
)
(LOGOR FlagLatch FlagBits)
NIL))
0 4 0)
((Eval (Mux-2 FlagMux (LOGOR FlagLatch FlagBits)
(LOGAND FlagLatch (LOGNOT MuxBus))
(LOGOR FlagLatch FlagBits)
NIL))
4 2 4)
((Not OpValid)
6 1 0)
(Reset 7 1 0]
(* PRINTOUT T " FlagLatch: " FlagLatch " Next " NextFlagLatch " FlagMux "
FlagMux " FlagBits " FlagBits T)
[SETQ IrqEnable (ConcatBits '((FlagLatch 0 1 1]
[SETQ PreConds (ConcatBits '(((Eval (Mux-1 IrqEnable 0 FlagLatch))
4 2 4)
(FlagLatch 2 2 2)
(NextFlagLatch 6 2 6]
(SETQ IrqOut (ConcatBits '((FlagLatch 0 1 0]
(* PRINTOUT T "Reset " Reset " RefCount " RefCount " OpValid " OpValid " PreConds "
PreConds T)
])
)
(* * Section Definitions)
(DEFINEQ
(SetSectionInfo
[LAMBDA NIL (* ; "Edited 13-Oct-87 16:24 by Krivacic")
(for i
in '(RegMux Context RegisterFile SpecialRegs PcLogic IBufLogic MemBuffer MemCtl MemoryPins
Memory AddrSel TLB ExecutionUnits UCode UCodeCtl DpCc PrintInstStart TamLogic
ChipVectors) collect (* CONS i (APPLY* i T))
i])
(SetBusSizes
[LAMBDA NIL (* ; "Edited 11-Sep-87 10:40 by Krivacic")
(for i in '((nUCodeSel 4)
(AltCxt 3)
(Arg 8)
(Arg2 8)
(BotCxt 3)
(Clocks 6)
(CurPc 34)
(D1Bus 34 2 32)
(D2Bus 34 2 32)
(FetchPc 34)
(MapAddr 32)
(MemState 4)
(NewMemState 4)
(MuxBus 8)
(NewAltCxt 3)
(NewFetchPc 34)
(NewIBufN 8)
(NewNextPc 34)
(NewOpcode 8)
(NewTemp1 34)
(NextArg 8)
(NextArg2 8)
(NextBotCxt 3)
(NextPc 34)
(NextTopCxt 3)
(NextTos 8)
(Pa 34)
(PcAddr 34)
(PhyAddr 32)
(PreCondAddr 3)
(PreConds 8)
(RamState 5)
(NewRamState 5)
(RBus 34 2 32)
(RMuk 9)
(RdAddr 5)
(ReadAddr 8)
(RegAddr 8)
(RegCxt 3)
(TagBits 2)
(TopCxt 3)
(Tos 8)
(UCodeSel 1)
(WrAddr 3)
(WriteAddr 8)
(XBus 40)
(↑IBufN 8)
(↑OpLength 3)
(↑Opcode 8)
(↑Temp1 34)) do (PUTPROP (CAR i)
'ConcatSpec
(CDR i])
)
(* * Old Procs)
(DEFINEQ
(CCodeMux
[LAMBDA NIL (* ; "Edited 27-Apr-87 17:15 by rtk")
(DefSection ((Inputs (RegMuxCondRes EuCondRes DpCondRes MemCtlCondRes))
(Outputs (CondRes))
(Code ((SETQ CondRes (LAND (LAND RegMuxCondRes EuCondRes)
(LAND DpCondRes MemCtlCondRes])
(UCodeMux
[LAMBDA NIL (* ; "Edited 29-May-87 12:19 by rtk")
(DefSection ((Inputs (SelPreCond ForceNewOp PreCondAddr NewOpcode ↑uAaddr ↑uDone))
(Outputs (aAddr))
(Code ((SETQ aAddr (Mux-1 ↑uDone (Mux-1 (LAND SelPreCond ForceNewOp)
↑uAaddr PreCondAddr)
(Mux-1 SelPreCond
[Mux-1 [ConcatBits '((NewOpcode 0 1 7]
NewOpcode
(ConcatBits '((NewOpcode 4 4 4]
PreCondAddr])
(PreCond
[LAMBDA NIL (* ; "Edited 29-May-87 09:32 by rtk")
(DefSection ((Inputs (Reset Interrupt OpValid StackRefill RefCount Hold Refresh))
(Outputs (SelPreCond ForceNewOp PreCondAddr))
(Code (if (TF Reset)
then (SETQ PreCondAddr ResetAddr)
(SETQ SelPreCond 1)
(SETQ ForceNewOp 1)
elseif (TF RefCount)
then (SETQ PreCondAddr RefCountAddr)
(SETQ SelPreCond 1)
(SETQ ForceNewOp 0)
elseif (TF StackRefill)
then (SETQ PreCondAddr StackRefillAddr)
(SETQ SelPreCond 1)
(SETQ ForceNewOp 0)
elseif (TF Interrupt)
then (SETQ PreCondAddr InterruptAddr)
(SETQ SelPreCond 1)
(SETQ ForceNewOp 0)
elseif (TF (LNOT OpValid))
then (SETQ PreCondAddr NoopAddr)
(SETQ SelPreCond 1)
(SETQ ForceNewOp 0)
else (SETQ PreCondAddr ResetAddr)
(SETQ SelPreCond 0)
(SETQ ForceNewOp 0])
(OldMemCtl
[LAMBDA NIL (* ; "Edited 27-Aug-87 11:00 by Krivacic")
(DefSection ((Inputs (DpCondRes OpValid IBufFull IBufEmpty PageFault TlbMiss RealAddr RWAccess
Hold Reset Clocks Mil))
(Outputs (MemCtlCondRes WrIBuf LatchMemBuffer WriteMemBufferLow WriteMemBufferHigh
PcFetch NewPcFetch LdPcAddr ClockTlb MemRead MemReq MemStall
RasEnable CasEnable HoldA))
(Mi (MemOp))
(Mil (MemOp MemCCode))
(Code ((DECLARE (GLOBALVARS ContRamOp ContPcOp StartRamOp AbortMemOp AbortRamOp
LeaveRas LeavePcRas MemTlbMis MemPageFault MemOpDone
RefillTlb nIBufFull RamOpDone RamPageFault CasnClock
CasnClock2 CasnnClock2 WriteMemBuffer ReadReq WriteReq
MemState NewMemState RamState NewRamState LatchedPageFault
LatchMem LdPcAddrFlag LastMemClock))
(if (NEQ LastMemClock Clock)
then (SETQ MemState NewMemState)
(SETQ RamState NewRamState))
(SETQ LastMemClock Clock)
(for counter from 0 to 2
do
(* ;; "Combinatorial Logic")
(SETQ AbortMemOp (LNOT (LOR DpCondRes MemStall)))
(SETQ nIBufFull (LNOT IBufFull))
(SETQ MemPageFault (LAND (LNOT TlbMiss)
(LNOT PcFetch)
(LNOT NewPcFetch)
(LNOT RealAddr)
PageFault))
(SETQ MemTlbMis (LAND TlbMiss (LNOT PcFetch)
(LNOT NewPcFetch)
(LNOT RealAddr)))
[SETQ LeaveRas (LAND (LNOT LeavePcRas)
(ConcatBits '((Mil-MemOp 0 1 1]
(* ;; "Control Pla")
(EvaluatePla MemCtlPla)
(* ;; " Ram Pla")
(EvaluatePla RamCtlPla)
(* ;; "Condition Code & More Combinatorial Logic")
(SETQ MemReq (LOR ReadReq WriteReq))
(SETQ MemRead (LNOT WriteReq))
[SETQ MemStall (LAND (OZ (NEQ 0 Mil-MemOp))
(LOR PcFetch (LNOT MemOpDone]
(SETQ WrIBuf (LAND LdPcAddrFlag LatchMem (LNOT Clock2)
(LOR DpCondRes PcFetch)))
(SETQ LdPcAddr WrIBuf)
(SETQ LatchMemBuffer (LAND LatchMem ReadReq))
[SETQ CasEnable (LOR (LAND CasnClock Clock)
(LAND CasnClock2 Clock2)
(LAND CasnnClock2 (LNOT Clock2]
(SETQ MemCtlCondRes (Mux-2 Mil-MemCCode 1 RWAccess LatchedPageFault
(LNOT LatchedPageFault])
(OldMemCtl2
[LAMBDA NIL (* ; "Edited 17-Sep-87 18:18 by Krivacic")
(DefSection ((Inputs (DpCondRes IBufFull Reset Hold Clocks Mil))
(Outputs (MemCtlCondRes nStall HoldA EnbBufs WriteCycle RasEnable CasEnable WrIBuf))
(Mil (MemOp MemCCode WriteTags WriteData))
(Props (Memop))
(Code ((DECLARE (GLOBALVARS Idle LastDead PcRasAlive PcCasAlive LastPcRas RasCont
RasStart CasStart MemStall))
(DECLARE (LOCALVARS IBufReq))
(SETQ IBufReq (LNOT IBufFull))
[if (TF (LAND LATCHING Clock Clock2))
then (COND
[(EQ Mil-MemOp Memop-Pc)
(COND
((TF Hold)
(SetMemFlags 0 0 0 0 0 0 0 0 1 0))
((TF (LAND (LNOT Idle)
(LNOT PcRasAlive)
(LNOT PcCasAlive)))
(SetMemFlags 1 0 0 0 0 0 0 0 0 0))
((TF (LAND Idle IBufReq))
(SetMemFlags 0 0 1 0 0 1 0 0 0 0))
((TF (LAND (LOR PcRasAlive PcCasAlive)
IBufReq))
(SetMemFlags 0 0 0 1 1 0 1 1 0 0))
((TF (LAND (LOR PcRasAlive PcCasAlive)
(LNOT IBufReq)
(LNOT LastPcRas)))
(SetMemFlags 0 1 0 0 1 1 0 0 0 0))
((TF (LAND LastPcRas (LNOT IBufReq)))
(SetMemFlags 1 0 0 0 0 0 0 0 0 0]
((EQ Mil-MemOp Memop-Map)
(if (TF Hold)
then (SetMemFlags 1 0 0 0 0 0 0 0 1 1)
else (SetMemFlags 1 0 0 0 0 0 0 0 0 0)))
((EQ Mil-MemOp Memop-Ras)
(SetMemFlags 0 0 1 0 0 0 0 0 0 0))
((EQ Mil-MemOp Memop-Cas)
(SetMemFlags 0 0 0 1 1 0 0 0 0 0]
(* ;; "Other combinatorial Logic")
[SETQ CasEnable (LOR (LAND CasStart (LNOT Clock))
(LAND CasStart (LAND Clock (LNOT Clock2]
[SETQ RasEnable (LOR RasCont (LOR (LAND RasStart (LNOT Clock))
(LAND RasStart (LAND Clock (LNOT Clock2]
(SETQ MemCtlCondRes 1)
(SETQ WriteCycle (LOR Mil-WriteTags Mil-WriteData))
(SETQ nStall (LNOT MemStall))
(SETQ EnbBufs (LNOT HoldA])
(MakeMemCtlPla
[LAMBDA NIL (* ; "Edited 11-Aug-87 18:06 by Krivacic")
(* ;; "Note: AbortRamOp ONLY generated while Clock= 1")
(SETQ MemCtlPla
(MakePlaSpec '(MemState Clock (Mil-MemOp 4)
IBufFull RamOpDone Reset Hold AbortMemOp)
'(NewMemState StartRamOp ContRamOp ContPcOp AbortRamOp MemOpDone LdPcAddrFlag PcFetch
NewPcFetch LeavePcRas ReadReq WriteReq HoldA)
'((x x x x x 1 x x - Idle 0 0 0 0 0 0 0 0 0 0 0)
(Idle 0 x x x 0 x x - Idle 0 0 0 0 0 0 0 0 0 0 0)
(Idle 1 x x 0 0 x x - Idle 0 0 0 0 0 0 0 0 0 0 0)
(Idle 1 x x 1 0 1 x - Holding 0 0 0 0 0 0 0 0 0 0 1)
(Idle 1 *Read x 1 0 0 x - Read 1 0 0 0 0 0 0 0 1 0 0)
(Idle 1 *StartRead x 1 0 0 x - Read 1 0 0 0 0 0 0 0 0 1 0 0)
(Idle 1 *ContinueRead x 1 0 0 x - Read 0 1 0 0 0 0 0 0 0 1 0 0)
(Idle 1 *Write x 1 0 0 x - Write 1 0 0 0 0 0 0 0 0 0 1 0)
(Idle 1 *StartWrite x 1 0 0 x - Write 1 0 0 0 0 0 0 0 0 0 1 0)
(Idle 1 *ContinueWrite x 1 0 0 x - Write 0 1 0 0 0 0 0 0 0 0 1 0)
(Idle 1 *MapIBuf x 1 0 0 x - MapPc 1 0 0 0 0 0 0 0 1 1 0 0)
(Idle 1 *ReadIBuf x 1 0 0 x - nMapPc 0 0 1 0 0 0 0 1 1 1 0 0)
(Idle 1 0 1 1 0 0 x - Idle 0 0 0 0 0 0 0 0 0 0 0 0)
(Idle 1 0 0 1 0 0 x - PcFetch 0 0 1 0 0 0 1 0 1 0 0 0)
(Read 1 x x x 0 x x - Read 0 0 0 0 0 0 0 0 0 1 0 0)
(Read 0 x x 1 0 x x - Idle 0 0 0 0 1 0 0 0 0 1 0 0)
(Read 0 x x 0 0 x 0 - Read 0 0 0 0 0 0 0 0 0 1 0 0)
(Read 0 x x 0 0 x 1 - Abort 0 0 0 0 0 0 0 0 0 1 0 0)
(Write 1 x x x 0 x x - Write 0 0 0 0 0 0 0 0 0 0 1 0)
(Write 0 x x 1 0 x x - Idle 0 0 0 0 1 0 0 0 0 0 1 0)
(Write 0 x x 0 0 x 0 - Write 0 0 0 0 0 0 0 0 0 0 1 0)
(Write 0 x x 0 0 x 1 - Abort 0 0 0 0 0 0 0 0 0 0 1 0)
(MapPc 1 x x x 0 x x - MapPc 0 0 0 0 0 1 0 0 1 0 0 0)
(MapPc 0 x x 1 0 x x - Idle 0 0 0 0 1 1 0 0 1 0 0 0)
(MapPc 0 x x 0 0 x 1 - Abort 0 0 0 0 0 1 0 0 1 0 0 0)
(MapPc 0 x x 0 0 x 0 - MapPc 0 0 0 0 0 1 0 0 1 0 0 0)
(nMapPc 1 x x x 0 x x - nMapPc 0 0 0 0 0 1 0 1 1 0 0 0)
(nMapPc 0 x x 1 0 x x - Idle 0 0 0 0 1 1 0 1 1 0 0 0)
(nMapPc 0 x x 0 0 x 0 - nMapPc 0 0 0 0 0 1 0 1 1 0 0 0)
(nMapPc 0 x x 0 0 x 1 - Abort 0 0 0 0 0 1 0 1 1 0 0 0)
(PcFetch x x x 0 0 x x - PcFetch 0 0 0 0 0 1 1 0 1 0 0 0)
(PcFetch 1 x x 1 0 x x - PcFetch 0 0 0 0 0 1 1 0 1 0 0 0)
(PcFetch 0 x x 1 0 x x - Idle 0 0 0 0 1 1 1 0 1 0 0 0)
(Holding x x x x 0 1 x - Holding 0 0 0 0 0 0 0 0 0 0 1)
(Holding x x x x 0 0 x - Idle 0 0 0 0 0 0 0 0 0 0 0)
(Abort 1 x x x 0 x x - Abort 0 0 0 1 0 0 0 0 0 0 0)
(Abort 0 x x x 0 x x - Idle 0 0 0 0 0 0 0 0 0 0 0))
'memop])
(MakeRamCtlPla
[LAMBDA NIL (* ; "Edited 3-Aug-87 12:13 by Krivacic")
(* ;; "Note: AbortRamOp ONLY looked at while Clock = 1")
(SETQ RamCtlPla
(MakePlaSpec '(RamState Clock StartRamOp ContRamOp ContPcOp AbortRamOp LeaveRas LeavePcRas
MemTlbMis MemPageFault Reset)
'(NewRamState RasEnable CasnClock CasnClock2 CasnnClock2 RamOpDone RamPageFault ClockTLB
LatchMem WriteMemBuffer)
'((x x x x x x x x x x 1 - Idle 0 0 0 0 1 0 0 0 0 0)
(Idle 0 x x x x x x x x 0 - Idle 0 0 0 0 1 0 0 0 0 0)
(Idle 1 x x x 1 x x x x 0 - Idle 0 0 0 0 1 0 0 0 0 0)
(Idle 1 0 0 0 0 x x x x 0 - Idle 0 0 0 0 1 0 0 0 0 0)
(Idle 1 1 x x 0 x x x x 0 - Ras 0 0 0 0 1 0 0 0 0 0)
(Idle 1 x 1 x 0 x x x x 0 - Ras 0 0 0 0 1 0 0 0 0 0)
(Idle 1 x x 1 0 x x x x 0 - Ras 0 0 0 0 1 0 0 0 0 0)
(Ras 0 x x x 0 x x 0 x 0 - Cas 1 1 0 1 0 0 0 0 0 0)
(Ras 0 x x x 0 x x 1 x 0 - TlbCas 1 1 0 1 0 0 0 0 0 0)
(Cas 1 x x x 0 0 0 x x 0 - CasUp 1 1 1 0 0 0 0 0 0 0)
(Cas 1 x x x 0 1 0 x x 0 - LrCasUp 1 1 1 0 0 0 0 0 0 0)
(Cas 1 x x x 0 0 1 x x 0 - LrPcCasUp 1 1 1 0 0 0 0 0 0 0)
(Cas 1 x x x 1 x x x x 0 - CasUp 1 1 1 0 0 0 0 0 0 0)
(CasUp 0 x x x 0 x x x x 0 - Dead 0 0 1 0 1 0 0 1 1)
(LrCasUp 0 x x x 0 x x x x 0 - LrIdle 1 0 1 0 1 0 0 1 1)
(LrIdle 1 0 0 0 0 x x x x 0 - Dead1 0 0 0 0 1 0 0 0 0 0)
(LrIdle 1 x x x 1 x x x x 0 - Dead1 0 0 0 0 1 0 0 0 0 0)
(LrIdle 1 1 x x 0 x x x x 0 - DeadnGo 0 0 0 0 1 0 0 0 0 0)
(LrIdle 1 x x 1 0 x x x x 0 - DeadnGo 0 0 0 0 1 0 0 0 0 0)
(LrIdle 1 x 1 x 0 0 x x x 0 - CasUp 1 1 0 0 1 0 0 0 0 0)
(LrIdle 1 x 1 x 0 1 x x x 0 - LrCasUp 1 1 0 0 1 0 0 0 0 0)
(LrPcCasUp 0 x x x 0 x x x x 0 - LrPcIdle 1 0 1 0 1 0 0 1 1)
(LrPcIdle 1 0 0 0 0 x x x x 0 - Dead1 0 0 0 0 1 0 0 0 0 0)
(LrPcIdle 1 x x x 1 x x x x 0 - Dead1 0 0 0 0 1 0 0 0 0 0)
(LrPcIdle 1 1 x x 0 x x x x 0 - DeadnGo 0 0 0 0 1 0 0 0 0 0)
(LrPcIdle 1 x 1 x 0 x x x x 0 - DeadnGo 0 0 0 0 1 0 0 0 0 0)
(LrPcIdle 1 x x 1 0 x 0 x x 0 - CasUp 1 1 0 0 1 0 0 0 0 0)
(LrPcIdle 1 x x 1 0 x 1 x x 0 - LrPcCasUp 1 1 0 0 1 0 0 0 0 0)
(Dead 1 x x x x x x x x 0 - Dead1 0 0 0 0 0 0 0 0 0 0)
(Dead1 0 x x x x x x x x 0 - Idle 0 0 0 0 0 0 0 0 0 0)
(DeadnGo 0 x x x x x x x x 0 - DeadnGo1 0 0 0 0 0 0 0 0 0 0)
(DeadnGo1 1 x x x x x x x x 0 - Ras 0 0 0 0 0 0 0 0 0 0)
(TlbCas 1 x x x 0 x x x x 0 - TlbCasUp 1 1 0 0 0 0 0 0 0 0)
(TlbCas 1 x x x 1 x x x x 0 - CasUp 0 0 0 0 0 0 0 0 0 0)
(TlbCasUp 0 x x x 0 x x x x 0 - TlbDead 0 0 1 0 0 0 0 1 0 0)
(TlbDead 1 x x x 0 x x x x 0 - TlbDead1 0 0 0 0 0 0 0 0 0 0)
(TlbDead 1 x x x 1 x x x x 0 - Dead1 0 0 0 0 0 0 0 0 0 0)
(TlbDead1 0 x x x 0 x x x x 0 - TlbDead2 0 0 0 0 0 0 0 0 0 0)
(TlbDead2 1 x x x 0 x x x x 0 - Ras 0 0 0 0 0 0 0 0 0 0)
(TlbDead2 1 x x x 1 x x x x 0 - Idle 0 0 0 0 0 0 0 0 0 0])
)
(DEFMACRO SetMemFlags (lastidle lastpcras rasstart rascont casstart pcrasalive pccasalive wribuf
holda memstall) `(PROGN (SETQ Idle ,lastidle)
(SETQ LastPcRas ,lastpcras)
(SETQ RasStart ,rasstart)
(SETQ RasCont ,rascont)
(SETQ CasStart ,casstart)
(SETQ PcRasAlive ,pcrasalive)
(SETQ PcCasAlive ,pccasalive)
(SETQ WrIBuf ,wribuf)
(SETQ HoldA ,holda)
(SETQ MemStall ,memstall)))
(* * UCode fields)
(PUTPROPS addr uField val)
(PUTPROPS label uField atom)
(PUTPROPS altcxt uField ((Top 0)
(Top+1 1)
(Top-1 2)
(Bot 3)
(Bot+1 4)
(Bot-1 5)
(K 6)
(Global 7)))
(PUTPROPS newbotcxt uField Flag)
(PUTPROPS rcxt uField Flag)
(PUTPROPS rd1addr uField ((Raddr 0)
(IBufData1 6)
(IBufData2 7)
(IBufData3 4)
(IBufData4 5)
(Temp1 8)
(MuxBus 9)
(0 10)
(-1 11)))
(PUTPROPS rd2addr uField ((Raddr-1 0)
(NextPc 7)
(Temp1 8)
(MuxBus 9)
(Nil 10)
(T 11)
(0 12)
(Unbound 13)
(Symbol 14)
(PtrMask 15)))
(PUTPROPS pcsrc uField ((NextPc 0)
(CurPc 1)
(MuxBus 2)
(D1 3)))
(PUTPROPS wcxt uField Flag)
(PUTPROPS memop uField ((Pc 0)
(Map 1)
(Ras 2)
(Cas 3)))
(PUTPROPS euop uField ((nop 0)
(XData 0)
(XTag 1)
(Shift 48)
(TypeBits 80)
(MergeSubtype 81)
(+ 16)
(+c 17)
(- 25)
(Diff1s 24)
(And 33)
(Xor 38)
(Or 39)
(D1 35)
(D2 37)
(Priority 64)))
(PUTPROPS tag uField ((Int 3)
(LowD2Tag 2)
(D1 1)
(D2 0)))
(PUTPROPS w2addr uField ((nowrite 0)
(Temp1 7)))
(PUTPROPS dswap uField Flag)
(PUTPROPS raddr uField ((Tos 1)
(Arg 2)
(Arg2 3)
(IBufN 4)
(Opcode 5)
(K 6)))
(PUTPROPS waddr uField ((NewTos 1)
(NewArg 2)
(NewArg2 3)
(IBufN 4)
(Opcode 5)
(K 6)))
(PUTPROPS newarg uField ((Arg 8)
(Arg+1 9)
(Arg+MuxBus 10)
(Arg-MuxBus 13)
(Arg+MuxBus+1 11)
(MuxBus 2)
(MuxBus+1 3)
(~MuxBus 4)
(-MuxBus 5)
(0 0)
(1 1)))
(PUTPROPS newarg2 uField ((Arg2 8)
(Arg2+1 9)
(Arg2+MuxBus 10)
(Arg2-MuxBus 13)
(Arg2+MuxBus+1 11)
(MuxBus 2)
(MuxBus+1 3)
(~MuxBus 4)
(-MuxBus 5)
(0 0)
(1 1)))
(PUTPROPS newtopcxt uField Flag)
(PUTPROPS newtos uField ((Tos 8)
(Tos+1 9)
(Tos+MuxBus 10)
(Tos-MuxBus 13)
(Tos+MuxBus+1 11)
(MuxBus 2)
(MuxBus+1 3)
(~MuxBus 4)
(-MuxBus 5)
(0 0)
(1 1)))
(PUTPROPS k uField ((0 0)
(IVar 0)
(PVSlot 7)
(HdrSlot 8)
(CodeSlot 9)
(BsSlot 10)
(Clink 11)
(PcSlot 12)
(ClosureEnvSlot 13)
(UnDefnSlot 14)
(IntTypeBits (TamTagRep 'Fix))
(SymbTypeBits (TamTagRep 'Symbol))
(FloatTypeBits (TamTagRep 'Float))
(Ptr1TypeBits (TamTagRep 'Ptr1))
(Ptr2TypeBits (TamTagRep 'Ptr2))
(ImmTypeBits (TamTagRep 'Imm))
(UnboundBits (TamTagRep 'Unbound))
(SlowReturnMask 8)
(UfnBase 256)
(UnDefFn 257)
(PFCode 258)
(Irq1Code 259)
(Irq2Code 268)
(StackAdjustCode 260)
(RTmp1 261)
(RTmp2 262)
(RTmp3 263)
(RTmp4 264)
(DecRef 263)
(IncRef 264)
(IncRef2 265)
(RefCountCode 266)
(WrapperTable 267)
(TypeTable 268)
(ConsPtr 269)
(CreateCellPtr 270)
(Irq1Mask 32)
(Irq2Mask 16)
(RefCountMask 8)
(StackRefillMask 4)
(IrqEnableMask 2)
(Irq1&IrqEnableMask 34)
(Irq2&IrqEnableMask 18)
(IrqOutMask 1)))
(PUTPROPS k2 uField ((0 0)
(ValueCellOffset 1)
(DefCellOffset 2)
(NextLink 1)
(FrameOffset 2)
(CarDispl 0)
(CdrDispl 1)
(ClosureEnvOffset 2)
(ClosureCodeOffset 3)))
(PUTPROPS muxbus uField ((Tos 1)
(Arg 2)
(Arg2 3)
(IBufN 4)
(Opcode 5)
(K 6)
(D2 7)))
(PUTPROPS writet uField Flag)
(PUTPROPS writef uField Flag)
(PUTPROPS jumpt uField Label)
(PUTPROPS jumpf uField Label)
(PUTPROPS misc uField ((SetOutputInt 1)
(ResetOutputInt 1)
(SetInitialRefill 1)
(ResetInitialRefill 1)
(SetStackRefill 1)
(ResetStackRefill 1)
(SetInterruptEnable 1)
(ResetInterruptEnable 1)
(SetMemLock 1)
(ResetMemLock 1)
(SetRefCount 1)
(ResetRefCount 1)
(ResetRefresh 1)
(ResetInterrupt 1)
(WriteOctal 1)
(ResetVMM 1)
(Reset 1)
(Stop 1)))
(PUTPROPS aside uField Flag)
(PUTPROPS bside uField Flag)
(PUTPROPS oplength uField val)
(PUTPROPS opmask uField ((T 0)
(b0111 3)
(b1111 2)))
(PUTPROPS memoffset uField ((K2 0)
(MuxBus 1)))
(PUTPROPS dpccode uField ((T 0)
(FixP 6)
(FixPD1D2 11)
(PosFixP 29)
(MinFixD2 24)
(FloatP 8)
(FloatPD1D2 31)
(FixPD1D2orFloatPD1D2 23)
(ImmediateP 9)
(UnboundP 4)
(PointerP 10)
(RefCountPtr 3)
(PointerPD2 25)
(RefCountPtrD1orD2 2)
(FixPD1PointerPD2 26)
(SymbolP 28)
(CCodeP 16)
(ClosureP 1)
(MethodP 12)
(ConsP 13)
(StackP 5)
(LastStackP 20)
(NumberP 19)
(NumberPD1D2 18)
(D1=D2 14)
(D1FixLess8 17)
(D1b111EQ0 30)
(D1b111EQ7 31)
(D1=<subtypes>D2 1)
(NilD2 21)
(MVokD2 31)
(D2=Int<8&D1=Atom 31)
(D2=Int<8&D1=CCodeP 31)
(ImmediatePD1D2 40)
(IntorFloatPD1D2 41)
(D2<4>=0or1 42)
(D2<4>=15 43)
(SmallConsP 44)
(D1<8>=D2<8> 45)
(D1<tags>=D2<tags> 46)
(FixPFloatPImmPSymbolPNumberPD1orD2 47)
(FixPD2 48)
(PosFixPD2 49)
(PosFixP<=32D2 50)
(NumberPD1D2orCharacterPD1D2 51)
(CharacterPD1D2&D1<8>=D2<8> 52)
(NumberPD1D2&D1<low2tags>=D2<low2tags> 53)
(NotSlowReturnPD2 54)
(SymbolPCCodePClosurePorMethodPD1&D2<8 55)
(D2>127 56)))
(PUTPROPS euccode uField ((T 0)
(NoOverflow 1)
(Carry 2)
(GreaterP 3)))
(PUTPROPS muxccode uField ((T 0)
(FramesFull 1)
(FramesEmpty 2)
(Opcodeb3 3)
(Arg=Mux 4)
(Arg#Mux 5)
(Arg=0 6)
(Arg#0 7)))
(PUTPROPS memccode uField ((T 0)
(RWAccess 1)
(PageFault 2)
(NoPageFault 3)))
(PUTPROPS writeoctal uField Flag)
(PUTPROPS clroplength uField Flag)
(PUTPROPS latchpc uField Flag)
(PUTPROPS latchfetchpc uField Flag)
(PUTPROPS memlatchsrc uField ((PhysAddr 0)
(InxPhysAddr 1)
(MapAddr 2)))
(PUTPROPS physaddrsrc uField ((FetchPc 0)
(PhysAddr 1)))
(PUTPROPS byteaddr uField Flag)
(PUTPROPS writedata uField Flag)
(PUTPROPS writetags uField Flag)
(PUTPROPS setflags uField Flag)
(PUTPROPS clrflags uField Flag)
(PUTPROPS forcedone uField Flag)
(* * OpPla Fields)
(PUTPROPS forcenewop uField2 Flag)
(PUTPROPS opname uField2 atom)
(PUTPROPS opnbr uField2 val)
(PUTPROPS precond uField2 ((Reset T)
(Interrupt1 T)
(Interrupt2 T)
(RefCount T)
(AdjustFrames T)
(NotOpValid T)))
(PUTPROPS start uField2 Label)
(PUTPROPS preconditions uField2 Flag)
(PUTPROPS unistart uField2 Flag)
(PUTPROPS multistart uField2 Flag)
(DECLARE%: EVAL@COMPILE
(DATATYPE MI ((Addr POINTER)
(AltCxt BITS 3)
(ByteAddr BITS 1)
(Done BITS 1)
(DpCCode BITS 6)
(Dswap BITS 1)
(EUop BITS 7)
(EuCCode BITS 2)
(ForceDone BITS 1)
(InvertCCode BITS 1)
(K BITS 9)
(K2 BITS 4)
(Label POINTER)
(LatchFetchPc BITS 1)
(LatchPc BITS 1)
(MemCCode BITS 2)
(MemLatchSrc BITS 2)
(MemOffset BITS 1)
(MemOp BITS 2)
(Misc BITS 2)
(MuxBus BITS 3)
(MuxCCode BITS 3)
(NewArg BITS 4)
(NewArg2 BITS 4)
(NewBotCxt BITS 1)
(NewTopCxt BITS 1)
(NewTos BITS 4)
(NextInstA POINTER)
(NextInstB POINTER)
(OpLength BITS 3)
(OpMask BITS 2)
(PcSrc BITS 2)
(PhysAddrSrc BITS 1)
(RCxt BITS 1)
(RD1addr BITS 4)
(RD2addr BITS 4)
(Raddr BITS 3)
(RomSide POINTER)
(Tag BITS 2)
(Ucode POINTER)
(W2addr BITS 3)
(WCxt BITS 1)
(Waddr BITS 3)
(WriteF BITS 1)
(WriteOctal BITS 1)
(WriteT BITS 1)
(WriteTags BITS 1)
(WriteData BITS 1)
(SetFlags BITS 1)
(ClrFlags BITS 1)
(Unused BITS 1)))
(DATATYPE OpD ((OpName POINTER)
(OpNbr POINTER)
(Val BITS 16)
(Mask BITS 16)
(Start BITS 10)
(ModStartAddr BITS 1)
(Length BITS 3)
(Precond BITS 3)
(NSel BITS 1)
(Const BITS 4)
(ForceNewOp BITS 1)))
(DATATYPE CondCode ((D1 POINTER)
(nD1 POINTER)
(D2 POINTER)
(nD2 POINTER)
(D1xorD2 POINTER)))
)
(/DECLAREDATATYPE 'MI '(POINTER (BITS 3)
(BITS 1)
(BITS 1)
(BITS 6)
(BITS 1)
(BITS 7)
(BITS 2)
(BITS 1)
(BITS 1)
(BITS 9)
(BITS 4)
POINTER
(BITS 1)
(BITS 1)
(BITS 2)
(BITS 2)
(BITS 1)
(BITS 2)
(BITS 2)
(BITS 3)
(BITS 3)
(BITS 4)
(BITS 4)
(BITS 1)
(BITS 1)
(BITS 4)
POINTER POINTER (BITS 3)
(BITS 2)
(BITS 2)
(BITS 1)
(BITS 1)
(BITS 4)
(BITS 4)
(BITS 3)
POINTER
(BITS 2)
POINTER
(BITS 3)
(BITS 1)
(BITS 3)
(BITS 1)
(BITS 1)
(BITS 1)
(BITS 1)
(BITS 1)
(BITS 1)
(BITS 1)
(BITS 1)) '((MI 0 POINTER)
(MI 0 (BITS . 2))
(MI 0 (BITS . 48))
(MI 0 (BITS . 64))
(MI 2 (BITS . 5))
(MI 0 (BITS . 80))
(MI 2 (BITS . 102))
(MI 0 (BITS . 97))
(MI 2 (BITS . 208))
(MI 2 (BITS . 224))
(MI 3 (BITS . 8))
(MI 3 (BITS . 147))
(MI 4 POINTER)
(MI 4 (BITS . 0))
(MI 4 (BITS . 16))
(MI 4 (BITS . 33))
(MI 4 (BITS . 65))
(MI 4 (BITS . 96))
(MI 3 (BITS . 209))
(MI 6 (BITS . 1))
(MI 6 (BITS . 34))
(MI 6 (BITS . 82))
(MI 6 (BITS . 131))
(MI 6 (BITS . 195))
(MI 4 (BITS . 112))
(MI 3 (BITS . 240))
(MI 7 (BITS . 3))
(MI 8 POINTER)
(MI 10 POINTER)
(MI 10 (BITS . 2))
(MI 10 (BITS . 49))
(MI 10 (BITS . 81))
(MI 10 (BITS . 112))
(MI 8 (BITS . 0))
(MI 8 (BITS . 19))
(MI 7 (BITS . 67))
(MI 8 (BITS . 82))
(MI 12 POINTER)
(MI 12 (BITS . 1))
(MI 14 POINTER)
(MI 14 (BITS . 2))
(MI 14 (BITS . 48))
(MI 14 (BITS . 66))
(MI 14 (BITS . 112))
(MI 12 (BITS . 32))
(MI 12 (BITS . 48))
(MI 12 (BITS . 64))
(MI 12 (BITS . 80))
(MI 12 (BITS . 96))
(MI 12 (BITS . 112))
(MI 7 (BITS . 128))) '16)
(/DECLAREDATATYPE 'OpD '(POINTER POINTER (BITS 16)
(BITS 16)
(BITS 10)
(BITS 1)
(BITS 3)
(BITS 3)
(BITS 1)
(BITS 4)
(BITS 1)) '((OpD 0 POINTER)
(OpD 2 POINTER)
(OpD 4 (BITS . 15))
(OpD 5 (BITS . 15))
(OpD 6 (BITS . 9))
(OpD 2 (BITS . 0))
(OpD 2 (BITS . 18))
(OpD 2 (BITS . 66))
(OpD 2 (BITS . 112))
(OpD 0 (BITS . 3))
(OpD 0 (BITS . 64))) '8)
(/DECLAREDATATYPE 'CondCode '(POINTER POINTER POINTER POINTER POINTER) '((CondCode 0 POINTER)
(CondCode 2 POINTER)
(CondCode 4 POINTER)
(CondCode 6 POINTER)
(CondCode 8 POINTER))
'10)
(RPAQQ InitVarLst
(NewRegMuxIBufN ↑RegMuxIBufN NewRegMuxOpcode ↑RegMuxOpcode NewRegMuxK ↑RegMuxK NextArg2 Arg2
NextArg Arg NextTos Tos Clock Latching D2Bus NewIBufN NewOpcode nStall Clocks Mi Mil
RegAddr MuxBus Argis0 ArgisMux NewAltCxt AltCxt NewBotCxt BotCxt NewTopCxt TopCxt
WriteOk RegCxt FramesEmpty FramesFull WriteAddr FullRegAddr ReadAddr RBus D1Bus
NewTemp1 ↑Temp1 NextPc CurPc PcWriteOk DoLatchPc ↑OpLength RdAddr NewIBufData ↑IBufData
XBus WrAddr WrIBuf Done OpValid IBufFull WriteCycle nxIdle Idling nxHold Holding nxData
Data nxPcCas PcCas nxPcRas PcRas DpCondRes Reset Hold MemCtlCondRes HoldA EnbBufs
RasEnable CasEnable PhyAddr nRas nCas Ra Pa FetchPcLo FetchPcHi NewLatchAddrLo PhysLo
NewLatchAddrHi PhysHi LatchPhys LatchFetchPc MapAddr NewTLBIndex TLBIndex ClockTlb
PageFault TlbMiss RWAccess EuCondRes PreCondAddr UCodeSel nUCodeSel PreConds Clock2
uOpLength NextNextIrq2 NextNextIrq1 Irq2 NextIrq2 Irq1 NextIrq1 FlagLatch NextFlagLatch
Mi-OpLength LatchOpLength Interrupt StackRefill RefCount Refresh IrqOut Irq1In Irq2In))
(RPAQQ InitGVarLst
(ResetAddr NoopAddr DoSimLog RegFile IBufMask IBufReg MemoryArray MemoryTagArray RefreshAfter
SimLog VMCmpArray VMResArray report ShowEnterExit DLOWPUDX Maxop RefreshEnable
Debugging MIR NilMir *memory-addr* *memory-data* LastRasEnable))
(RPAQQ fulltagmsk 4261412864)
(RPAQQ tagmsk 3221225472)
(RPAQQ fulltag&flagmsk 4278190080)
(RPAQQ VarsList (Cycles FnCount FrameDumps TOPCXT NEWOPCODE PCWRITEOK WRITEOK NEWIBUFN ↑IBUFDATA
WRADDR RDADDR IBUFFULL OPVALID ↑TEMP1 FETCHPCLO NEXTPC))
(RPAQQ MapConst 0)
(DECLARE%: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS InitVarLst InitGVarLst fulltagmsk tagmsk fulltag&flagmsk VarsList MapConst UCodeRomA
UCodeRomB)
)
(DEFINEQ
(ADDMOD
[LAMBDA (value) (* ; "Edited 15-Sep-87 12:00 by Krivacic")
(if (EQ value 3)
then 0
else (ADD1 value])
(SUBMOD
[LAMBDA (value) (* ; "Edited 15-Sep-87 12:00 by Krivacic")
(if (EQ value 0)
then 3
else (SUB1 value])
)
(PUTPROPS TAMARINEMULATOR COPYRIGHT ("Xerox Corporation" 1985 1986 1987))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (2924 5881 (DoCycle 2934 . 3237) (DoSave 3239 . 3488) (SetClocks 3490 . 4230) (
UpdateClocks 4232 . 4800) (MakeClocksVal 4802 . 5607) (ClockBit 5609 . 5879)) (6550 12474 (RegMux 6560
. 9621) (RegMuxSet 9623 . 10884) (Context 10886 . 12472)) (12503 14285 (RegisterFile 12513 . 14283))
(14316 15918 (SpecialRegs 14326 . 15916)) (15955 18189 (PcLogic 15965 . 18187)) (18224 21630 (
IBufLogic 18234 . 21123) (SelectIBufByte 21125 . 21628)) (21650 34927 (MemCtl 21660 . 25443) (TLB
25445 . 28521) (AddrSel 28523 . 30914) (MemBuffer 30916 . 31838) (MemoryPins 31840 . 32512) (Memory
32514 . 34925)) (34956 40720 (ExecutionUnits 34966 . 36746) (ShiftEUop 36748 . 37339) (AdderEUop 37341
. 39122) (LogicalEUop 39124 . 39739) (PriorityEUop 39741 . 40031) (TagShifter 40033 . 40434) (
TagLogic 40436 . 40718)) (40747 46277 (UCode 40757 . 42299) (UCodeCtl 42301 . 46275)) (46306 58973 (
DpCc 46316 . 47143) (EvalDpCc 47145 . 47813) (MakeCondCodeArray 47815 . 53067) (MakeCondEntry 53069 .
58971)) (58993 65995 (TamRep 59003 . 59629) (TamTagRep 59631 . 60688) (TamSignBit 60690 . 60845) (
GetTamTag 60847 . 61003) (GetTamTags 61005 . 61162) (GetTamTagLow 61164 . 61322) (GetTamTagsLow 61324
. 61483) (GetTamDataVal 61485 . 61645) (GetTamPtrVal 61647 . 61806) (PutTamTag 61808 . 61965) (
PutTamTags 61967 . 62189) (TamLogic 62191 . 65993)) (66028 68210 (SetSectionInfo 66038 . 66520) (
SetBusSizes 66522 . 68208)) (68233 84389 (CCodeMux 68243 . 68628) (UCodeMux 68630 . 69407) (PreCond
69409 . 70951) (OldMemCtl 70953 . 74633) (OldMemCtl2 74635 . 77919) (MakeMemCtlPla 77921 . 81010) (
MakeRamCtlPla 81012 . 84387)) (107234 107636 (ADDMOD 107244 . 107438) (SUBMOD 107440 . 107634)))))
STOP