// MemBash.bcpl -- Maxc2 memory contention diagnostic
//	Assumes a memory diagnostic (e.g., DGMR) running on Maxc

//	Last modified June 4, 1978  5:51 PM

get "streams.d"

external
[
Ws; Wss; Gets; Puts; Endofs; Resets; Noop; MoveBlock; Zero
CreateDisplayStream; ShowDisplayStream; StartIO
MemRead; MemWrite; MemRMW
InputSMI; OutputSMI; OutputSMIPulse
InputSMIErrors; OutputSMITest; ExecuteMicroInstruction; LoadBus; ReadBus
LoadRam; SetBLV; USetBLV

RamImage; dsp; keys; lvUserFinishProc; adrMTBS
]

static
[
AltoOperation; NextAdr
altoNumber; maxcNumber; numberTyped; altoCode; testAdr
displayEnabled = true
startAdr = #21
savedUserFinishProc
fatalSE = false; fatalPBF = false
adrMTBS  //external wanted by AltIOUtila.asm
]


manifest
[
//Maxc processor states (software convention)
stateRunning = 0	//processor running
stateBreakpoint = 1	//at micro-breakpoint
stateLocalMemPE = 2	//local memory parity error
stateMainBusPE = 3	//main memory bus parity error
stateHalted = 4		//halted for other reason

//SMI input addresses
smiRUN = #200	//processor run status
smiB0 = #203	//processor bus
smiB1 = #202
smiB2 = #201
smiJKERRS = #43	//memory errors for quadrants J and K
smiLMERRS = #44	//memory errors for quadrants L and M

//SMI output addresses
smiBR0 = #213	//processor bus
smiBR1 = #212
smiBR2 = #211
smiPIR0 = #217
smiPIR1 = #216	//pseudo-instruction register
smiPIR2 = #215
smiPIR3 = #214
smiCR = #210	//control register
smiPLMR = #40	//physical/logical memory module register
smiCONFR = #41	//memory configuration register
smiRESR = #42	//memory error reset register
]

structure RUN:	//processor run status
   [
   blank bit 8
   running bit		//processor is running
   notBreakpoint bit	//not at micro breakpoint
   localPE bit		//local memory parity error
   mainPE bit		//main memory data bus parity error
   ]

structure QErr^0,3 byte	//memory error register (2 words)
manifest		//layout assuming byte right-justified
   [
   qeTimeout = #40
   qeDIP = #20
   qeAPE = #10
   qePBF = #4
   qeDE = #2
   qeSE = #1
   ]

manifest	//processor control register
[
crEIC = #100000	//enable instruction controlled changes
crEB = #40000	//enable changes to branch conditions
crEIMA = #20000	//enable changes to IMA
crENPC = #10000	//enable changes to NPC
crNOTSS = #4000	//don't single step
crSetRun = #2000 //set the run flipflop
crReset = #1000	//reset processor-memory interface
crEPIR = #400	//execute instructions from PIR rather than IM
crRegToB = #200	//put BR register on processor bus
crIntOn = #100	//enable micro-interrupts
crStrobe = #40	//generate interprocessor signal

//normal value sent to CR (e.g., when setting Strobe)
crNormal = crEIC+crEB+crEIMA+crENPC+crNOTSS+crIntOn
]

structure PLMR:	//physical/logical module register
   [
   blank bit 7
   disableCorrection bit
   logicalModule bit 3
   physicalModule bit 3
   quadrant bit 2
   ]

structure CONFR:  //configuration register
   [
   blank bit 4
   eFER bit	//enable reporting of fatal errors
   configuration bit 3  //address/quadrant map
   jSEF bit	//quadrant J single errors fatal
   jPBFF bit	//quadrant J parity bit failures fatal
   kSEF bit
   kPBFF bit
   lSEF bit
   lPBFF bit
   mSEF bit
   mPBFF bit
   ]
manifest allSEF = #252
manifest allPBFF = #125
manifest enableFER = #4000

structure RESR:  //error reset register (all bits complemented)
   [
   blank bit 8
   jResetErrors bit  //reset errors in quadrant J
   jResetQuadrant bit  //completely reset quadrant J
   kResetErrors bit
   kResetQuadrant bit
   lResetErrors bit
   lResetQuadrant bit
   mResetErrors bit
   mResetQuadrant bit
   ]
manifest allResetErrors = #125
manifest allResetQuadrant = #252

structure SMIErr:  //SMI error register
   [
   blank bit 11
   comb bit	//communication strobe B (unused)
   coma bit	//communication strobe A
   nfer bit	//non-fatal error
   fer bit	//fatal error
   blank bit
   ]
