//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)
]