//
// Alto microprocessor simulator
// last edited November 13, 1978  5:29 PM
//
// Copyright Xerox Corporation 1979

	get "ami.d"
	get "asim.d"


structure IR:	// fields in IR for Nova F2's
[	bit0 bit 1
	z bit 7 =
	[ opf bit 2 = acs bit 2
	  opx bit 5 =
	  [ funct bit 2 = acd bit 2
	    bit567 bit 3 = [ ind bit 1; idx bit 2 ]
	  ]
	] =
	[ blank bit 3
	  adrp bit 4
	]
	disp bit 8 =
	[ shift bit 2
	  carry bit 2
	  noload bit 1
	  skip bit 3 =
	  [ skc bit 2
	    skp bit 1
	  ]
	]
]

static	// the microprocessor state, comments are in Asim.d
[	@t; @tu; @l; @lu
	@ir
	@carry
	@bus
	@alu
	@sh
	@skip
	@alucy
	@mar; @altbank; @mstate
	@marmod
	@md; @mdx; @mdu
	@nmod
	@pc
	@waiting
	@ramadr
]

external	// memory access procedures
[	ReadR; WriteR
	ReadCON
	ReadRAM; WriteRAM
	ReadMEM; WriteMEM
]

manifest	// memory states
[	mQUIET = 0	// memory idle
	mMAR1 = 1	// 1 instr. after MAR←
	mMAR2 = 2	// 2 instr.s after MAR←
	mMAR3 = 3	// 3 instr.s after MAR←
	mMAR4 = 4	// 4 instr.s after MAR←
	mMD1 = 5	// 1 instr. after fetch done in MAR2
	mMD2 = 6	// 1 instr. after fetch done in MAR3-4
	mST1 = 7	// 1 instr. after store done in MAR2
	mST2 = 8	// 1 instr. after store done in MAR3
]
manifest
	msbusymask = b1+b2+b3	// mstates illegal at task switch

manifest	// other manifests
[	MOUSELOC = #177030	// mouse data
	EMBANKS = #177740	// memory bank #s
]

static	// configuration flags
[	@AltoType	// 0 = must run on both Alto I and II
		// 1 = Alto I
		// 2 = Alto II
	ExtendedMemory
	ExtraROM
]

static	// other statics
[	idlenms	// mstate transition table when idle
	marnms	// ditto for MAR←
	fetchnms	// ditto for ←MD
	storenms	// ditto for MD←
	@cy	// temp. for ALU carry
	@wptr	// pointer to list of planned writes
]


let InitAsim(atype, xrom, xm, dws; numargs na) be
[	switchon na into
	[ case 0: atype = 0
	  case 1: xrom = false
	  case 2: xm = false
	  case 3: dws = false
	]
	AltoType = atype
	ExtraROM = xrom
	ExtendedMemory = xm
	idlenms = table[ mQUIET; mMAR2; mMAR3; mMAR4; mQUIET
	  mQUIET; mQUIET; mQUIET; mQUIET ]
	marnms = table[ mMAR1; -1; mMAR1; mMAR1; mMAR1
	  mMAR1; mMAR1; mMAR1; mMAR1 ]
	switchon AltoType into
	[ case 2: setmem2(); endcase
	  case 1: setmem1(dws); endcase
	  case 0: setmem0(dws); endcase
	]
	waiting = -1
	lu, tu = true, true
	mstate = mQUIET
	mdu = true
	marmod, md, mdx = 0, 0, 0
	t, l, ir = 0, 0, 0
	skip, alucy, carry = 0, 0, 0
	nmod = 0
]

and setmem0(dws) be
[	setmem1(dws)	// Alto I timing is compatible almost everywhere
	storenms = table[ -1; -1; mST1; mST2; -1
	  mST2; -1; -1; -1 ]	// store timing like Alto II
	storenms!mST1 = (dws? mQUIET, -1)
]

and setmem1(dws) be
[	marnms!mMAR1 = -1	// requires 1-cycle wait for MAR← after MAR←
	fetchnms = table[ -1; -1; mMD1; mMD2; mMD2
	  mQUIET; mQUIET; mQUIET; mQUIET ]	// memory data is not latched
	test dws
	 ifso
	storenms = table[ -1; -1; mST1; mST2; mST2
	  mST2; mQUIET; mQUIET; mQUIET ]	// store as late as MAR4
	 ifnot
	storenms = table[ -1; -1; mST1; mST2; mST2
	  mST2; mQUIET; -1; -1 ]	// store as late as MAR4
]