manifest smiErrorMask = #12  //bits that we care about (coma, fer)



// ---------------------------------------------------------------------------
let MemBash() be
// ---------------------------------------------------------------------------
[
Ws("MemBash of June 4, 1978")

//load the special Ram microcode
RamImage!0 = #077376  //run tasks 0, 10, 17 in Ram
let res = LoadRam(RamImage, true)  //load and boot
if res ls 0 then
   Ws("*nFailed to load Alto Ram -- Ram or Ethernet board broken")
if res gr 0 then Ws("*nMicrocode constants wrong, beware!")
savedUserFinishProc = @lvUserFinishProc
@lvUserFinishProc = MyFinishProc

Ws("*nAlto MI State  Address  Maxc State    MAR      KMAR     Memory State")

let ds = vec 15000
ds = CreateDisplayStream(30, ds, 15000)
ShowDisplayStream(ds)
dsp = ds

OutputSMITest(#16)
ConfigureMemory(0, 0)

let v = vec 2; maxcNumber = v
let v = vec 1; testAdr = v; Zero(testAdr, 2)
AltoOperation = MemRead
NextAdr = IncrementAdr
Command()
]


// ---------------------------------------------------------------------------
and Command() be
// ---------------------------------------------------------------------------
[
Ws("*n**")
let char = GetKeys()
switchon char into
   [
   case $G: case $g:
      [
      if Confirm("Go") then DoTest()
      endcase
      ]
   case $A: case $a:
      [
      Ws("Alto operation = ")
      switchon GetKeys() into
         [
         case $R: case $r:
            [ Ws("Read"); AltoOperation = MemRead; endcase ]
         case $W: case $w:
            [ Ws("Write"); AltoOperation = MemWrite; endcase ]
         case $M: case $m:
            [ Ws("Modify"); AltoOperation = MemRMW; endcase ]
         case $?:
            [ Ws("? Read, Write, Modify"); loop ]
         default:
            [ Oop(); loop ]
         ]
      Ws(", address sequence = ")
      switchon GetKeys() into
         [
         case $S: case $s:
            [ Ws("Sequential"); NextAdr = IncrementAdr; endcase ]
         case $R: case $r:
            [
            Ws("Repeat at address: ")
            test GetNumber() eq $*n & numberTyped
               ifso MoveBlock(testAdr, maxcNumber+1, 2)
               ifnot [ Oop(); loop ]
            NextAdr = Noop
            endcase
            ]
         case $?:
            [ Ws("? Sequential, Repeat"); loop ]
         default:
            [ Oop(); loop ]
         ]
      endcase
      ]
   case $M: case $m:
      [
      Ws("Maxc start address = ")
      test GetNumber() eq $*n & numberTyped
         ifso startAdr = altoNumber
         ifnot Oop()
      endcase
      ]
   case $D: case $d:
      [
      if Confirm(displayEnabled?
       "Don't display errors", "Display errors") then
         displayEnabled = not displayEnabled
      endcase
      ]
   case $Z: case $z:
      [
      if Confirm("Zap memory") then ResetMemory()
      endcase
      ]
   case $Q: case $q:
      [
      if Confirm("Quit") then finish
      endcase
      ]
   case $?:
      [
      Ws("? Alto operation, Maxc start adr, Go, Display, Zap, Quit")
      endcase
      ]
   case $*n: case $*s:
      endcase
   default:
      Oop(char)
   ]
] repeat


// ---------------------------------------------------------------------------
and DoTest() be
// ---------------------------------------------------------------------------
[
Ws("*nTest running, hit any key to stop")
StartMaxc(startAdr)
   [
   Zero(maxcNumber, 3)
   altoCode = AltoOperation(testAdr, maxcNumber)
   let smiErr = InputSMIErrors()
   if altoCode ne 0 % smiErr<<SMIErr.fer then
      [
      test displayEnabled
         ifso DisplayErrors()
         ifnot Puts(dsp, $?)
      if smiErr<<SMIErr.fer then StartMaxc(startAdr)
      ]
   NextAdr()
   ] repeatwhile Endofs(keys)
StopMaxcForcefully()
Gets(keys)
]


// ---------------------------------------------------------------------------
and IncrementAdr() be
// ---------------------------------------------------------------------------
[
testAdr!1 = (testAdr!1+#10000) & #170000
if testAdr!1 eq 0 then testAdr!0 = (testAdr!0+1) & #37777
]


// ---------------------------------------------------------------------------
and Display20Bit(str,adr) be PrintOctalField(str,adr,0,19)
// ---------------------------------------------------------------------------

// ---------------------------------------------------------------------------
and Display36Bit(str,adr) be
// ---------------------------------------------------------------------------
[
PrintOctalField(str,adr,0,17)
Puts(str,$*s)
PrintOctalField(str,adr,18,35)
]

// ---------------------------------------------------------------------------
and Display40Bit(str,adr) be
// ---------------------------------------------------------------------------
[
test (adr!2 & #7400) ne 0
   ifso PrintOctalField(str,adr,36,39)
   ifnot Wss(str,"  ")
Puts(str,$*s)
Display36Bit(str,adr)
]


// ---------------------------------------------------------------------------
and PrintOctalField(str,adr,firstBit,lastBit) be
// ---------------------------------------------------------------------------
[
let r = (lastBit-firstBit) rem 3
firstBit = firstBit+r
let mask = (2 lshift r)-1
   [
   let q,r = firstBit rshift 4, firstBit&#17
   Puts(str,$0 + ((adr!(q-1) lshift (1+r) +
    adr!q rshift (15-r)) & mask))
   firstBit = firstBit+3
   mask = 7
   ] repeatuntil firstBit gr lastBit
]


// ---------------------------------------------------------------------------
and DisplayErrors() be
// ---------------------------------------------------------------------------
[
Puts(dsp, $*n)
Ws(selecton altoCode into
   [
   case 0:  "             "
   case 1:  "Mem bus PE   "
   case 2:
   case 3:  "Timed out    "
   default: "Impossible   "
   ])
Ws("  ")
Display20Bit(dsp, testAdr)
Ws("  ")
let state = MaxcState()
Ws(selecton state into
   [
   case stateRunning:    "Running     "
   case stateBreakpoint: "Breakpoint  "
   case stateLocalMemPE: "Local mem PE"
   case stateMainBusPE:  "Mem bus PE  "
   case stateHalted:     "Halted      "
   ])
Ws("  ")
if state eq stateRunning then StopMaxcForcefully()
let maxcData = vec 2
ExecuteMicroInstruction( table  // B_MAR
   [ #040102; #077546; #120001; #000000; #003400 ])
ReadBus(maxcData)
Display20Bit(dsp, maxcData+1)
Ws("  ")
ExecuteMicroInstruction( table  // B_KMAR
   [ #040102; #077546; #160001; #000000; #003400 ])
ReadBus(maxcData)
Display20Bit(dsp, maxcData+1)
if state eq stateRunning then StartMaxc()
Puts(dsp, $*s)

let qErr = vec 1
qErr!0 = InputSMI(smiJKERRS)
qErr!1 = InputSMI(smiLMERRS)
OutputSMI(smiRESR, allResetErrors)
for i = 0 to 5 do
   [
   let mask = #401 lshift i
   if (qErr!0 & mask) ne 0 % (qErr!1 & mask) ne 0 then
      [
      Ws(selecton i into
         [
         case 0: " SE: "
         case 1: " DE: "
         case 2: " PBF: "
         case 3: " APE: "
         case 4: " DIP: "
         case 5: " Timeout: "
         ])
      for q = 0 to 3 do
         if (qErr>>QErr^q & mask) ne 0 then Puts(dsp,$J+q)
      ]
   ]
]


// ---------------------------------------------------------------------------
and StartMaxc(microAdr; numargs na) be
// ---------------------------------------------------------------------------
//start Maxc running at the specified micro-address, or just
//resume it if microAdr is not specified
[
if na gr 0 then
   [
   let maxcData = vec 3
   maxcData!0 = 0
   maxcData!1 = microAdr rshift 4
   maxcData!2 = microAdr lshift 12
   LoadBus(maxcData)
   ExecuteMicroInstruction(  // NPC_BR, ENPC
    table [ #040102; #077546; #000000; #020000; #113600 ])
   maxcData!2 = (maxcData!2+#10000) & #170000
   if maxcData!2 eq 0 then maxcData!1 = maxcData!1 + 1
   LoadBus(maxcData)
   ExecuteMicroInstruction(  // NPC_BR, ENPC, EIMA
    table [ #040102; #077546; #000000; #020000; #133600 ])
   ExecuteMicroInstruction(  // IRET, INHINT
    table [ #040102; #077546; #000152; #000000; #103400 ])
   ]
ExecuteMicroInstruction(  // WRESTART, KWRESTART
 table [ #040102; #077546; #000110; #160000; #103400 ])
ExecuteMicroInstruction(  // FRZBALUBC, EIC, EB, ENPC, EIMA, NOTSS, Strobe
 table [ #040102; #077546; #000155; #000000; #177140 ])
InputSMIErrors()
]


// ---------------------------------------------------------------------------
and StopMaxcForcefully() be
// ---------------------------------------------------------------------------
   OutputSMI(smiCR,not (crEIC+crEB+crEIMA+crENPC+crIntOn))


// ---------------------------------------------------------------------------
and MaxcState() = valof
// ---------------------------------------------------------------------------
[
let runReg = InputSMI(smiRUN)
if runReg<<RUN.running resultis stateRunning
unless runReg<<RUN.notBreakpoint resultis stateBreakpoint
if runReg<<RUN.localPE resultis stateLocalMemPE
if runReg<<RUN.mainPE resultis stateMainBusPE
resultis stateHalted
]


// ---------------------------------------------------------------------------
and ResetMemory() be
// ---------------------------------------------------------------------------
[
OutputSMI(smiRESR, 0)  //full reset
ConfigureMemory(0, 0)
]


// ---------------------------------------------------------------------------
and ConfigureMemory(map,fatality) be
// ---------------------------------------------------------------------------
//setup the memory system with the logical-physical mapping
//defined by "map", which is in the following form (see Maxc 11.6):
//	B0:	disable error correction for module 0
//	B1-3:	logical module assignment for module 0
//	B4:	disable error correction for module 1
//	etc.
//"fatality" determines whether SE and PBF are fatal:
//	B0:	SE fatal
//	B1:	PBF fatal
[
//set standard quadrant configuration (0) and fatality as specified
fatalSE = (fatality & #100000) ne 0
fatalPBF = (fatality & #40000) ne 0
OutputSMI(smiCONFR, enableFER+(allSEF&fatalSE)+(allPBFF&fatalPBF))

//set logical-physical map for each module in each quadrant
if map eq 0 then map = #040142  //standard configuration
for m = 0 to 3 do for q = 0 to 3 do
   [
   let plmr = map rshift (7-4*m)  //position ec and log mod number
   plmr<<PLMR.physicalModule = m
   plmr<<PLMR.quadrant = q
   OutputSMIPulse(smiPLMR,plmr)
   ]
OutputSMI(smiRESR, allResetErrors)
]


// ---------------------------------------------------------------------------
and GetNumber() = valof
// ---------------------------------------------------------------------------
//inputs an octal number from the keyboard, ignoring spaces.
//returns a 16-bit result in altoNumber and a 40-bit result
//in maxcNumber.  numberTyped will be true iff a number was typed
[
altoNumber = 0
Zero(maxcNumber,3)
numberTyped = false
   [
   let char = GetKeys()
   if char eq $*s then [ Puts(dsp,char); loop ]
   if char ls $0 % char gr $7 then resultis char
   numberTyped = true
   Puts(dsp,char)
   altoNumber = altoNumber lshift 3 + char-$0
   let overflow = maxcNumber!0 rshift 13
   maxcNumber!0 = maxcNumber!0 lshift 3 + maxcNumber!1 rshift 13
   maxcNumber!1 = maxcNumber!1 lshift 3 + maxcNumber!2 rshift 13
   maxcNumber!2 = (maxcNumber!2 & #010400) lshift 3 +
    (char-$0) lshift 12 + overflow lshift 8
   ] repeat
]


// ---------------------------------------------------------------------------
and Confirm(prompt; numargs na) = valof
// ---------------------------------------------------------------------------
[
if na gr 0 then Ws(prompt)
Ws(" [confirm] ")
   [
   switchon GetKeys() into
      [
      case $Y: case $y: case $*n: case $.:
         [ Ws("Yes."); resultis true ]
      case $N: case $n: case $*177:
         [ Ws("No."); resultis false ]
      ]
   Oop()
   ] repeat
]


// ---------------------------------------------------------------------------
and Oop(char; numargs na) be
// ---------------------------------------------------------------------------
[
if na gr 0 then Puts(dsp,char)
Ws(" ? ")
Resets(keys)
]


// ---------------------------------------------------------------------------
and GetKeys() = Gets(keys)
// ---------------------------------------------------------------------------


// ---------------------------------------------------------------------------
and MyFinishProc() be
// ---------------------------------------------------------------------------
[
@lvUserFinishProc = savedUserFinishProc
USetBLV(#177776)
StartIO(#100000)
]


// ---------------------------------------------------------------------------
and Ws(string) be Wss(dsp, string)
// ---------------------------------------------------------------------------