//MXTST.BCPL

//Microprocessor diagnostic overlay (MXTALL.BCPL also in overlay)

get "mx.d"

//FieldTest() allows any of the fields in a microinstruction to be repeatedly
//executed from the Alto and modified under mouse control for scope loops.
//The initial field value is zero, and values for all other fields are taken
//from the NOP (no-operation) microinstruction.  The data pattern is
//repeatedly loaded into BR and executed.  When the loop is stopped, the
//final instruction tested is left in TSTINS.

//DataTest() allows any register or memory to be tested using a data pattern
//selected from the following:
//	ZEROES	all 0's data
//	ONES	all 1's data
//	CYC1	cycled 1 in word of 0's
//	CYC0	cycled 0 in word of 1's
//	RANDOM	random data
//	ALTZO	alternating all-0's and all-1's
//	SEQ	sequential integers 0, 1, ...
//	ALTGD	alternates SHOULD-BE with its complement

//Whenever a TEST stops, the last value of test data is in SHOULD-BE,
//last value read back in DATA-WAS, and number of successful iterations
//prior to halting in LOOP-COUNT.  Tests write data, read it back, compare,
//halt if any bits selected by BITS-CHECKED are wrong, modify the data
//under control of the pattern, and loop.

//Memory tests presently write all words in the address range being tested
//sequentially, then read and check the words sequentially.  The left
//and right 18-bit half-words for LOW-HIGH control the address range,
//with the upper bound being ignored if greater than the hardware maximum
//for the memory being tested.

//MicTest(Count,A0,A1,A2,A3,A4,A5) a count of LDR addresses and one to six
//LDR addresses.  If only one address is passed, then an endless repeat of
//loading BR with the selected data pattern and executing the
//selected LDR instruction takes place.  If more than one address is passed,
//then the sequence is executed endlessly, the first preceded by loading
//BR with the selected data pattern and the last followed by reading
//and checking 36 bits of result.  This means that to check fewer bits
//a mask left-justified in 36 bits of BITS-CHECKED should be used.

static [
	STAT1		//First string on status line
	STAT2		//Second string on status line
	STAT3		//Number on status line
	Inscnt; Ins0; Ins1; Ins2; Ins3; Ins4; Ins5
]

//Scope loop for various microinstruction fields

static [ INCact; DECact; RSHact; LSHact ]

let FieldTest() = valof
[	WssCSS("Instruction field for scope loop:")
	DefField("BT",0); DefField("BC",1)
	DefField("LA",2); DefField("RA",3)
	DefField("PS",4); DefField("QS",5)
	DefField("AF",6); DefField("BS",7)
	DefField("BD",8); DefField("F1",9)
	DefField("F2",10); DefField("SA",11)
	QUITact = CreateAction("Abort", lv StopFldLoop,nil,0,$C-100B)
	QuitF = -1
	resultis FieldMenu
]


//Storage for TSTACT allocated during initialization
and DefField(str,FldX) be
[	REGACT!FldX = CreateAction(str,lv TestFld,FldX)
]


and FieldMenu(S,Nix) be
[	WsMarkA(QUITact)
	test QuitF ls 0
	ifso [ for I = 0 to NFLDS-1 do WsMarkA(REGACT!I) ]
	ifnot
	[ WsMarkA(INCact); WsMarkA(DECact)
	  WsMarkA(RSHact); WsMarkA(LSHact)
	]
]


and StopFldLoop(S,garb,Buttons,garb1) be
[	Resets(CmdCommentStream)
	WssCSS(QuitF ge 0 ? "Field iteration finished","XXX")
	MaxcStopped(false)
]

and RshF(S,garb,Buttons,FldX) be
[	STAT3 = STAT3 rshift 1; ChangeField(FldX)
]


and LshF(S,garb,Buttons,FldX) be
[	STAT3 = STAT3 lshift 1; ChangeField(FldX)
]


and IncF(S,garb,Buttons,FldX) be
[	STAT3 = STAT3+1; ChangeField(FldX)
]


and DecF(S,garb,Buttons,FldX) be
[	STAT3 = STAT3-1; ChangeField(FldX)
]


