[Indigo]<Alto-1822>aitestsources.dm!2>AIwork.bcpl

external //Outgoing Statics
[
cInterrupt
iInterrupt
oInterrupt
cb //command block (12 words)
iBuf //input buffer
oBuf //output buffer
BufSize //input buffer size
lastCSFctn
oiHostRelay //our impression of hardware status
oiTestMode
oiDiscard
iTimer //data transfer timeouts
oTimer
]

static
[
cInterrupt = false // interrupt flags
iInterrupt = false
oInterrupt = false
cb //command block (12 words)
iBuf //input buffer
oBuf //output buffer
BufSize = #2000 //input buffer size
lastCSFctn = 0 //command word for special use
oiHostRelay = true //our impression of hardware status
oiTestMode = true
oiDiscard = false
iTimer //data transfer timeouts
oTimer
toValue = 100
]

let TestAll() be
[
Wss(workS,"*nTesting Ready Relay: ")
let HRR = HostRelay(false)
Dismiss(50)
Wss(workS, HRR eq HostRelay(true) ? "OK*n","Bad*n")
ClearIWD()
Wss(workS,"Testing Interrupts: [")
BlinkBox(Menu!bTestInt,50)
Wss(workS, TestInt() ? "] OK*n","] Bad*n")
Wss(workS,"Testing Block Length Zero: ")
BlinkBox(Menu!bTestBLZ,50)
Wss(workS, TestBLZ() ? "OK*n","Bad*n")
Wss(workS,"Testing Scatter: ")
BlinkBox(Menu!bTestScatter,50)
Wss(workS, TestScatter() ? "OK*n","Bad*n")
Wss(workS,"Testing Gather: ")
BlinkBox(Menu!bTestGather,50)
Wss(workS, TestGather() ? "OK*n","Bad*n")
Wss(workS,"Testing Data: ")
FlipBox(Menu!bLoopEcho)
Wss(workS, LoopEcho() ? "OK*n","Bad*n")
FlipBox(Menu!bLoopEcho)
]

and TestBLZ() = valof
[
StartInput(iBuf,iBuf)
until cb>>CB.InputPost % Blast do
[
Block()
if Dead(lv iTimer) break
]
SetResults(true,false)
if (((cb>>CB.InputPost)<<POST.uCodeStat eq iBufLenZero) & (cb>>CB.InputPointer eq iBuf)) then resultis true
resultis false
]

and TestScatter() = valof
[
StartInput(iBuf,iBuf+2)
StartLastOutput(oBuf,oBuf+4)
until cb>>CB.InputPost % Blast do
[
Block()
if Dead(lv iTimer) break
]
if ((cb>>CB.InputPost)<<POST.uCodeStat ne iBufFull) then
[
MasterClear()
resultis false
]
StartInput(iBuf,iBuf+2)
until cb>>CB.InputPost % Blast do
[
Block()
if Dead(lv iTimer) break
]
if ((cb>>CB.InputPost)<<POST.uCodeStat eq iBufFullDone) then resultis true
MasterClear()
resultis false
]

and TestGather() = valof
[
StartInput(iBuf,iBuf+6)
StartOutput(oBuf,oBuf+2)
until cb>>CB.OutputPost % Blast do
[
Block()
if Dead(lv oTimer) break
]
if ((cb>>CB.InputPost)<<POST.uCodeStat ne 0) then
[
MasterClear()
resultis false
]
StartLastOutput(oBuf,oBuf+4)
until cb>>CB.InputPost % Blast do
[
Block()
if Dead(lv iTimer) break
]
if ((cb>>CB.InputPost)<<POST.uCodeStat eq iBufFullDone)
& ((cb>>CB.OutputPost)<<POST.uCodeStat eq allOK) then resultis true
MasterClear()
resultis false
]

and TestInt() = valof
[
let ocInt = cIntSwitch
let oiInt = iIntSwitch
let ooInt = oIntSwitch
cIntSwitch, iIntSwitch, oIntSwitch = true, true, true
FlipBox(Menu!bSetInterrupts)
SetInterrupts(false)
SetControl(doNothing)
StartInput(iBuf,iBuf+2)
StartLastOutput(oBuf,oBuf+1)
until cb>>CB.InputPost % Blast do
[
Block()
if Dead(lv iTimer) break
]
until cb>>CB.OutputPost % Blast do
[
Block()
if Dead(lv oTimer) break
]
cIntSwitch, iIntSwitch, oIntSwitch = ocInt, oiInt, ooInt
SetInterrupts(false)
FlipBox(Menu!bSetInterrupts)
if iInterrupt & oInterrupt & cInterrupt resultis true
resultis false
]