and setmem2() be
[	marnms!mMAR1 = mMAR1	// doesn't require 1-cycle wait for MAR← after MAR←
	fetchnms = table[ mQUIET; -1; mMD1; mMD2; mMD2
	  mQUIET; mQUIET; mQUIET; mQUIET ]	// memory data is latched
	storenms = table[ -1; -1; mST1; mST2; -1
	  mST2; -1; mQUIET; -1 ]	// store no later than MAR3, double store must start at MAR2
]


let Asim() = valof
// returns 0 or error string
[	let ins = vec 1
	ins!0 = ReadRAM(pc % #2000)
	ins!1 = ReadRAM(pc)
	let next = ins>>MI.next % nmod
	let nms = idlenms
	let nwait = -1

	// Unpack instruction
	let rsel, aluf, bs, f1x, f2x, lt, ll =
	  ins>>MI.rsel, ins>>MI.aluf, ins>>MI.bs,
	  ins>>MI.f1x, ins>>MI.f2x,
	  ins>>MI.loadt ne 0, ins>>MI.loadlx eq 0
	let csel = rsel lshift 3 + bs
	let buscon = (f1x eq f1CONST) % (f2x eq f2CONST)
	let wlist = vec 8
	wptr = wlist

	// Do most error checks
	if lu then
	  if (ldef2mask lshift f2x ls 0) % (waiting eq f1WRTRAM) then
	    resultis "L undefined"
	if tu then
	  if (f2x eq f2MAGIC) % ((tdefalumask lshift aluf ls 0) &
	   (ll % (f1x eq f1MARGETS) % (lt & (ltalumask lshift aluf ls 0)))) then
	    resultis "T undefined"
	if waiting eq f1TASK then
	[ if nmf2mask lshift f2x ls 0 then
	   unless (f2x eq f2IRGETS) & buscon & ((ReadCON(csel) & #107000) eq 0) do
	    resultis "Branch modifier following TASK"
	  if waitf1mask lshift f1x ls 0 then
	    resultis "Delayed F1 following TASK"
	  if (msbusymask lshift mstate ls 0) & (bs ne bsMD) &
	   (f2x ne f2STORE) then
	    resultis "TASK with memory running"
	]
	if aluf ne 0 then
	  if (not ll) & (f1x ne f1MARGETS) &
	   ((ltalumask lshift aluf ge 0) % (not lt)) then
	    resultis "ALU output discarded"
	switchon f2x into
	[ case f2DNS:
	  [ if bs ne bsLOADR then
	      resultis "DNS with BS#R←"
	    endcase
	  ]
	  case f2STORE:
	  [ if (f1x eq f1MARGETS) & ExtendedMemory endcase	// not a real store
	    if storenms!mstate eq -1 then
	      resultis "MD← at wrong time"
	    nms = storenms
	    endcase
	  ]
	]

	// Modify low bits of rsel
	let rsel1 = selecton f2x into
	[ case f2ACSOURCE: (rsel%3)-ir<<IR.acs
	  case f2ACDEST:
	  case f2DNS: (rsel%3)-ir<<IR.acd
	  default: rsel
	]

	// Compute shifter output and emulator carryin
	let carryin = nil
	let ecy = (f2x ne f2DNS? alucy, valof
	[ carryin = carry xor selecton ir<<IR.carry into
	  [ case 1: 0
	    case 2: 1
	    case 3: 1-alucy
	    default: alucy
	  ]
	  resultis selecton f1x into
	  [ case f1LLSH1: l rshift 15
	    case f1LRSH1: l & 1
	    default: carryin
	  ]
	] )
	sh = selecton f1x into
	[ case f1LLCY8: l lshift 8 + l rshift 8
	  case f1LLSH1: l lshift 1 +
	    selecton f2x into
	    [ case f2MAGIC: t rshift 15
	      case f2DNS: carryin
	      default: 0
	    ]
	  case f1LRSH1: l rshift 1 +
	    selecton f2x into
	    [ case f2MAGIC: t lshift 15
	      case f2DNS: carryin lshift 15
	      default: 0
	    ]
	  default: l
	]

	// Compute bus value
	test (f1x eq f1CONST) % (f2x eq f2CONST)
	ifso bus = ReadCON(csel)
	ifnot
 [	switchon bs into
	[ case bsLOAD2R:
	  [ if rsel eq 0 then resultis "Attempt to load R40"
	    switchon f1x into
	    [ case f1LLSH1:
	      case f1LRSH1:
	      case f1LLCY8:
	        resultis "Attempt to shift into 2nd R bank"
	    ]
	    plan(WriteR, rsel+#40, l)
	    bus = ReadCON(csel)
	    endcase
	  ]
	  case bsLOADR:
	  [ if lu then resultis "L undefined"
	    if (f2x ne f2DNS) % (ir<<IR.noload eq 0) then
	      plan(WriteR, rsel1, sh)
	    bus = 0
	    endcase
	  ]
	  case bsREAD2R:
	  [ test rsel eq 0
	    ifso
	    [ if lu then resultis "L undefined"
	      bus = l
	    ]
	    ifnot
	      bus = ReadR(rsel+#40)
	    endcase
	  ]
	  case bsREADR:
	  [ bus = ReadR(rsel1)
	    endcase
	  ]
	  case bsMD:
	  [ if nms ne idlenms then
	      resultis "2 memory ops"
	    if (ReadCON(csel) ne -1) & (AltoType ne 2) then
	      resultis "Attempt to mask MD"
	    if fetchnms!mstate eq -1 then
	      resultis "←MD at wrong time"
	    if mdu then
	      resultis "MD undefined"
	    if (mstate eq mMD1) & ((mar&1) ne 0) & (AltoType eq 0) then
	      resultis "Odd double fetch not compatible"
	    nms = fetchnms
	    bus = (AltoType ne 2? readm(mar % marmod), marmod eq 0? md, mdx) & ReadCON(csel)
	    marmod = 1-marmod
	    endcase
	  ]
	  case bsMOUSEDATA:
	  [ bus = ReadMEM(MOUSELOC) & ReadCON(csel)
	    endcase
	  ]
	  case bsDISP:
	  [ bus = (ir<<IR.idx eq 0? ir&#377, (ir&#177)-(ir&#200)) & ReadCON(csel)
	    endcase
	  ]
	  default:
	    bus = -1
	]
 ]
	if waiting eq f1RDRAM then
	  bus = bus & ReadRAM(ramadr)

	// Compute ALU output
	cy = 0
	if aluf ge #16 then resultis "Bad ALUF"
	alu = selecton aluf into
	[ case 1: t
	  case 2: bus % t
	  case 3: bus & t
	  case 4: bus xor t
	  case 5: add3(bus, 1, 0)
	  case 6: add3(bus, -1, 0)
	  case 7: add3(bus, t, 0)	// BUS+T
	  case #10: add3(bus, not t, 1)	// BUS-T
	  case #11: add3(bus, not t, 0)	// BUS-T-1
	  case #12: add3(bus, t, 1)	// BUS+T+1
	  case #13: add3(bus, skip, 0)
	  case #14: bus & t
	  case #15: bus & not t
	  default: bus
	]

	// Do remaining F1's
	switchon f1x into
	[ case f1NONE:
	  case f1LLSH1:
	  case f1LRSH1:
	  case f1LLCY8:
	  case f1CONST: endcase
	  case f1MARGETS:
	  [ if nms ne idlenms then resultis "2 memory ops"
	    if marnms!mstate eq -1 then
	      resultis "Memory timing error"
	    if rsel eq #37 then resultis "MAR← with R37"
	    nms, mar, altbank = marnms, alu, f2x eq f2STORE
	    marmod, mdu = 0, false
	    if AltoType eq 2 then
	      md, mdx = readm(mar), readm(mar xor 1)
	    endcase
	  ]
	  case f1WRTRAM:
	  case f1RDRAM:
	  case f1TASK:
	  case f1SWMODE: [ nwait = f1x; endcase ]
	  case f1STARTIO: resultis "STARTIO"
	  default: resultis "Bad F1"
	]

	// Do remaining F2's
	if badf2mask lshift f2x ls 0 then
	  resultis "Bad F2"
	nmod = selecton f2x into
	[  case f2DNS: valof
	  [ if ir<<IR.noload eq 0 then
	      carry = ecy
	    skip = ir<<IR.skp xor selecton ir<<IR.skc into
	    [ case 1: 1-ecy
	      case 2: (sh eq 0? 1, 0)
	      case 3: (sh eq 0? 1, 1-ecy)
	      default: 0
	    ]
	    resultis 0
	  ]
	  case f2STORE: valof
	  [ if f1x eq f1MARGETS resultis 0	// not a real store
	    nms = storenms
	    plan(writem, (AltoType eq 2? mar xor marmod, mar % marmod), bus)
	    marmod = 1-marmod
	    resultis 0
	  ]
	  case f2BUSEQ0: (bus eq 0? 1, 0)
	  case f2SHLS0: sh rshift 15
	  case f2SHEQ0: (sh eq 0? 1, 0)
	  case f2BUS: bus & #1777
	  case f2ALUCY: alucy
	  case f2BUSODD: bus & 1
	  case f2IRGETS: valof
	  [ ir, skip = bus, 0
	    resultis ir<<IR.bit0 lshift 3 + ir<<IR.bit567
	  ]
	  case f2IDISP: selecton ir<<IR.opf into
	  [ case 1: 4
	    case 2: 5
	    case 3: selecton ir<<IR.adrp into
	    [ case 0: 1
	      case 1: 0
	      case 6: 16b
	      case 16b: 6	// CONVERT
	      default: ir<<IR.adrp
	    ]
	    default: ir<<IR.funct
	  ]
	  case f2ACSOURCE:
	   (ir<<IR.bit0? 3-ir<<IR.shift,
	    ir<<IR.opf ne 3? ir<<IR.ind,
	   selecton ir<<IR.opx into
	  [ case 0: 2	// CYCLE
	    case 1: 5
	    case 2: 3	// OPR
	    case 3: 6
	    case 4: 7
	    case 11b:	// JSRII (PC)
	    case 12b: 4	// JSRII (AC2)
	    case 16b: 1	// CONVERT
	    case 37b: 17b	// SWAT
	    default: 16b	// other traps
	  ] )
	  default: 0
	]

	// Load L and T
	let oldramadr, oldl = ramadr, l
	if lt then t, tu, ramadr =
	  (ltalumask lshift aluf ls 0? alu, bus), false, alu
	if ll then l, alucy, lu = alu, cy, false

	// End of instruction
	mstate = nms!mstate
	while wlist ne wptr do
	[ (wlist!0)(wlist!1, wlist!2)
	  wlist = wlist+3
	]
	let hinext = pc & not #1777
	switchon waiting into
	[ case f1TASK: [ lu, tu, mdu = true, true, true; endcase ]
	  case f1WRTRAM:
	  [ WriteRAM((oldramadr & #1777)+#2000, oldl)
	    WriteRAM(oldramadr & #1777, alu)
	    endcase
	  ]
	  case f1SWMODE:
	    hinext = (not ExtraROM? hinext xor #4000,
	      (next&#400) eq 0? (hinext eq #4000? 0, #4000),
	      hinext eq #14000? 0, #14000)
	    endcase
	]
	pc, waiting = hinext+next, nwait
	resultis 0
]

and add3(x, y, c) = valof	// add x+y+c, set cy to carry
[	let u = (x&1) + (y&1) + c
	cy = (x rshift 1 + y rshift 1 + u rshift 1) rshift 15
	resultis x+y+c
]

and plan(proc, arg1, arg2) be
[	wptr!0, wptr!1, wptr!2 = proc, arg1, arg2
	wptr = wptr+3
]

and readm(addr) =
(not ExtendedMemory? ReadMEM(addr),
	ReadMEM(addr,
	  (ReadMEM(EMBANKS) rshift (altbank? 0, 2)) & 3)
)

and writem(addr, wd) be
[	test ExtendedMemory
	ifnot WriteMEM(addr, wd)
	ifso WriteMEM(addr, wd,
	  (ReadMEM(EMBANKS) rshift (altbank? 0, 2)) & 3)
]