//D0Go.bcpl stuff associated with stop and go of the microprocessor
// Last edited: 20 October 1981
get "mcommon.d"
get "d0.d"
manifest [ get "d0regmem.d" ]
external [
// MIDAS
MidasSwat
// MRGN
RemoveFromEveryTimeList
// MMPRGN
UpdateMPDValues
// MPATTERN
@PATTERN
// MASM
PutsCSS; ResetsCSS; @WssCSS; WssCS1
// MDATA
GoVec
// MSYM
SearchBlocks
// MCMD
DisplayError; ErrorAbort; WnsCSS; FormCmdMenu
CmdCommentStream; QuitCmdOverlay
// MLOAD
DoingLoad
// MINIT0
MStatus
// MGO
@CantContinue; @QuitF
// MPRINS
NWss
// D0I0
DVx; BPTable
// D0I1
d0go
// D0TABLES
@MEMNAM
// D0ASM
sendbyte; sendword; recvbyte; WritePrinter
@utilout; stNotInVM; stNotIMA
// D0REG
ReadAllRegs; ReadRegisters; PutAllRegs
// D0MEM
GetMemData; PutMemData; sovlput; readtpc
// D0VM
LookUpVA; LookUpAA; @VirtualP
//Defined here
DefaultGoMemory; @CheckStopped; Stop; d0Stop; MStopped
SetupIMA; PrCCV; AddBp; BreakAddr
]
static
[ stoppedcode = 0
BreakAddr; BreakTask
MouseHalt
]
//Setup for step or go. Arg1 is true to setup for go, false for step.
//MemX is either IMx or IMXx; NA is 1, indicating that AVec and MemX
//aren't supplied so setup to continue from last breakpoint, or 3 to
//indicate a new go or step for the current task.
//SetupIMA leaves its results in GoVec as described in the "Go"
//structure def in MCOMMON.D.
let SetupIMA(GoP,AVec,MemX,NA,Str,MB) be
[ let DVec1,BPindex = vec 3,nil
test NA ge 3
ifso //New go for current task
[ NA = AVec!1
switchon MemX into
[
case IMx: NA = LookUpAA(NA)
if NA < 0 then ErrorAbort(stNotInVM)
case IMXx: (lv GoVec>>Go.AVec)!1 = NA; endcase
default: ErrorAbort(stNotIMA)
]
]
ifnot //Continue
[ if CantContinue ne 0 do
[ ResetsCSS(); WssCSS("Can't continue after")
PATTERN = CantContinue
NWss(" Test,",didTest)
NWss(" Load,")
// NWss(" PEscan,") //Unused on D0
// NWss(" Call,") //Unused on D0
NWss(" LoadPage,",didLoadPage)
NWss(" Boot,")
NWss(" IMX PE,")
NWss(" R bus PE,")
NWss(" Memory Error,")
NWss(" Stack Overflow,")
NWss(" Multiple BP's at same Page address,")
DisplayError(0,"Try to continue",0,0)
]
DVx>>srbus.ctask = BreakTask
]
WssCSS(Str)
WnsCSS(DVx>>srbus.ctask); PutsCSS($:)
PrCCV(lv GoVec>>Go.AVec,IMXx)
CantContinue = 0
GoVec>>Go.Branch = false
test GoP
ifso
[ GoVec>>Go.RunP = GoRun
//if run from bp, set RunP to GoRunbp
for I = BPmin to BPlen-1 do
[ if (BPTable>>BP↑I.Addr eq (lv GoVec>>Go.AVec)!1) &
(BPTable>>BP↑I.InUse) do
[ GoVec>>Go.RunP = GoRunbp; break
]
]
]
ifnot GoVec>>Go.RunP = GoStep
test GoVec>>Go.RunP eq GoRun
ifso MapAllBp(InsertBp) //Insert bp's from table
ifnot //insert step breakpoint(s)
[ //calculate the effective address, get real m-i from D0
unless GetMemData(IMXx,DVec1,lv GoVec>>Go.AVec) do
MidasSwat(GoVecErr)
//assume m-i in DVec1!0,DVec1!1,DVec1!2
let Ea = nil
let Ja = ((DVec1!1 & #176) rshift 1) %
((DVec1!2 & #30000) rshift 6)
let Pg = (lv GoVec>>Go.AVec)!1 & #7400
let Jc = (DVec1!1 & #1600) rshift 7
switchon Jc into
[
case 6: //RETURN
unless ((DVec1!0 & #77) eq #47) &
((DVec1!1 & #30000) eq #30000) do //test is for control store R/W
[ Ea = DVx>>srbus.apc; endcase;
]
case 4: //GOTO
case 5: //CALL
Ea = Pg % Ja; endcase
case 7: //DISPATCH
Ea = Pg % (Ja & #360) % (#17 & DVx>>srbus.apc)
endcase
default: //BRANCH
Ea = Pg % Ja
GoVec>>Go.Branch=true;
//insert extra bp at Ea xor 1
InsertBp(1,Ea xor 1); //Put the breakpoint in the table
]
InsertBp(0,Ea) //Set bp at effective address (puts it in the table)
]
StartD0()
]
and StartD0() be
[ PutAllRegs()
sendbyte(sovlput(d0go))
sendword((DVx>>srbus.ctask lshift 12) + (lv GoVec>>Go.AVec)!1)
MStatus>>MStatus.MachRunning = true
]
and DefaultGoMemory() = VirtualP ? MEMNAM!IMx, MEMNAM!IMXx
and PrCCV(AVec,MemX) be
[ let VA = AVec!1 //Correct if MemX eq IMx
let AA = VA //Correct if MemX eq IMXx
switchon MemX into
[
default: MidasSwat(PrCCVMemXErr)
case IMXx: VA = LookUpVA(AA); endcase
case IMx: if VA < 0 do
[ WssCSS(stNotInVM); return
]
AA = LookUpAA(VA)
//If VA ge 0 then VA is valid IM address, so LookUpAA must always succeed
if AA < 0 then MidasSwat(PrCCVAAErr)
endcase
]
if VirtualP do
[ if VA ge 0 do
[ let AVec1 = vec 1; AVec1!0 = 0; AVec1!1 = VA
SearchBlocks(CmdCommentStream,IMx,AVec1); return
]
WssCSS("abs ")
]
WnsCSS(AA)
]
//Called from SingleStepM, HaltWait, and HaltProc in MGO. A message like
//"Go at 3:FOO" was printed on CmdCommentStream by SetupIMA; the caller
//may append other text to CmdCommentStream before calling MStopped.
//MStopped appends a string to describe the BP location on
//CmdCommentStream, prints error information on CmdCS1, and cleans up
//after the SS, Go, or whatever.
//GoFlag is omitted for keyboard halts, true for BP or error halts,
//false for SS actions; MStopped returns when GoFlag is false, but does
//QuitCmdOverlay when it is omitted or true.
and MStopped(GoFlag; numargs NA) be
[ MStatus>>MStatus.MachRunning = false
DVx>>srbus.ncia = #7777 xor BreakAddr
if QuitF ge 0 do RemoveFromEveryTimeList(QuitF)
QuitF = -1
UpdateMPDValues()
let DVec = vec 3
//print breakpoint task & address (if any), or print
//out the fact that we stopped by zapping the machine
test stoppedcode eq #101
ifso //Fault
[ WssCSS(", fault at ")
let Errors = DVx>>srbus.parity
if (Errors & #10) ne 0 then WssCS1("StackOvf ")
if (Errors & #4) ne 0 then WssCS1("IMX PE ")
if (Errors & #2) ne 0 then WssCS1("R Bus PE ")
if (Errors & #1) ne 0 then WssCS1("Memory Error ")
if (Errors & #17) eq 0 then WssCS1("Unknown fault reason ")
]
ifnot WssCSS(MouseHalt ? ", Mouse halt at ", ", BP at ")
MouseHalt = false
WnsCSS(DVx>>srbus.ctask); PutsCSS($:)
PrCCV(lv GoVec>>Go.AVec,IMXx)
if (NA < 1) % GoFlag then QuitCmdOverlay()
]
and CheckStopped() = valof
[ stoppedcode = recvbyte()
unless (stoppedcode & #177776) eq #100 do resultis 0
ReadRegisters()
//Undo bp's so that the m-i will show the correct contents.
test GoVec>>Go.RunP eq GoRun
ifso MapAllBp(UndoBp)
//On SS or on a Go for which the starting address has a bp,
//Midas inserts bp's only at the successor to the instruction being
//started, or to both successors if the instruction has a branch
//condition. Remove these now.
ifnot //GoRunbp or GoStep
[ UndoBp(0)
if GoVec>>Go.Branch then UndoBp(1)
]
BreakAddr = DVx>>srbus.ncia xor #7777
BreakTask = DVx>>srbus.ctask
MouseHalt = false
test stoppedcode eq #100
ifso //Normal bp
[ if DVx>>srbus.ctask eq #16 do
[ MouseHalt = true
for i = 0 to BPlen-1 do
[ if BPTable>>BP↑i.InUse eq 0 then loop
//Restart address for mouse halt is at loc+1
if BPTable>>BP↑i.Addr eq BreakAddr do
[ MouseHalt = false; break
]
]
]
test MouseHalt
ifso BreakAddr = BreakAddr+1
ifnot
[
//If the BP instruction followed a LoadPage, its Page bits will be incorrect.
//We scan the BP table. If there was a BP at BreakAddr, breakOK ← true.
//After the scan, breakCnt contains the no. of BPs with the same page address
//as BreakAddr, and xbreakAddr contains the address of the last such BP found.
let breakOK,breakCnt,xbreakAddr = false,0,0
//we only look through BPs that were set (0-1 if stepping, 2-BPlen otherwise).
let first,last = 0,1
if GoVec>>Go.RunP eq GoRun do [ first,last = 2,BPlen-1 ]
for i = first to last do
[ if BPTable>>BP↑i.InUse eq 0 then loop
if BPTable>>BP↑i.Addr eq BreakAddr then [ breakOK = true; loop ]
if (BPTable>>BP↑i.Addr & #377) ne (BreakAddr & #377) then loop
breakCnt = breakCnt+1
xbreakAddr = BPTable>>BP↑i.Addr
]
unless breakOK do //check for real BP where we stopped.
test breakCnt gr 1
//we are confused - set multiple BP flag
ifso CantContinue = CantContinue % didMultBP
//no confusion about which BP - didLoadPage will be set later..
ifnot BreakAddr = xbreakAddr
]
]
//On other faults, the instruction is aborted before execution, so
//CIA is still correct.
ifnot //#101 faults except bp
[
let Errors = DVx>>srbus.parity
if (Errors & #10) ne 0 then
CantContinue = CantContinue % didStkOvf
if (Errors & #4) ne 0 then
CantContinue = CantContinue % didIMXPE
if (Errors & #2) ne 0 then
CantContinue = CantContinue % didRBusPE
if (Errors & #1) ne 0 then
CantContinue = CantContinue % didMemoryError
]
//Breakpoints 0 and 1 are no longer needed. Zap them.
for i = 0 to 1 do BPTable>>BP↑i.InUse = 0
(lv GoVec>>Go.AVec)!1 = BreakAddr
if DVx>>srbus.page ne (BreakAddr rshift 8) then
CantContinue = CantContinue % didLoadPage
//When we started at an instruction which is a bp, we first step
//that instruction, then undo the step breakpoints, insert all the
//bp's from the table and continue. Return 0 indicating no halt in
//this case.
if GoVec>>Go.RunP eq GoRunbp do
[ GoVec>>Go.RunP = GoRun
unless CantContinue ne 0 do
[ MapAllBp(InsertBp)
StartD0(); resultis 0
]
]
resultis stoppedcode
]
and Stop() be
[ @utilout = not 460b
@utilout = not 40460b
@utilout = not 460b
//wait a while
let x = nil
for i = 1 to 100 do x = 0
]
and d0Stop() be
[ WritePrinter(#30400)
WritePrinter(#130400)
let x = nil
for i = 1 to 100 do x = 0
WritePrinter(#20400)
]
//Called from BreakIML and AddToVM
and AddBp(AA) = valof
[ let BPindex = 0
for I = BPmin to BPlen-1 do
[ test BPTable>>BP↑I.InUse
ifso if (BPTable>>BP↑I.Addr eq AA) then resultis 1
ifnot if BPindex eq 0 then BPindex = I
]
//test if BPtable was full
if BPindex eq 0 then resultis 0
//add instruction to breakpoint list
BPTable>>BP↑BPindex.Added = not DoingLoad
BPTable>>BP↑BPindex.InUse = true
BPTable>>BP↑BPindex.Addr = AA
resultis -1
]
//Apply Proc to every bp.
and MapAllBp(Proc) be
[ for I = BPmin to BPlen-1 do
[ if BPTable>>BP↑I.InUse then Proc(I)
]
]
//Rewrite the saved m-i into the bp location
and UndoBp(Ival) be
[ let DVec,AVec = vec 3, vec 2
AVec!0 = 0
AVec!1 = BPTable>>BP↑Ival.Addr
unless PutMemData(IMXx,lv BPTable>>BP↑Ival.w0,AVec) do
MidasSwat(CantUndoBP)
]
//Read and save the m-i at the bp address in BPTable and overwrite the
//m-i with a breakpoint m-i. This is called at the beginning of a
//"Go" or "SS" sequence.
and InsertBp(BPindex,Addr; numargs NA) be
[ let DVec,AVec = vec 3, vec 2
if NA ge 2 then [ BPTable>>BP↑BPindex.Addr = Addr; BPTable>>BP↑BPindex.InUse = 1 ]
AVec!0 = 0
AVec!1 = BPTable>>BP↑BPindex.Addr
//save real m-i in BPTable
unless GetMemData(IMXx,lv BPTable>>BP↑BPindex.w0,AVec) do
MidasSwat(CantGetBPInst)
//build and insert breakpoint
DVec!0 = BpI0
DVec!1 = BpI1 % (((AVec!1) lshift 1) & #176)
DVec!2 = #140000 % (((AVec!1) & #300) lshift 6)
unless PutMemData(IMXx,DVec,AVec) do MidasSwat(CantSetBP)
]