// PupTestIO.bcpl
// Copyright Xerox Corporation 1979, 1982
// Last modified February 15, 1982  5:49 PM by Boggs

get "Pup.decl"
get "PupStats.decl"
get "PupTest.decl"

external
[
//outgoing procedures
GetString; GetNumber; PrintPort; Confirm
OpenPort; ComputeThruput; Ws; Wss
OtherSpigot; OtherSpigotProcess
PrintPupRT; RTTitle; RTEntry; PrintStatistics

//incoming procedures
Puts; Gets; Endofs; Resets
MoveBlock; Zero; DefaultArgs
Enqueue; Dequeue; Block
PutTemplate; EraseBits; CharWidth
OpenLevel1Socket; ReleasePBI; GetPartner
HLookup; HEnumerate
UpdateAverage; Divide32x16

//statics
dsp; keys
spigotQ; pupRT; pbiFreeQ
]

manifest realTimeClock = 430b

//----------------------------------------------------------------------------
let GetString(prompt, addr, echo, cr; numargs na) = valof
//----------------------------------------------------------------------------
[
//make a bcpl string from the keyboard
//if echo is true, echo the typed characters to the display
//returns false if del is typed (return to command level)
//addr is the address of the string that should get the result.
//prompt is a prompt string printed in the obvious places
if na ls 3 then echo = true
if na ls 4 then cr = true
Ws(prompt)
let count = 0
   [
   let char = Gets(keys)
   switchon char into
      [
      case $*S: case $*N: case $*033:
         [
         Puts(dsp, (cr ? $*N, $*S))
         addr>>String.length = count
         resultis count ne 0
         ]
      case $*177:
         [ Ws("XXX"); Puts(dsp, (cr ? $*N, $*S)); resultis false ]
      case $*001: case $*010:
         [
         if count then
            [
            if echo then
               EraseBits(dsp, -CharWidth(dsp, addr>>String.char↑count))
            count = count -1
            ]
         endcase
         ]
      default:
         [
         if count le 255 & char ge $*S & char le $*177 then
            [
            count = count + 1
            addr>>String.char↑count = char
            if echo then Puts(dsp, char)
            ]
         endcase
         ]
      ]
   ] repeat
]

//----------------------------------------------------------------------------
and GetNumber(string) = valof
//----------------------------------------------------------------------------
[
Ws(string)
let res = 0
   [
   let char = Gets(keys)
   switchon char into
      [
      case $0: case $1: case $2: case $3:
      case $4: case $5: case $6: case $7:
         [
         Puts(dsp, char)
         res = (res lshift 3) + (char & 7)
         endcase
         ]
      case $*001: case $*010:
         [
         EraseBits(dsp, -CharWidth(dsp, $0+(res&7)))
         res = res rshift 3
         endcase
         ]
      case $*N: case $*S: case $*177: resultis res
      ]
   ] repeat
]

//----------------------------------------------------------------------------
and Confirm(prompt; numargs na) = valof
//----------------------------------------------------------------------------
[
if na gr 0 then Ws(prompt); Ws("[Confirm] ")
switchon Gets(keys) into
   [
   case $Y: case $y: case $*N:
      [ Ws("Yes.*N"); resultis true ]
   case $N: case $n: case $*177:
      [ Ws("No.*N"); resultis false ]
   default:
      [ Ws("Yes or No*N"); endcase ]
   ]
] repeat

//----------------------------------------------------------------------------
and PrintPort(port) be
//----------------------------------------------------------------------------
   PutTemplate(dsp,"[$UO#$UO#$UEO]", port>>Port.net, port>>Port.host,
    lv port>>Port.socket)

//----------------------------------------------------------------------------
and OpenPort(string, soc, fs1, fs2, lclPort; numargs na) = valof
//----------------------------------------------------------------------------
[
DefaultArgs(lv na, -2, 0, 0, 0)
let frnPort = vec lenPort
let name = vec 40
   [
   unless GetString(string, name, true, false) resultis false
   if GetPartner(name, dsp, frnPort, fs1, fs2) break
   ] repeat
OpenLevel1Socket(soc, lclPort, frnPort)
resultis true
]

//----------------------------------------------------------------------------
and Ws(string) be Wss(dsp, string)
//----------------------------------------------------------------------------

//----------------------------------------------------------------------------
and Wss(stream, string) be
//----------------------------------------------------------------------------
   for i = 1 to string>>String.length do
      Puts(stream, string>>String.char↑i)

//----------------------------------------------------------------------------
and ComputeThruput(tp) = valof
//----------------------------------------------------------------------------
[
let num = vec 1
MoveBlock(num, (alto? table [ 19; -28468], table [ 76; 19264]), 2)
Divide32x16(num, @realTimeClock-tp>>TP.timer)
PutTemplate(dsp, " [ $UD0 bytes/sec ]*N", num!1)
tp>>TP.thruput = num!1
tp>>TP.aveThruput = tp>>TP.aveThruput eq 0? tp>>TP.thruput,
 UpdateAverage(tp>>TP.thruput, tp>>TP.aveThruput, 8)
]

//---------------------------------------------------------------------------
and PrintPupRT() be
//---------------------------------------------------------------------------
[
let PerNet(rte, lvCount) be
   RTEntry(rte>>RTE.net, rte>>RTE.ndb>>NDB.localNet,
    rte>>RTE.host, rte>>RTE.hops, lvCount)
let count = 0
RTTitle("Local routing table:")
HEnumerate(pupRT, PerNet, lv count)
Puts(dsp, $*N)
]