//For fields, create a microinstruction which is a no-op except for the
//selected field.  Begin testing with 0 in the field, modifying the value
//under mouse control.  Whenever the value changes, reload PIR0-PIR3 and
//enter a loop in which CR is repeatedly loaded.
//fld is the field index, str is a status string to be displayed
//Note that TSTINS is the displacement of the instruction into LDRMEM
//while INSTST is a direct pointer to the instruction being tested
and TestFld(S,garb,Buttons,FldX) be
[	LoadDone = false	//Indicate storage smashed in case of "Dump"
	MoveBlock(INSTST,LDRMEM+NOP,5)
	STAT2 = " "; STAT3 = 0
	INCact = CreateAction("+1",lv IncF,FldX)
	DECact = CreateAction("-1",lv DecF,FldX)
	RSHact = CreateAction("Rshift",lv RshF,FldX)
	LSHact = CreateAction("Lshift",lv LshF,FldX)
	QuitF = AddToEveryTimeList(FieldLoop,FldX)
	FormMenu(CmdMDFS,FormCmdmenuText); ChangeField(FldX)
]


and ChangeField(FldX) be
[	STAT3 = STAT3 & (table [ 3; 37B; 37B; 37B; 77B; 7; 37B; 37B; 37B; 77B; 17B; 377B ] ) !FldX
	STAT1 = (REGACT!FldX)!0
//Args to PutField are bit1, nbits, DVec, value
	PutField(table [ 0; 2; 7; 12; 17; 23; 26; 31; 36; 41; 47; 51 ] ! FldX,
		table [ 2; 5; 5; 5; 6; 3; 5; 5; 5; 6; 4; 8 ] !FldX,
		INSTST,STAT3)
	WriteComment()
]


and FieldLoop(FldX) be XctL36(TSTINS,GOODD)

//Test of register/memory using various data patterns

and DataTest() = valof
[	STAT1 = "Testing "; STAT3 = -1
	for I = 0 to NREALREGS-1 do	//Skip non read-write regs
	[ REGACT!I = CreateAction(REGNAM!I,lv TestReg,I) ]
	for I = 0 to 1 do	//IMh and IMl
	[ MEMACT!I = CreateAction(MEMNAM!I,lv TestMem,I) ]
	for I = 3 to 5 do	//SM, DM, and MP (skipping 72-bit IM)
	[ MEMACT!(I-1) = CreateAction(MEMNAM!I,lv TestMem,I) ]
	for I = 7 to NREALMEMS-1 do	//Skip MAIN and LDR
	[ MEMACT!(I-2) = CreateAction(MEMNAM!I,lv TestMem,I) ]
	GetPattern(0); resultis TestMenu
]


and TestMenu(S,Nix) be
[	WsMarkA(QUITact)
	if QuitF eq -2 do
	[ WssCSS("Select register or memory:")
	  for I = 0 to NREALREGS-1 do WsMarkA(REGACT!I)
	  for I = 0 to NREALMEMS-3 do WsMarkA(MEMACT!I)
	]
	if QuitF eq -1 do
	[ for I = 0 to NPATS-1 do WsMarkA(PATACT!I) ]
]


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


and ErrorStop(str1,str2) be
[	Resets(CmdCommentStream)
	WssCSS(str1 eq 0 ? "Data compare error testing ",str1)
	WssCSS(str2)
	if QuitF ge 0 do
	[ RightAdjust(MASK,DMASK,TestWidth)
	  RightAdjust(GDATA,GOODD,TestWidth)
	  RightAdjust(DATA,ACTD,TestWidth)
	]
	MaxcStopped(false)
]

and TestReg(S,garb,Buttons,RegX) be
[	TestWidth = REGWID!RegX
	LeftAdjust(MASK,DMASK,TestWidth)
	QuitF = AddToEveryTimeList(TestRLp,RegX)
	STAT2 = REGNAM!RegX; WriteComment()
	FormMenu(CmdMDFS,FormCmdmenuText)
]


and TestRLp(RegX) be
[	for I = 1 to 100 do
	[ PutRegData(RegX,GOODD); GetRegData(RegX,ACTD)
	  if CheckData() then ErrorStop(0,STAT2)
	]
]


