//MTest.bcpl -- machine-independent part of "Test" overlay
//	27 June 1983

get "mdecl.d"
get "mcommon.d"

external [
// OS
	Noop; SetBlock; Zero; DoubleAdd

// MIDAS
	MidasSwat

// MASM
	@MBlock; SelfRel; DoubleNeg; VUsc
	@WssCSS; WssCS1; PutsCSS; PutsCS1; ResetsCSS; ResetsCS1

// MDATA
	@DataWas; @ShouldBe; @BitsChecked; TestFailures
	@LowAddress; @HighAddress; @CurrentAddress; @AddrIncrement

// xxACTIONS
	@LongOne; ConTAllAct; SkipTAllAct; ConTAct; FreeRunTAct
	NewEscAction; NewCRAction

// MRGN
	UpdateDisplay; AddToEveryTimeList; RemoveFromEveryTimeList

// MMENU
	CreateAction; @WsMarkA; PrintActionTime

// MMPRGN
	BadAltIn; MDatatoCSS; RDatatoCSS

// MIOC
	DWns

// MCMD
	WnsCSS; CmdCommentStream; FormCmdMenu; LoadDone

// MINIT0
	@ACTS

// MGO
	@QuitF; @CantContinue

// MDEBUG
	GetPattern; SetupPattern; ShowPattern; ErrorStop
	SaveDGen; RestoreDGen; ContinueGen
	@NDWords; @TestWidth; TestAborted; NActs; FreeRunning
	LastName; LastRadix

// MPATTERN
	CheckData; NextData; IncV

// Machine-dependent assembly files
	@MEMNAM; @MEMWID; @MEMCON; @MEMFORMS; AltMInput; AltMForms
	@REGNAM; @REGWID; @REGCON; @REGFORMS; AltRInput; AltRForms
	@MEMLEN; @NMEMS; @NREGS

// Machine-dependent resident
	GetMemData; PutMemData; GetRegData; PutRegData; MDATAmemx

// Machine-dependent test overlay assembly file
	NOtherTests; OtherNAM; OtherWID; OtherProc; OtherPrint
	OtherMask; OtherTST; OtherOne
	MEMMask; MEMAnalyze; MEMTST; MEMOne
	REGMask; REGAnalyze; REGTST; REGOne

// Machine-dependent test overlay file
	ValidateTest

// Defined here
	DataTest; ContinueTest; FreeRunTest
	TestAll; ContinueTAll; SkipTAll; LastVal
]

static [ CCSCnt; TAllState; LastX; LastVal; lvLastLp; LastPrint; LastPhase
]


//Test of register/memory/other using various data patterns
let DataTest(nil,nil) = valof
[	CheckTestTables()
	let J = 0
	for I = 0 to NREGS-1 do if TestOK(REGTST!I) ne 0 do
	[ ACTS!J = CreateAction(REGNAM!I,lv StartTest,I,0,0,1)
	  J = J+1
	]
	for I = 0 to NMEMS-1 do if TestOK(MEMTST!I) ne 0 do
	[ ACTS!J = CreateAction(MEMNAM!I,lv StartTest,NREGS+I,0,0,1)
	  J = J+1
	]
	for I = 0 to NOtherTests-1 if TestOK(OtherTST!I) do
	[ ACTS!J = CreateAction(SelfRel(OtherNAM+I),
		lv StartTest,NREGS+NMEMS+I,0,0,1)
	  J = J+1
	]
	resultis GetPattern(J,TestSelect)
]


//Verify length of test tables (easy to forget editting)
and CheckTestTables() be
[	if	((REGMask-MEMMask) ne NMEMS) %
		((REGTST-MEMTST) ne NMEMS) %
		((REGAnalyze-MEMAnalyze) ne NMEMS) %
		((REGOne-MEMOne) ne NMEMS) %
		((MEMTST-REGMask) ne NREGS) %
		((MEMAnalyze-REGTST) ne NREGS) %
		((MEMOne-REGAnalyze) ne NREGS) %
		((OtherNAM-REGOne) ne NREGS) then MidasSwat(TestAsmEdit)
]


