// PupControl1.bcpl
// Copyright Xerox Corporation 1979
// Last modified December 26, 1978  10:02 PM by Boggs

get "Pup.decl"
get "Puptest.decl"

external
[
//outgoing procedures
Host; Command

//incoming procedures form pupcontrol
SetFlag; Ows; GetStatistics; Ding
SingleSelection; GetKeys; Confirm; GetName; GetString
StateOfHost; InitHost; ResetHost; UnAcked

//incoming procedures from the os
Zero; MoveBlock; Usc; SetPupDPort; SetPupID
Dequeue; SetTimer; TimerHasExpired; Block; Dismiss
OpenLevel1Socket; CloseLevel1Socket; GetBitPos; EraseBits
FlushQueue; GetPBI; ReleasePBI; CompletePup
OpenFile; FileLength; Closes
Endofs; Resets; Wss; Puts; PutTemplate

//incoming statics
keys; zone; dis; hT; statFile; trys; ndbQ
]

//----------------------------------------------------------------------------
let Command() be
//----------------------------------------------------------------------------
//this is the keyboard command scanner context
[
//Block() repeatwhile UnAcked()
Block() repeatwhile Endofs(keys)
let ThisCmmd = GetKeys()
switchon ThisCmmd into
   [
   default: [ Ding(dis); endcase ]
   case $S: case $s:  //BSP send
   case $E: case $e:  //EFTP send
   case $T: case $t:  //thruput
   case $*S:  //stop
      [
      trys = tryHard
      for line = 1 to maxHosts do if hT>>HT.selected^line then
         hT>>HT.cb^line.cmmd = ThisCmmd
      endcase
      ]
   case $Y: case $y:  //statistics
      [
      GetStatistics(dis)
      endcase
      ]
   case $C: case $c:  //Set Checksums
      [
      SetFlag("*NChecksums on?", chksFlag)
      endcase
      ]
   case $D: case $d:  //Set Data Checking
      [
      SetFlag("*NData checking on?", dataFlag)
      endcase
      ]
   case $O: case $o:  //Set Overlap data with ack
      [
      SetFlag("*NOverlap data with acks?", ovlpFlag)
      endcase
      ]
   case $P: case $p:  //Set partner
      [
      let line = SingleSelection(); if line eq 0 loop
      Wss(dis,"*NPartner: ")
      let port = lv hT>>HT.cb^line.sendport
      if GetName(port, 0, 6) then
         Ows(hT>>HT.ds^line, colPartner, port)
      endcase
      ]
   case $H: case $h:  //Set controlled host
      [
      let line = SingleSelection()
      if line eq 0 loop
      Wss(dis, "*NHost: ")
      let frnPort = vec 3
      unless GetName(frnPort, 0, 0) endcase
      InitHost(line, frnPort)
      hT>>HT.cb^line.cmmd = $K
      endcase
      ]
   case $K: case $k:  //send kiss of death again
      [
      for line = 1 to maxHosts do
         if hT>>HT.selected^line then
            hT>>HT.cb^line.cmmd = $K
      endcase
      ]
   case $B: case $b:  //Boot
      [
      Wss(dis, "*NBoot DMT"); unless Confirm() loop
      trys = tryHard
      for line = 1 to maxHosts do
         if hT>>HT.selected^line then
            hT>>HT.cb^line.cmmd = $B
         [
         Block()
         let done = true
         for i = 1 to maxHosts do if hT>>HT.selected^i then
            [
            done = false
            if hT>>HT.cb^i.cmmd eq 0 then ResetHost(i)
            ]
         if done break
         ] repeat
      endcase
      ]
   case $A: case $a:
      [
      Wss(dis, "*NAppend statistics to file: ")
      if statFile>>StatFile.valid then
         [
         let bitpos = GetBitPos(dis)
         Wss(dis, lv statFile>>StatFile.name)
         unless Confirm() do
            [
            EraseBits(dis, -(GetBitPos(dis)-bitpos))
            statFile>>StatFile.valid = false
            ]
         ]
      unless statFile>>StatFile.valid do
         unless GetString(lv statFile>>StatFile.name) loop
      let file = OpenFile(lv statFile>>StatFile.name, ksTypeWriteOnly,
       charItem)
      if file eq 0 then
         [
         Wss(dis, "*NCant open file")
         statFile>>StatFile.valid = false
         loop
         ]
      statFile>>StatFile.valid = true
      trys = tryHard
      for i = 1 to maxHosts if hT>>HT.selected^i then
         hT>>HT.cb^i.cmmd = $T
      //Block() repeatwhile UnAcked()
      FileLength(file)
      Wss(file,"*N");
      for i = 1 to 60 do Puts(file, $-);
      Wss(file, "*N Host Partner State Checksum DataCheck")
      Wss(file, " Overlap Thruput AveThruput*N")
      for i = 1 to maxHosts do
         if hT>>HT.soc^i.frnPort.host ne 0 & hT>>HT.selected^i then
            [
            PutTemplate(file, "*N$UO#$3UO",
             hT>>HT.soc^i.frnPort.net, hT>>HT.soc^i.frnPort.host)
            test hT>>HT.cb^i.sendport.host ne 0
               ifso PutTemplate(file, "  $UO#$3UO ",
                hT>>HT.cb^i.sendport.net, hT>>HT.cb^i.sendport.host)
               ifnot Wss(file,"        ")
            test hT>>HT.dead^i
               ifso Wss(file, " **")
               ifnot Wss(file, "  ")
            Wss(file, StateOfHost(i))
            Wss(file, hT>>HT.stats^i.checksums? "     On  ", "    Off  ")
            Wss(file, hT>>HT.stats^i.data? "     On   ", "    Off   ")
            Wss(file, hT>>HT.stats^i.overlapDataWithAck ?
                                   "    On  ","   Off  ")
            PutTemplate(file, "  $5UD0", hT>>HT.stats^i.thruput)
            PutTemplate(file, "   $5UD0", hT>>HT.stats^i.avethruput)
            ]
      Wss(file, "*N*N")
      GetStatistics(file)
      Closes(file)
      endcase
      ]
   case $F: case $f:
      [
      structure THT ^1,maxHosts: @Port
      manifest lenTHT = size THT/16
      Wss(dis, "*NFind Hosts - type any key to stop")
      for i = 1 to maxHosts do ResetHost(i)
      let soc = vec lenPupSoc
      OpenLevel1Socket(soc, 0, table [ 0; 0; socketPupControl ])
      let tempHT = vec lenTHT; Zero(tempHT, lenTHT)
         [
         let pbi = GetPBI(soc)
         pbi>>PBI.pup.length = pupOvBytes + lenCmmd*2
         pbi>>PBI.pup.type = typeCmmd
         Zero(lv pbi>>PBI.pup.words^1, lenCmmd)
         CompletePup(pbi)
         let timer = nil; SetTimer(lv timer, 5)
            [
            Block() repeatwhile Endofs(keys) &
             soc>>PupSoc.iQ.head eq 0 &
             not TimerHasExpired(lv timer)
            pbi = Dequeue(lv soc>>PupSoc.iQ)
            if pbi eq 0 break
            for i = 1 to maxHosts do
               switchon Usc(pbi>>PBI.pup.sPort.host, tempHT>>THT^i.host) into
                  [
                  case 1:  //insert here and bubble remainder
                     [
                     let temp1, temp2 = vec lenPort, vec lenPort
                     MoveBlock(temp1, lv pbi>>PBI.pup.sPort, lenPort)
                     for j = i to maxHosts do
                        [
                        if temp1!0 eq 0 then break
                        MoveBlock(temp2, lv tempHT>>THT^j, lenPort)
                        MoveBlock(lv tempHT>>THT^j, temp1, lenPort)
                        MoveBlock(temp1, temp2, lenPort)
                        Ows(hT>>HT.ds^j,colNetHost, lv tempHT>>THT^j)
                        ]
                     ]
                  case 0: break  //already got that one
                  case -1: loop  //keep searching
                  ]
            ReleasePBI(pbi)
            ] repeat
         ] repeatwhile Endofs(keys)
      CloseLevel1Socket(soc)
      for i = 1 to maxHosts do
         [
         if tempHT>>THT^i.host eq 0 break
         InitHost(i, lv tempHT>>THT^i)
         if i gr 1 & (i&1) eq 0 then
            [
            hT>>HT.cb^(i-1).sendport.net = tempHT>>THT^i.net
            hT>>HT.cb^(i-1).sendport.host = tempHT>>THT^i.host
            hT>>HT.cb^(i-1).sendport.socket^1 = 0
            hT>>HT.cb^(i-1).sendport.socket^2 = socketBSPTest
            Ows(hT>>HT.ds^(i-1), colPartner, lv tempHT>>THT^i)
            hT>>HT.cb^i.sendport.net = tempHT>>THT^(i-1).net
            hT>>HT.cb^i.sendport.host = tempHT>>THT^(i-1).host
            hT>>HT.cb^i.sendport.socket^1 = 0
            hT>>HT.cb^i.sendport.socket^2 = socketBSPTest
            Ows(hT>>HT.ds^i, colPartner, lv tempHT>>THT^(i-1))
            ]
         ]
      endcase
      ]
   case $X: case $x:
      [
      Wss(dis, "*NXpunge Hosts"); unless Confirm() loop
      for line = 1 to maxHosts do
         if hT>>HT.selected^line then ResetHost(line)
      endcase
      ]
   case $Q: case $q:
      [
      Wss(dis, "*NQuit")
      if Confirm() then [ @#420 = 0; finish ]
      endcase
      ]
   case $?:
      [
      Wss(dis, "*NCommands are:")
      Wss(dis, "*NS = BSP Send, E = EFTP send, <sp> = Stop, Q = Quit,")
      Wss(dis, "*NT = Thruput, Y = Status, P = Partner, H = Host,")
      Wss(dis, "*NC = Checksum, D = DataCheck, O = Overlap, B = BootDMT")
      Wss(dis, "*NX = XpungeHost, A = AppendToFile, F = FindHosts, K = KissOfDeath")
      endcase
      ]
   ]
] repeat

//----------------------------------------------------------------------------
and Host(ctx) be
//----------------------------------------------------------------------------
[
//Command() loads up the cb structure in our HT.
//if cb.cmmd is non-zero, it is a command to execute
let line = ctx!3
let ds = hT>>HT.ds^line
let soc = lv hT>>HT.soc^line
let probeTimer = nil; SetTimer(lv probeTimer, 500)
hT>>HT.cb^line.cmmd = 0

   [
   Block() repeatuntil hT>>HT.cb^line.cmmd ne 0 %
    soc>>PupSoc.iQ.head ne 0 % TimerHasExpired(lv probeTimer)
   //flush old packets that may have trickled in
   FlushQueue(lv soc>>PupSoc.iQ)
   if hT>>HT.cb^line.cmmd ne 0 break
   if TimerHasExpired(lv probeTimer) then
      [
      hT>>HT.cb^line.cmmd = $T  //are you alive?
      break
      ]
   ] repeat

//Can't do anything if no controllee specified
if soc>>PupSoc.frnPort.host eq 0 loop

if hT>>HT.cb^line.cmmd eq $K then
   [
   let pbi = GetPBI(soc)
   SetPupID(pbi, table [ 0; bfnPupTest ])
   SetPupDPort(pbi, table [ 0; 0; 4 ])
   CompletePup(pbi, typeKissOfDeath, pupOvBytes)
   loop
   ]
hT>>HT.dead^line = true
hT>>HT.id^line = hT>>HT.id^line+1  //bump sequence number
for i = 1 to trys do
   [
   //generate command
   let pbi = nil
      [
      pbi = GetPBI(soc,true); if pbi ne 0 break
      FlushQueue(lv soc>>PupSoc.iQ)
      Block()
      ] repeat
   let cb = lv pbi>>PBI.pup.words^1
   MoveBlock(cb,lv hT>>HT.cb^line, lenCmmd)
   cb>>Cmmd.cmmd = selecton hT>>HT.cb^line.cmmd into
      [
      default: 0
      case $*S: $*S
      case $T: case $t: 0
      case $B: case $b: $Q
      case $S: case $s: hT>>HT.cb^line.sendport.host ? $S, 0
      case $E: case $e: hT>>HT.cb^line.sendport.host ? $R, 0
      ]
   pbi>>PBI.pup.id^2 = hT>>HT.id^line
   CompletePup(pbi, typeCmmd, pupOvBytes+lenCmmd lshift 1)

   //wait for answer
   let timeout = nil; SetTimer(lv timeout, 20)
   Block() repeatuntil soc>>PupSoc.iQ.head ne 0 %
    TimerHasExpired(lv timeout)
   let pbi = Dequeue(lv soc>>PupSoc.iQ); if pbi eq 0 loop
   unless pbi>>PBI.pup.type eq typeOK do
      [ ReleasePBI(pbi); loop ]

   //process answer
   let stat = lv pbi>>PBI.pup.words^1
   MoveBlock(lv hT>>HT.stats^line, stat, lenStats)
   Ows(ds, colAThruput, stat>>Stats.avethruput)
   Ows(ds, colThruput, stat>>Stats.thruput)
   Ows(ds, colChksm, stat>>Stats.checksums)
   Ows(ds, colData, stat>>Stats.data)
   Ows(ds, colOvlp, stat>>Stats.overlapDataWithAck)
   Ows(ds, colState, StateOfHost(line))
   Ows(ds, colDead, " ")
   ReleasePBI(pbi)
   hT>>HT.dead^line = false
   break
   ]
if hT>>HT.dead^line then Ows(ds, colDead, "**")
] repeat