and TestMem(S,garb,Buttons,MemX) be
[	LoadDone = false	//Indicate state smashed in case of "Dump"
	TestWidth = MEMWID!MemX
	LeftAdjust(MASK,DMASK,TestWidth)
	STAT2 = MEMNAM!MemX; WriteComment()
	QuitF = AddToEveryTimeList(selecton MemX into
		[ case 9: TestSTKLp
		  default: TestMLp
		] ,MemX)
	TAVEC!0 = 0
//The left and right halves of the right-most 36 bits of the LDRMEM
//location LOW-HIGH contain the lower bound on the low address and the
//upper bound on the high address.  If the low bound is greater than
//the maximum for this memory, set it to zero.
	HIGHADDR = (MEMLEN!MemX)-1; LOWADDR = ADRANG!3 rshift 2
	if LOWADDR gr HIGHADDR do [ LOWADDR = 0; ADRANG!3 = 0 ]
	if HIGHADDR gr ADRANG!4 then HIGHADDR = ADRANG!4
	FormMenu(CmdMDFS,FormCmdmenuText)
]


//LOW-HIGH doesn't affect STK
and TestSTKLp(MemX) be
[	let Vals = vec 12		//Special for STK
	for I = 11 to 0 by -1 do
	[ XctL12(LDNPC,GOODD); XctMic(CALL)
	  Vals!I = GOODD!0; NextGDATA()
	]
	for I = 0 to 11 do
	[ XctR12(RDSTK,ACTD); GOODD!0 = Vals!I
	  if CheckData() then ErrorStop(0,STAT2)
	  XctMic(POPSTK)
	]
]


and TestMLp(MemX) be
[	let SaveRX,SaveRD,SaveGD = RANDIX,RANDATA,vec 3
	MoveBlock(SaveGD,GOODD,3)
	for I = LOWADDR to HIGHADDR do
	[ TAVEC!1 = I; PutMemData(MemX,TAVEC,GOODD); NextGDATA() ]
	RANDIX = SaveRX; RANDATA = SaveRD
	MoveBlock(GOODD,SaveGD,3)
	for I = LOWADDR to HIGHADDR do
	[ TAVEC!1 = I; GetMemData(MemX,TAVEC,ACTD)
	  if CheckData() then ErrorStop(0,STAT2)
	]
]

and MicTMenu(S,Nix,MarkS) be
[	WsMarkA(QUITact)
	if QuitF eq -1 do
	[ for I = 0 to NPATS-1 do WsMarkA(PATACT!I) ]
	if QuitF eq -2 do
	[ LoadDone = false
	  QuitF = AddToEveryTimeList((Inscnt eq 1 ? RepLDR1, RepLDRn),0)
	  WriteComment()
	]
]


//This procedure initiates "ConstructedTest".  Its args are an address
//count and a vector of 1 to 6 LDR addresses.  If a single address is
//passed, it is repeatedly executed from the Alto, preceded by generation
//of the selected data pattern.  If more than one arg, then the sequence of
//LDR addresses is executed as a test, preceded by generation of the
//data pattern, followed by a compare of the initial data against the
//result read back.  BITS-CHECKED should have a left-justified data compare
//mask.
and MicTest(count,AV) = valof
[	STAT1 = count eq 1 ? "Repeating LDR instruction",
		"Repeating test sequence of LDR addresses"
	STAT2 = ""; STAT3 = -1
	Ins5 = AV!5; Ins4 = AV!4; Ins3 = AV!3; Ins2 = AV!2; Ins1 = AV!1; Ins0 = AV!0
	Inscnt = count; TestWidth = 36; LeftAdjust(MASK,DMASK,TestWidth)
	GetPattern(NREALREGS+NREALMEMS-2); resultis MicTMenu
]


and RepLDR1() be
[	for I = 1 to 100 do
	[ XctL36(Ins0,GOODD); NextGDATA()
	  if TestAborted then ErrorStop("Halted by mouse","")
	]
]


