//MDebug.bcpl -- machine-independent part of "Debug" overlay used to
//setup for data generation and checking.
//	17 May 1983

get "mdecl.d"

external [
// OS
	SetBlock; Zero

// MASM
	ResetsCSS; ResetsCS1; @WssCSS; WssCS1; @MBlock; SelfRel

// MDATA
	@DataWas; @ShouldBe; @BitsChecked; @LoopCount
	@LowAddress; @HighAddress; @CurrentAddress; @AddrIncrement
	AddrIntersect; AddrUnion; BitsDropped; BitsPicked; TestFailures

// MIOC
	DWns; Wns; DataToStream

// MRGN
	UpdateDisplay; RemoveFromEveryTimeList; AddToEveryTimeList

// MMENU
	CreateAction; @WsMarkA

// MCMD
	FormCmdMenu; SetAbort; ShowActions
	CmdCommentStream; CmdCS1; @CmdAbortAct

// MINIT0
	@ACTS

// MGO
	@QuitF

// MDEBUGASM
	PatTab; NPatterns

// MPATTERN
	@RANDIX; RanTab; RanLen; @PATTERN; IncV

// xxACTIONS
	@LongOne

// Machine-dependent resident
	@MEMFORMS; @MEMWID; MDATAmemx

// Machine-dependent debug overlay file
	QuitTest

// Defined here
	GetPattern; ShowPattern; SetupPattern
	ErrorStop; WriteComment; ContinueGen; SaveDGen; RestoreDGen; Vec60
	@NDWords; NActs; STAT1; STAT2; STAT3; TestAborted; FreeRunning
	LastName; LastRadix
]

static [
	TestAborted; NActs; DebugProcedure; PATACT
	STAT1	//First string on status line
	STAT2	//Second string on status line
	STAT3	//Number on status line
	@NDWords = TValSize; FreeRunning = false
	Vec60; LastName; LastRadix
]

let GetPattern(NumActs,DebugProc,TimeOut; numargs NA) = valof
[	if NA < 3 then TimeOut = 0
	NActs,DebugProcedure,TestAborted = NumActs,DebugProc,false
	SetAbort(lv TestStop,0)
	PATACT = CreateAction(SelfRel(PatTab),lv SetPattern,0)
	for I = 1 to NPatterns-1 do
	[ CreateAction(SelfRel(PatTab+I),lv SetPattern,I,0,0,TimeOut)
	]
	QuitF = -1; WssCSS("Select data pattern:")
	resultis DebugMenu
]


and SetPattern(PatX,Buttons,nil) be
[	PATTERN = PatX; QuitF = -2; FormCmdMenu()
]


//The caller must initialize BitsChecked when the new item being tested
//differs from the last; also the caller must put a right-justified "1"
//into IncV.  SetupPattern will then mask BitsChecked by DMask and use
//IncV in controlling the SEQUENTIAL, CYC0, and CYC1 test patterns.
and SetupPattern(DMask,Name,Radix) be
[	Zero(LoopCount,2);	Zero(TestFailures,2)
	Zero(AddrUnion,2);	SetBlock(AddrIntersect,-1,2)
	Zero(BitsDropped,NDWords);	Zero(BitsPicked,NDWords)
	switchon PATTERN into
	[
case 0:					//Zeroes
case 7:					//AltZO
case 5:	Zero(ShouldBe,NDWords)		//Sequential
	endcase
case 1:	SetBlock(ShouldBe,-1,NDWords)	//Ones
	endcase
case 3:	for I = 0 to TValSize-1 do	//Cyc0
	[ IncV!I = not IncV!I
	]
case 2:	MBlock(ShouldBe,IncV,NDWords)	//Cyc1
case 4:					//Random
case 6:					//Should-Be
case 8:	endcase				//Alt-Should-Be
	]
	for I = 0 to TValSize-1 do BitsChecked!I = BitsChecked!I & DMask!I
	LastName,LastRadix = Name,Radix
	ResetsCSS(); ShowPattern("Testing ",Name,Radix)
]


and SaveDGen() be
[	Vec60!0 = RANDIX
	MBlock(Vec60+1,RanTab,RanLen)
	MBlock(Vec60+RanLen+1,ShouldBe,NDWords)
]


and RestoreDGen() be
[	RANDIX = Vec60!0
	MBlock(RanTab,Vec60+1,RanLen)
	MBlock(ShouldBe,Vec60+RanLen+1,NDWords)
]

//Procedure called to continue a test aborted for some reason.
//Continues checking with the next word.
and ContinueGen(lvProc,Arg) = valof
[	TestAborted = false; SetAbort(lv TestStop,0)
	QuitF = AddToEveryTimeList(rv lvProc,Arg)
	resultis DebugMenu
]


and DebugMenu(nil,nil) be
[	WsMarkA(CmdAbortAct)
	if QuitF eq -2 then DebugProcedure()
	if QuitF eq -1 do ShowActions(-1,PATACT,NPatterns)
]


and TestStop(nil,Buttons,nil) be
[	test QuitF ge 0
	ifso TestAborted = true
	ifnot ErrorStop("XXX","")
]


and ErrorStop(str1,str2,AVec; numargs NA) be
[	test NA > 0
	ifso
	[ if FreeRunning do	//Not stopping on errors?
	  [ if (TestFailures!1 < 8) % ((TestFailures!1 & 77B) eq 0) do
	    [ ResetsCS1(); DWns(CmdCS1,TestFailures,32,0,10)
	      WssCS1(" failures in ")
	      DWns(CmdCS1,LoopCount,32,0,10); WssCS1(" iterations")
	    ]
	    return
	  ]
	  ResetsCSS(); WssCSS(str1); WssCSS(str2)
	  if NA ge 3 then DWns(CmdCommentStream,AVec)
	]
	ifnot
	[ ResetsCSS(); WssCSS("Test halted by mouse")
	]
	if QuitF ge 0 do
	[ RemoveFromEveryTimeList(QuitF)
	]
	FreeRunning = false
	QuitTest()
]


and ShowPattern(S1,S2,Radix) be
[	WssCSS(S1); WssCSS(S2); WssCSS(" with ")
	WssCSS(SelfRel(PatTab+PATTERN))
	WssCSS(", mask = ")
	DataToStream(CmdCommentStream,MEMFORMS!MDATAmemx,MEMWID!MDATAmemx,
		BitsChecked,Radix)
]


and WriteComment() be
[	ResetsCSS(); WssCSS(STAT1); WssCSS(STAT2)
	if STAT3 ne 177777B then Wns(CmdCommentStream,STAT3,6,8)
	UpdateDisplay()
]