//The REGTST, MEMTST, and OtherTST tables contain pointers either to
//statics that assume the values -1 or 0 or to procedures that return
//a -1 or 0 value, according to whether or not the item should presently
//appear in the test menu.  It is intended that the contents of the Test
//menu be varied according to which boards of the hardware assembly are
//currently operable.
and TestOK(Val) = selecton Val!0 into
[ case 0:	 0
  case -1:	-1
  default:	(rv Val)()
]


and TestSelect(nil,nil) be
[	WssCSS("Select register, memory, or other test:")
	for I = 0 to NActs-1 do WsMarkA(ACTS!I)
]


and ContinueTest(nil,nil) = valof
[	ValidateTest(LastVal)
	ShowPattern("Resume testing ",LastName,LastRadix)
	let R = ContinueGen(lvLastLp,LastX)
	(rv LastPrint)(LastX)
	resultis R
]


and FreeRunTest(nil,nil) = valof
[	FreeRunning = true; resultis ContinueTest()
]

//Copy the format vector, width, alternate input, and alternate output
//procedures for the item being tested into the table entries for MDATA.
//BITS-CHECKED, SHOULD-BE, DATA-WAS, BITS-DROPPED, and BITS-PICKED in
//MDATA will then print exactly like the item being tested.  IncV is a
//vector of value "1" for the item being tested, used to control the
//SEQUENTIAL, CYC0, and CYC1 test patterns.

//BITS-CHECKED is initialized to a full-sized mask for the item being
//tested iff this test is a repeat of the immediately preceding test.
//For memory tests, HIGH-ADDR is reset if greater than the memory max.
//and LOW-ADDR is then reset if greater than HIGH-ADDR.  For short
//memories (le 10000 words), the address range is reset if the item
//being tested differs from the last item tested.
and StartTest(X,nil,nil) be
[	NewEscAction,NewCRAction = ConTAct,FreeRunTAct
	let Name,CON,MaskT,WidthT,Form,IncT = nil,nil,nil,nil,nil,nil
	let AltIn,AltOut = BadAltIn,MDatatoCSS
	test X < NREGS

//Register tests
	ifso
	[ Name,CON,MaskT,WidthT = REGNAM!X,REGCON!X,REGMask,REGWID
	  Form,IncT = REGFORMS!X,REGOne
	  LastPrint,lvLastLp = lv Noop,lv TestRLp
	  AltIn = AltRInput!X
	  if AltRForms!X ne RDatatoCSS then AltOut = AltRForms!X
	  ValidateTest(X)
	]
	ifnot
	[ X = X-NREGS
	  test X < NMEMS

//Memory tests
	  ifso
	  [ Name,CON,MaskT = MEMNAM!X,MEMCON!X,MEMMask
	    WidthT,Form,IncT = MEMWID,MEMFORMS!X,MEMOne
	    AltIn,AltOut = AltMInput!X,AltMForms!X
	    LastPrint,lvLastLp,LastPhase = lv ShowRange,lv TestMLp,0
	    LoadDone = false	//To warn against "Dump" later
	    let High = vec 1; High!0,High!1 = -1,-1
	    DoubleAdd(High,MEMLEN+X+X)
	    if Name ne LastName then
	      if (High!0 eq 0) & (High!1 < 10000B) do
	      [ MBlock(HighAddress,High,2)
		Zero(LowAddress,2)
	      ]
//Make sure upper/lower bounds are legal
	    if VUsc(High,HighAddress,2) < 0 then MBlock(HighAddress,High,2)
	    if VUsc(LowAddress,HighAddress,2) > 0 then Zero(LowAddress,2)
	    if (AddrIncrement!0 eq 0) & (AddrIncrement!1 eq 0) then
		MBlock(AddrIncrement,LongOne,2)
	    ValidateTest(X+NREGS)
	    InitTAddr()
	  ]

//Special machine-dependent tests
	  ifnot
	  [ X = X-NMEMS
//**Name eq LastName iff test overlay is loaded in the same position as
//**it was last time.  Radix should really be controllable somehow.
	    Name,CON,MaskT = SelfRel(OtherNAM+X),100000B,OtherMask
	    WidthT,Form,IncT = OtherWID,0,OtherOne
	    LastPrint,lvLastLp = OtherPrint!X,OtherProc!X
	    ValidateTest(X+NREGS+NMEMS)
	  ]
	]
	if Name ne LastName do
	[
//Reset BitsChecked iff testing item different from last time.
	  SetBlock(BitsChecked,-1,NDWords)
	]
	MBlock(IncV,SelfRel(IncT+X),NDWords)
	let Radix = table [ 8; 10; 16; 8 ] !(CON<<MRType.DefRadix)
	MEMFORMS!MDATAmemx = Form
	MEMWID!MDATAmemx = WidthT!X
	AltMInput!MDATAmemx = AltIn
	AltMForms!MDATAmemx = AltOut
	CantContinue = CantContinue % didTest
	LastX = X
	QuitF = AddToEveryTimeList(rv lvLastLp,X)
	SetupPattern(SelfRel(MaskT+X),Name,Radix); SaveDGen()
	(rv LastPrint)(X)
	FormCmdMenu(); UpdateDisplay()
]