//----------------------------------------------------------------------------
and RTTitle(string) be
//----------------------------------------------------------------------------
[
Ws(string)
Ws("*N Net   Via   Hops | Net   Via   Hops | Net   Via   Hops | Net   Via   Hops")
Ws("*N -----------------|------------------|------------------|-----------------")
]

//----------------------------------------------------------------------------
and RTEntry(dNet, viaNet, viaHost, hops, lvCount) be
//----------------------------------------------------------------------------
[
if @lvCount rem 4 eq 0 then Ws("*N ")
PutTemplate(dsp, "$U3O $U3O#$U3F0O# $U2O ", dNet, viaNet, viaHost, hops)
unless @lvCount rem 4 eq 3 do Ws(" | ")
@lvCount = @lvCount +1
]

//----------------------------------------------------------------------------
and PrintStatistics() be
//----------------------------------------------------------------------------
[
let net = GetNumber("statistics for network ")
let rte = HLookup(pupRT, net)
if rte ne 0 then
   [
   let pbi = Dequeue(pbiFreeQ)
   if rte>>RTE.ndb>>NDB.level0Stats(pbi, rte>>RTE.ndb) then
      if rte>>RTE.hops eq 0 then
         switchon pbi>>PBI.pup.words↑1 into
            [
            case netTypeEther:
               [ PrintEtherStats(pbi); endcase ]
            case netTypeSLA:
               [ PrintSLAStats(pbi); endcase ]
            ]
   Enqueue(pbiFreeQ, pbi)
   ]
]

//----------------------------------------------------------------------------
and PrintEtherStats(pbi) be
//----------------------------------------------------------------------------
[
Ws("*NEthernet Statistics:")
let es = lv pbi>>PBI.pup.words↑2
PutTemplate(dsp, "*nRcv: good $UD, bad $UD, off $UD",
 es>>EtherStats.packetsRcvd, es>>EtherStats.numBadRcvStatus,
 es>>EtherStats.inputOff)
PutTemplate(dsp, "; Xmt: good $UD, bad $UD; I|O $UD",
 es>>EtherStats.packetsSent, es>>EtherStats.numBadXmtStatus,
 es>>EtherStats.numInUnderOut)
Ws("*NLds:")
for i = 0 to 15 do
   PutTemplate(dsp, " $UD", es>>EtherStats.loadTable↑i)
PutTemplate(dsp, "; Ovf: $UD", es>>EtherStats.loadTable↑16)
]

//----------------------------------------------------------------------------
and PrintSLAStats(pbi) be
//----------------------------------------------------------------------------
[
Ws("*NSLA Statistics:*N")
Ws("        ----Packets---     -----Bytes-----    ------Errors------*n")
Ws("Line    Sent  Received     Sent   Received    CRC   Sync Control   State*n")
let maxSLAHost = pbi>>PBI.pup.words↑2
let maxSLALine = pbi>>PBI.pup.words↑(maxSLAHost+3)
for line = 0 to maxSLALine do
   [
   let ss = lv pbi>>PBI.pup.words↑(maxSLAHost+4+lenSLAStats*line)
   if ss>>SLAStats.state eq slaLineMissing loop
   PutTemplate(dsp, "$3O$9ED$9ED$10ED$10ED  $6D$6D$6D      $S*n",
    line, lv ss>>SLAStats.transmitPackets, lv ss>>SLAStats.receivePackets,
    lv ss>>SLAStats.transmitBytes, lv ss>>SLAStats.receiveBytes,
    ss>>SLAStats.badCRC, ss>>SLAStats.inputOverrun,
    ss>>SLAStats.lineControlError,
    selecton ss>>SLAStats.state into
      [
      case slaLineDown: "Down"
      case slaLineUp: "Up"
      case slaLineLoopedBack: "Looped back"
      default: "?"
      ])
   ]
Ws("*nRouting table:*n")
for i = 1 to 4 do Ws("Host Line Hops    ")
let count = 0
for i = 1 to maxSLAHost do
   [
   let rte = lv pbi>>PBI.pup.words↑(2+i)
   if rte>>SLARTE.hopCnt ne #377 then
      [
      PutTemplate(dsp, "$S$3O  $3O  $3D", (count rem 4 eq 0? "*n", "     "),
       i, rte>>SLARTE.line, rte>>SLARTE.hopCnt)
      count = count +1
      ]
   ]
Puts(dsp, $*n)
]

//---------------------------------------------------------------------------
and OtherSpigot(pbi) be Enqueue(spigotQ, pbi)
//---------------------------------------------------------------------------

//---------------------------------------------------------------------------
and OtherSpigotProcess() be
//---------------------------------------------------------------------------
[
while spigotQ!0 eq 0 do Block()
let pbi = Dequeue(spigotQ)
let startByte = 0
switchon pbi>>PBI.pup.type into
   [
   case typeAbort:
      [
      Ws("[Abort] ")
      startByte = 3
      endcase
      ]
   case typeError:
      [
      Ws("[Error] ")
      startByte = 25
      endcase
      ]
   case typeInterrupt:
      [
      Ws("[Interrupt] ")
      startByte = 3
      endcase
      ]
   ]
if startByte ne 0 then
   [
   for i = startByte to pbi>>PBI.pup.length-pupOvBytes do
      Puts(dsp,pbi>>PBI.pup.bytes↑i)
   Puts(dsp, $*N)
   ]
ReleasePBI(pbi)
] repeat