and RepLDRn() be
[ for I = 1 to 100 do
  [	XctL36(Ins0,GOODD)
	test Inscnt ls 3
	ifso [ XctR36(Ins1,ACTD) ]
	ifnot
	[ XctMic(Ins1); test Inscnt ls 4
	  ifso [ XctR36(Ins2,ACTD) ]
	  ifnot
	  [ XctMic(Ins2); test Inscnt ls 5
	    ifso [ XctR36(Ins3,ACTD) ]
	    ifnot
	    [ XctMic(Ins3); test Inscnt ls 6
	      ifso [ XctR36(Ins4,ACTD) ]
	      ifnot [ XctMic(Ins4); XctR36(Ins5,ACTD) ]
	    ]
	  ]
	]
	if CheckData() then ErrorStop("Data compare error","")
  ]
]

//Check the 36-bit data in ACTD against GOODD using mask DMASK.
//Returns 0 on data ok with COUNT incremented and next data pattern
//in GOODD; returns 1 when a "B" is typed after reading new value for
//BBS; returns 2 on data error or anything other than "B" typed.
and CheckData() = valof
[	for I = 0 to 2 do
	[ if ((GOODD!I xor ACTD!I) & DMASK!I) ne 0 then resultis true
	]
//ITRCNT is equivalent to LDRMEM+COUNT
	DoubleAdd(ITRCNT+3,LongOne)
	if TestAborted then ErrorStop("Test halted by mouse","")
	NextGDATA(); resultis false
]


and NextGDATA(Temp) be
[	switchon PATTERN into [
case 2:
case 3:	[ Temp = GOODD!0 rshift 3
	  GOODD!0 = (GOODD!0 lshift 1) + (GOODD!1 rshift 15)
	  GOODD!1 = (GOODD!1 lshift 1) + (GOODD!2 rshift 15)
	  GOODD!2 = ((GOODD!2 lshift 1) + Temp) & 170000B; return ]
case 4:	[ RANDIX = (RANDIX+1)&7
	  for I = 0 to 2 do
	  [ RANDATA = RANDATA + table [ 134134B; 054206B; 036711B
		103625B; 117253B; 154737B; 041344B; 006712B
		134134B; 054206B ] !RANDIX
	    GOODD!I = RANDATA; RANDIX = RANDIX+1
	  ]
	  return
	]
case 5:
case 7:	[ GOODD!0 = not GOODD!0; GOODD!1 = not GOODD!1
	  GOODD!2 = (not (GOODD!2)) & 170000B; return ]
case 6:	[ GOODD!2 = GOODD!2 + 10000B
	  if GOODD!2 eq 0 then DoubleAdd(GOODD,LongOne)
	  return ]
	]
]

//Subroutine to copy a right-justified value from an 80-bit LDR address
//to a 3-word DataVec.  Args are:
// (1) Pointer to 5-word LDR vector
// (2) Pointer to DataVec
// (3) Number of bits to be in DataVec
and LeftAdjust(LDRvec,DVec,Width) be
[	let Bit1 = 0
	LDRvec = LDRMEM+LDRvec
	Zero(DVec,3)
	if Width > 32 do
	[ PutField(Bit1,Width-32,DVec,LDRvec!2)
	  Bit1 = Bit1+Width-32; Width = 32
	]
	if Width > 16 do
	[ PutField(Bit1,Width-16,DVec,LDRvec!3)
	  Bit1 = Bit1+Width-16; Width = 16
	]
	PutField(Bit1,Width,DVec,LDRvec!4)
]


//Subroutine to copy a left-justified DataVec of a given size to a
//right-justified 80-bit LDR location.  Args are:
// (1) Pointer to 5-word LDR vector
// (2) Pointer to DataVec
// (3) Number of bits in Datavec
and RightAdjust(LDRvec,DVec,Width) be
[	let I,Bit1 = 0,80-Width
	LDRvec = LDRMEM+LDRvec
	Zero(LDRvec,5)
	while Width > 16 do
	[ PutField(Bit1,16,LDRvec,DVec!I)
	  I = I+1; Width = Width-16; Bit1 = Bit1+16
	]
	PutField(Bit1,Width,LDRvec,(DVec!I) rshift (16-Width))
]


//Display strings STAT1 and STAT2 and if STAT3 ne 177777B the
//integer STAT3 on command line
and WriteComment() be
[	Resets(CmdCommentStream); WssCSS(STAT1);
	WssCSS(STAT2)
	if STAT3 ne 177777B then Wos(CmdCommentStream,STAT3)
	UpdateDisplay()
]