//   AIWork.bcpl
//   Alto - 1822 Interface Test Program
//   L. Stewart  last modified:  January 5, 1981  12:55 PM

//   This module contains work-doing procedures

get "AIHW.d"
get "AIMenuNames.d"
get "AIMenuDefs.d"
get "AITest.d"

external             //Incoming Procedures
   [
   aisio             //from AISio.asm
   GetBoxNumber      //from AIWorkb.bcpl
   PutBoxTemplate
   BlinkBox
   SetResults
   SetInterrupts
   CheckBuffers
   WriteCStat
   DecodeIMPMessage  //from AIComm.bcpl
   ]

external             //Incoming Procedures from packages
   [
   Block             //Context package
   Dismiss           //Altotimer package
   SetTimer
   TimerHasExpired
   PutTemplate       //Template package
   ]

external             //Incoming OS Procedures
   [
   Wss
   StartIO
   ]

external             //Outgoing Procedures in AIWork.bcpl
   [
   TestAll
   TestBLZ
   TestGather
   TestInt
   TestScatter
   Dead
   SetCSFctn
   TestMode
   HostRelay
   DiscardMode
   MasterClear
   ClearIWD
   Listen
   LoopEcho
   SetInterruptMasks
   SetControl
   StartInput
   StartOutput
   StartLastOutput
   ]
(1024)
external             //Incoming Statics
   [
   cIntSwitch        //from AIWorkb.bcpl
   iIntSwitch
   oIntSwitch
   PacketType
   PacketLength
   PacketPattern
   PacketLoopCount
   Menu              //from AITest.bcpl
   workS
   Blast
   ]

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)
   ]
(635)