and TestRLp(RegX) = valof
[	for I = 0 to 49 do
	[ NextData()
	  PutRegData(RegX,ShouldBe)
	  GetRegData(RegX,DataWas)
	  if CheckData() then ErrorStop(REGNAM!RegX," failed")
	]
	if TestAborted then FAnalyze(REGAnalyze+RegX)
	PrintActionTime(); resultis true
]


and FAnalyze(FPtr) be
[	FPtr = SelfRel(FPtr)
//Enough failures to analyze?
	test VUsc(TestFailures,FPtr,2) ge 0
	ifso
	[ ((FPtr!2)!0)()
	]
	ifnot ErrorStop()
]


and ShowRange() be
[	let direction = AddrIncrement!0 < 0
	WssCSS(" from ")
	DWns(CmdCommentStream,(direction ? HighAddress,LowAddress))
	WssCSS(" to ")
	DWns(CmdCommentStream,(direction ? LowAddress,HighAddress))
	WssCSS(" by ")
	DWns(CmdCommentStream,AddrIncrement,32,0,-8)
]


//Returns true at end of pass through memory, else false for TestAll.
//LastPhase is 0 during the write phase, 1 during the reads, or 2
//after a CheckData failure causes ErrorStop.
and TestMLp(MemX) = valof
[	if TestAborted then FAnalyze(MEMAnalyze+MemX)
	for I = 0 to 49 do
	[ NextData()
	  test LastPhase eq 0
	  ifso
	  [ PutMemData(MemX,ShouldBe,CurrentAddress)
	    if AdvanceMemAddr() do	//If done with the writes...
	    [ RestoreDGen(); InitTAddr(); LastPhase = 1
	    ]
	  ]
	  ifnot
	  [ test LastPhase eq 1
	    ifso			//Not continuing after ErrorStop
	    [ GetMemData(MemX,DataWas,CurrentAddress)
	      if CheckData() do
	      [ LastPhase = 2
	        ErrorStop(MEMNAM!MemX," failed at ",CurrentAddress)
	      ]
	    ]
	    ifnot LastPhase = 1		//Continuing after ErrorStop
	    if AdvanceMemAddr() do	//If done with the reads...
	    [ SaveDGen(); InitTAddr(); LastPhase = 0
	      PrintActionTime(); resultis true
	    ]
	  ]
	]
	PrintActionTime(); resultis false
]


//Start at HighAddress if AddrIncrement negative, else at LowAddress
and InitTAddr() be
[	MBlock(CurrentAddress,
		(AddrIncrement!0 < 0 ? HighAddress,LowAddress),2)
]


//Advance CurrentAddress by AddrIncrement and return true if new address
//is outside the address range (Low le Current le High are ok)
and AdvanceMemAddr() = valof
[	DoubleAdd(CurrentAddress,AddrIncrement)
	if CurrentAddress!0 < 0 then resultis true
	resultis VUsc(CurrentAddress,HighAddress,2) > 0
]

and TestAll(nil,nil) = valof
[	CheckTestTables()
//Require Timeout action before pattern action in command file
	TAllState = 0; resultis GetPattern(0,TAllDoIt,1)
]


and TAllDoIt() be
[	QuitF = AddToEveryTimeList(TAllRM,nil)
	NewEscAction,NewCRAction = ConTAllAct,SkipTAllAct
	MBlock(AddrIncrement,LongOne,2)
	CantContinue = CantContinue % didTest
	ResetsCSS(); CCSCnt = 0
]