and Dead(timer) = valof
[
test TimerHasExpired(timer)
ifso
[
Wss(workS," [Timeout] ")
resultis true
]
ifnot resultis false
]

and SetCSFctn() be
[
SetControl(lastCSFctn)
]

and TestMode(switch) be
[
oiTestMode = switch
SetControl(oiTestMode ? turnOnTestMode,turnOffTestMode)
PutBoxTemplate(Menu!bTestMode,oiTestMode ? "Test ON","Test OFF")
]

and HostRelay(switch) = valof
[
oiHostRelay = switch
SetControl(oiHostRelay ? turnOnRelay,turnOffRelay)
PutBoxTemplate(Menu!bHostRelay,oiHostRelay ? "Relay ON","Relay OFF")
if ((cb>>CB.ControlPost)<<POST.HostNotReady eq 0) eq oiHostRelay then resultis false
resultis true
]

and DiscardMode(switch) be
[
// PutBoxTemplate(Menu!bDiscardMode," ")
]

and MasterClear() be SetControl(masterReset)

and ClearIWD() be SetControl(tryClearIWD)

and Listen() be
[
StartInput(iBuf,iBuf+BufSize)
until cb>>CB.InputPost % Blast do Block()
WriteCStat(cb>>CB.InputPost)
SetResults(true,true)
test cb>>CB.InputPointer eq iBuf
ifso Wss(workS,"Nothing Received")
ifnot DecodeIMPMessage(workS)
]

and LoopEcho() = valof
[
let errors = 0
let timeouts = 0
let thistime = false
SetResults(false,false)
for i = 1 to PacketLoopCount do
[
StartInput(iBuf,iBuf+BufSize)
StartLastOutput(oBuf,oBuf+PacketLength)
until Blast do
[
if ((cb>>CB.OutputPost ne 0) & (cb>>CB.InputPost ne 0)) do
[
thistime = CheckBuffers(false)
errors = errors % thistime
Wss(workS,thistime ? "!","?")
errors = errors + (thistime ? 1,0)
break
]
if TimerHasExpired(lv iTimer) % TimerHasExpired(lv oTimer) do
[
Wss(workS,"~")
timeouts = timeouts + 1
break
]
Block()
]
if Blast break
]
WriteCStat(cb>>CB.OutputPost)
SetResults(true,true)
PutTemplate(workS,"*n$UO Bad, $UO Timeouts ",errors,timeouts)
test errors+timeouts gr 0
ifso resultis false
ifnot resultis true
]

and SetInterruptMasks(cMask,iMask,oMask) be
[
cb>>CB.ControlBits = cMask
cb>>CB.InputBits = iMask
cb>>CB.OutputBits = oMask
]

and SetControl(newCmd) = valof
[
let a = 0
cb>>CB.ControlPost = 0
cb>>CB.ControlWord = newCmd
cInterrupt = false
aisio(controlSioCode,cb)
a = a + 1
if cb>>CB.ControlPost eq 0 do
[
Wss(workS,"Control Timeout ")
resultis false
]
resultis true
]

and StartInput(bufptr,bufend) be
[
cb>>CB.InputPost = 0
cb>>CB.InputPointer = bufptr
cb>>CB.InputEnd = bufend
iInterrupt = false
SetTimer(lv iTimer,toValue)
StartIO(inputSioCode)
]

and StartLastOutput(bufptr,bufend) be
[
cb>>CB.OutputPost = 0
cb>>CB.OutputPointer = bufptr
cb>>CB.OutputEnd = bufend
oInterrupt = false
SetControl(turnOnLastBit)
SetTimer(lv oTimer,toValue)
StartIO(outputSioCode)
]

and StartOutput(bufptr,bufend) be
[
cb>>CB.OutputPost = 0
cb>>CB.OutputPointer = bufptr
cb>>CB.OutputEnd = bufend
oInterrupt = false
SetControl(turnOffLastBit)
SetTimer(lv oTimer,toValue)
StartIO(outputSioCode)
]