// PupTest.bcpl - Pup package test program
// Copyright Xerox Corporation 1979, 1982
// Last modified February 15, 1982  5:10 PM by Boggs

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

external
[
// outgoing procedures
Command; RemoteControl; PupTestFinish; SysErr

// incoming procedures
InitPupTest; CreateKeyboardStream
EtherBoot; Junta; MyFrame; Zero; MoveBlock
Ws; Wss; Confirm; PutTemplate
Gets; Puts; Endofs; Closes
Block; CallContextList; Dismiss
AddToZone; Free; Allocate; Enqueue; Dequeue; FlushQueue
OpenLevel1Socket; CloseLevel1Socket; ExchangePorts
CompletePup; SetAllocation; GetPBI; ReleasePBI

EchoUser; MiscServices; BSPSend; EFTPSend
PrintPupRT; PrintStatistics

// outgoing statics
State; Cmmd; checksums; checkdata; pbiCount

// incoming statics
keys; dsp; sysZone; spyBuffer
lvUserFinishProc; savedFinish
checkBuffer; ctxQ; sendPort; tp; bootFlag
numNets; socketQ; pbiFreeQ; dPSIB; pupRT
lenPup; lenPBI; maxPupDataBytes; overlapDataWithAck
]

manifest [ levBcpl = 3; stkLim = 335b ]

static
[
State; Cmmd; codeEnd; pbiCount
checksums = false
checkdata = false
]

structure Byte^0,0 byte

//----------------------------------------------------------------------------
let PupTest(blv) be
//----------------------------------------------------------------------------
[
codeEnd = blv!29
InitPupTest()
Junta(levBcpl, AfterJunta)
]

//----------------------------------------------------------------------------
and AfterJunta() be
//----------------------------------------------------------------------------
[
CreateKeyboardStream()
//Add the remaining stack and the Juntaed OS parts to sysZone
let freeBegin = @stkLim
@stkLim = MyFrame() -120
AddToZone(sysZone, freeBegin, @stkLim-freeBegin)
AddToZone(sysZone, InitPupTest, codeEnd-InitPupTest)  //Init code
let freeSlop = Allocate(sysZone, 1250) //later dynamic allocation needs
pbiCount = 0
   [  //allocate as many additional pbis as we can
   let pbi = Allocate(sysZone, lenPBI, true)
   if pbi eq 0 break
   Enqueue(pbiFreeQ, pbi)
   pbiCount = pbiCount +1
   ] repeatwhile pbiCount ls 32767/maxPupDataBytes
Free(sysZone, freeSlop)
pbiCount = pbiCount-numNets
let soc = socketQ!0
while soc ne 0 do
   [
   SetAllocation(soc, pbiCount, pbiCount-1, pbiCount-1)
   soc = soc!0
   ]
let fakeSoc = dPSIB - offset PupSoc.psib/16
SetAllocation(fakeSoc, pbiCount, pbiCount-1, pbiCount-1)

CallContextList(ctxQ!0) repeat
]

//----------------------------------------------------------------------------
and PupTestFinish() be
//----------------------------------------------------------------------------
[
@420b = 0; for i = 0 to 30000 loop
(table [ 63000b; 1401b ])(177776b)
@lvUserFinishProc = savedFinish
if bootFlag then EtherBoot(10b)
]

//----------------------------------------------------------------------------
and SysErr(p1, errNo, p2, p3, p4, p5) be
//----------------------------------------------------------------------------
[
let t = p1; p1 = errNo; errNo = t
(table [ 77403b; 1401b ])("Sys.errors", lv p1)
]

//----------------------------------------------------------------------------
and Command() be
//----------------------------------------------------------------------------
[
Cmmd = 0
   [
   Ws("*N> ")
   State = stateStop
   Block() repeatwhile Endofs(keys) & Cmmd eq 0
   let char = Endofs(keys) ? Cmmd, Gets(keys)
   switchon char into
      [
      case $*S:
         [ Cmmd = 0; loop ]
      case $C: case $c:
         [
         Ws("Pup checksums ")
         Ws(checksums ? "disabled", "enabled")
         checksums = not checksums
         endcase
         ]
      case $D: case $d:
         [
         Ws("Data Checking ")
         Ws(checkdata ? "disabled", "enabled")
         checkdata = not checkdata
         endcase
         ]
      case $E: case $e:
         [ EchoUser(); endcase ]
      case $S: case $s:
         [ BSPSend(); endcase ]
      case $Q: case $q:
         [
         if Cmmd eq 0 then unless Confirm("Quit ") endcase
         finish
         ]
      case $R: case $r:
         [ EFTPSend(); endcase ]
      case $P: case $p:
         [
         Ws("Print ")
         switchon Gets(keys) into
            [
            case $R: case $r:
               [ PrintPupRT(); endcase ]
            case $S: case $s:
               [ PrintStatistics(); endcase ]
            case $?:
               [ Ws("?*NRoutingTable, Statistics"); endcase ]
            default: [ Puts(dsp, $?); endcase ]
            ]
         endcase
         ]
      case $M: case $m:
         [ MiscServices(); endcase ]
      case $?:
         [
         Ws("?*NEcho, SendBSP, Misc services, Quit")
         Ws("*NPrint, Checksums, DataChecking, R=EFTP")
         endcase
         ]
      ]
   ] repeat
]

//----------------------------------------------------------------------------
and RemoteControl() be	//the context by which PupControl controls PupTest
//----------------------------------------------------------------------------
[
let lastID = 0
let controlSoc = vec lenPupSoc
OpenLevel1Socket(controlSoc, table [ 0; 0; socketPupControl ])
   [
   Block() repeatwhile controlSoc>>PupSoc.iQ.head eq 0
   let pbi = Dequeue(lv controlSoc>>PupSoc.iQ)
   unless pbi>>PBI.pup.type eq typeCmmd do
      [ ReleasePBI(pbi); loop ]
   if pbi>>PBI.pup.id^2 ne lastID then
      [
      lastID = pbi>>PBI.pup.id^2
      let cb = lv pbi>>PBI.pup.words^1
      MoveBlock(sendPort, lv cb>>Cmmd.sendport, lenPort)
      Cmmd = cb>>Cmmd.cmmd
      checksums = cb>>Cmmd.checksums ne 0
      checkdata = cb>>Cmmd.data ne 0
      overlapDataWithAck = cb>>Cmmd.overlapDataWithAck ne 0
      ]
   let stat = lv pbi>>PBI.pup.words^1; Zero(stat, lenStats)
   stat>>Stats.thruput = tp>>TP.thruput
   stat>>Stats.avethruput = tp>>TP.aveThruput
   stat>>Stats.state = State
   stat>>Stats.checksums = checksums
   stat>>Stats.data = checkdata
   stat>>Stats.overlapDataWithAck = overlapDataWithAck
   ExchangePorts(pbi)
   CompletePup(pbi, typeOK, lenStats*2+pupOvBytes)
   ] repeat
]