and ContinueTAll(nil,nil) = valof
[	ShowPattern("Resume TestAll of ",LastName,LastRadix)
	(rv LastPrint)(LastX)
	resultis ContinueGen(lv TAllRM,nil)
]


and SkipTAll(nil,nil) = valof
[	TAllState = (TAllState+4) & 177774B
	resultis ContinueGen(lv TAllRM,nil)
]


//The MEMMask, REGMask, and OtherMask tables control which registers,
//memories, and other tests get called for TestAll.
//The table entries are 0, indicating don't test, or a self-relative
//pointer to a DVec of size NDWords which is the mask used for testing.
and TAllRM(nil) be
[	test TAllState ge (NREGS lshift 2)
	ifso
	[ if TAllState < 400B then TAllState = 400B
	  let MemX = (TAllState-400B) rshift 2
	  test MemX ge NMEMS
	  ifso
	  [ if TAllState < 1000B then TAllState = 1000B
	    if TAllState ge (1000B+(NOtherTests lshift 2))
		then ErrorStop("Everything AOK","")
	    let OtherX = (TAllState-1000B) rshift 2
	    if (TAllState & 3) eq 0 then ValidateTest(NREGS+NMEMS+OtherX)
	    SetupTAll(NREGS+NMEMS,OtherMask,OtherWID,0,OtherOne,
		SelfRel(OtherNAM+OtherX),OtherX,rv OtherProc!OtherX,
		OtherTST,1,BadAltIn,MDatatoCSS)
	  ]
	  ifnot
	  [ if (TAllState & 3) eq 0 do
	    [ LoadDone = false
	      Zero(LowAddress,2); SetBlock(HighAddress,-1,2)
	      DoubleAdd(HighAddress,MEMLEN+MemX+MemX)
	      ValidateTest(NREGS+MemX)
	      InitTAddr(); LastPhase = 0
	    ]
	    SetupTAll(NREGS,MEMMask,MEMWID,MEMFORMS!MemX,MEMOne,
			MEMNAM!MemX,MemX,TestMLp,MEMTST,MEMCON!MemX,
			AltMInput!MemX,AltMForms!MemX)
	  ]
	]
	ifnot
	[ let RegX = TAllState rshift 2
	  let AltOut = AltRForms!RegX eq RDatatoCSS ? MDatatoCSS,
		AltRForms!RegX
	  if (TAllState & 3) eq 0 then ValidateTest(RegX)
	  SetupTAll(0,REGMask,REGWID,REGFORMS!RegX,REGOne,REGNAM!RegX,
		RegX,TestRLp,REGTST,REGCON!RegX,AltRInput!RegX,AltOut)
	]
]


//Called 4 times per reg/mem/other item tested; on first call do
//the setup; subsequent calls iterate the test, so each memory is
//tested for 3 cycles and each register for 3*50 iterations.
and SetupTAll(VArg,Mask,Width,Form,OneTab,Name,X,TestP,TST,CON,
	AltIn,AltOut) be
[	test (TAllState & 3) eq 0
	ifso		//Initialize the test
	[ if (CON<<MRType.TestAll eq 0) %
		(TestOK(TST!X) eq 0) do
	  [ TAllState = TAllState+4; return
	  ]
	  SetBlock(BitsChecked,-1,NDWords)
	  MEMFORMS!MDATAmemx = Form
	  MEMWID!MDATAmemx = Width!X
	  AltMInput!MDATAmemx = AltIn
	  AltMForms!MDATAmemx = AltOut
	  MBlock(IncV,SelfRel(OneTab+X),NDWords)
	  let Radix = table [ 8; 10; 16; 8 ] ! (CON<<MRType.DefRadix)
	  LastX,LastPrint = X,lv Noop
	  SetupPattern(SelfRel(Mask+X),Name,Radix)
	  CCSCnt = CCSCnt+1
	  if CCSCnt > 13 then
	  [ ResetsCS1(); CCSCnt = 0
	  ]
	  WssCS1(Name); PutsCS1($ )
	  if VArg eq NREGS then	//Testing a memory?
	  [ SaveDGen(); ShowRange()
	    LastPrint = lv ShowRange
	  ]
	  UpdateDisplay()
	  TAllState = TAllState+1
	]
	ifnot if TestP(X) then TAllState = TAllState+1
]