// 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