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

get "Pup0.decl"
get "Pup1.decl"
get "PupTest.decl"

external
[
//outgoing procedures
EchoServer; EchoUser

//incoming procedures
Puts; Endofs; MoveBlock; Zero
GetPBI; ReleasePBI; ExchangePorts; HLookup
OpenLevel1Socket; CompletePup; CloseLevel1Socket
SetTimer; TimerHasExpired; Enqueue; Dequeue; Block
OtherSpigot; PrintPort; OpenPort
Divide32x16; BlockEq; DoubleIncrement
PutTemplate; Ws

//incoming statics
dsp; keys
pupRT; maxPupDataBytes
Cmmd; checksums; checkdata; sendPort; checkBuffer
]

manifest
[
socketEcho = 5
typeEchoMe = 1
typeImAnEcho = 2
]

structure Byte↑0,0 byte

//----------------------------------------------------------------------------
let EchoServer() be	//a context
//----------------------------------------------------------------------------
[
let serverSoc = vec lenPupSoc
OpenLevel1Socket(serverSoc, table [ 0; 0; socketEcho ])
   [
   Block() repeatuntil serverSoc>>PupSoc.iQ.head ne 0
   let pbi = Dequeue(lv serverSoc>>PupSoc.iQ)
   test pbi>>PBI.pup.type eq typeEchoMe
      ifnot OtherSpigot(pbi)
      ifso
         [
         ExchangePorts(pbi)
         //compute checksum on outgoing packet
         // if incoming packet computed it.
         serverSoc>>PupSoc.doChecksum =
          pbi!(lenPBIOverhead+(pbi>>PBI.pup.length-1) rshift 1) ne -1
         CompletePup(pbi, typeImAnEcho)
         serverSoc>>PupSoc.doChecksum = true
         Puts(dsp, $$)
         ]
   ] repeat
]

//----------------------------------------------------------------------------
and EchoUser() be
//----------------------------------------------------------------------------
[
let userSoc = vec lenPupSoc
test Cmmd eq 0
   ifnot [ Cmmd = 0; OpenLevel1Socket(userSoc, 0, sendPort) ]
   ifso unless OpenPort("Echo to: ", userSoc, 0, socketEcho) return

Ws("- Checksums "); Ws(checksums ? "enabled", "disabled")
Ws(", Data checking "); Ws(checkdata? "enabled*N", "disabled*N")
userSoc>>PupSoc.doChecksum = checksums

PrintPort(lv userSoc>>PupSoc.lclPort); Ws(" -> ")
let rte = HLookup(pupRT, userSoc>>PupSoc.frnPort.net)
if rte ne 0 & rte>>RTE.hops ne 0 then
   PutTemplate(dsp, "[$UO#$UO#] -> ",
    rte>>RTE.ndb>>NDB.localNet, rte>>RTE.host)
PrintPort(lv userSoc>>PupSoc.frnPort)

let out = vec 6; Zero(out, 6)
let in, inTimes100 = out+2, out+4
let numDataBytes, numDataWords, pupid = maxPupDataBytes, 0, 0

while Endofs(keys) & Cmmd eq 0 do
   [
   let pbi = GetPBI(userSoc)
   //packets get longer by 1 byte each time.
   numDataBytes = numDataBytes +1
   if numDataBytes gr maxPupDataBytes then numDataBytes = 0
   numDataWords = (numDataBytes +1)/2
   pupid = pupid +1
   pbi>>PBI.pup.id↑1 = 0
   pbi>>PBI.pup.id↑2 = pupid
   MoveBlock(lv pbi>>PBI.pup.bytes, checkBuffer, numDataWords)
   CompletePup(pbi, typeEchoMe, numDataBytes+pupOvBytes)
   DoubleIncrement(out)
   
   let timeOut = nil; SetTimer(lv timeOut, 150)  //1.5 seconds
      [
      Block() repeatuntil userSoc>>PupSoc.iQ.head %
       TimerHasExpired(lv timeOut)
      pbi = Dequeue(lv userSoc>>PupSoc.iQ)
      if pbi eq 0 then [ Puts(dsp, $?); break ]
      if pbi>>PBI.pup.type ne typeImAnEcho then
         [ OtherSpigot(pbi); loop ]
      DoubleIncrement(in); DoubleIncrement(inTimes100, 100)
      //note that if there is a 'garbage' byte at the end of the packet,
      // it has a known value and we check it.
      if checkdata & numDataBytes gr 0 then
         unless BlockEq(checkBuffer, lv pbi>>PBI.pup.bytes, numDataWords) do
            Ws("Data compare error*N")
      test pbi>>PBI.pup.id↑2 eq pupid
         ifnot [ Puts(dsp, $#); ReleasePBI(pbi) ]
         ifso [ Puts(dsp, $!); ReleasePBI(pbi); break ]
      ] repeat
   ]

CloseLevel1Socket(userSoc)
PutTemplate(dsp, "*nOut: $ED, In: $ED", out, in)
while out!0 ne 0 do  //scale so denominator is ls 2↑16
   [ Divide32x16(inTimes100, 10); Divide32x16(out, 10) ]
Divide32x16(inTimes100, out!1)
PutTemplate(dsp, ", $UD%", inTimes100!1)
]