// PupControl.bcpl
// Copyright Xerox Corporation 1979
// Last modified July 2, 1978 7:33 PM by Boggs
get "Pup.decl"
get "PupStats.decl"
get "Puptest.decl"
get "SysDefs.d"
external
[
//outgoing procedures
SetFlag; Ows; MouseWatcher; Wss; GetStatistics; Ding
SingleSelection; GetKeys; Confirm; GetName; GetString
StateOfHost; UnAcked; ResetHost; InitHost; MiscServ
//incoming procedures
Allocate; Junta; CallSwat; Zero; DefaultArgs
Block; Dismiss; CallContextList; Enqueue; Dequeue
SetBitPos; GetFont; EraseBits; CharWidth; InvertLine
Puts; Gets; Endofs; Resets; InitBootServ; AddNameToBFT
SetTimer; TimerHasExpired; InitPupControl; PutTemplate
GetPBI; ReleasePBI; CompletePup; FlushQueue
CloseLevel1Socket; InitPupLevel1; OpenLevel1Socket
SetAllocation; GetPartner; MayDayServ
//incoming statics
dsp; keys; zone; dis; trys; hT; ctxQ
]
static [ trys ]
manifest
[
rtc = #430
display = #420
cursorY = #427
utilIn = #177030
]
//---------------------------------------------------------------------------
let PupControl() be Junta(levDisplay, AfterJunta)
//---------------------------------------------------------------------------
//---------------------------------------------------------------------------
and AfterJunta() be
//---------------------------------------------------------------------------
[
InitPupControl()
CallContextList(ctxQ!0) repeat
]
//---------------------------------------------------------------------------
and InitHost(line, port) be
//---------------------------------------------------------------------------
[
ResetHost(line)
let soc = lv hT>>HT.soc↑line
port>>Port.socket↑1 = 0
port>>Port.socket↑2 = socketPupControl
OpenLevel1Socket(soc, 0, port)
SetAllocation(soc, 2, 1, 1)
hT>>HT.id↑line = @rtc
Ows(hT>>HT.ds↑line, colNetHost, port)
]
//---------------------------------------------------------------------------
and ResetHost(line) be
//---------------------------------------------------------------------------
[
let soc = lv hT>>HT.soc↑line
if soc>>PupSoc.frnPort.host ne 0 then CloseLevel1Socket(soc)
Zero(lv hT>>HT.soc↑line, lenPupSoc)
Zero(lv hT>>HT.cb↑line, lenCmmd)
Zero(lv hT>>HT.stats↑line, lenStats)
hT>>HT.selected↑line = false
Resets(hT>>HT.ds↑line)
]
//---------------------------------------------------------------------------
and StateOfHost(line) = selecton hT>>HT.stats↑line.state into
//---------------------------------------------------------------------------
[
case stateStop: "Stop"
case stateBSP: "BSP"
case stateEFTP: "EFTP"
default: " ? "
]
//----------------------------------------------------------------------------
and GetStatistics(stream) be
//----------------------------------------------------------------------------
[
let statSoc = vec lenPupSoc
OpenLevel1Socket(statSoc, 0, table [ 0; 0; socketStatistics ])
for line = 1 to maxHosts do
if hT>>HT.selected↑line & hT>>HT.soc↑line.frnPort.host then
for try = 1 to tryHard do
[
let pbi = nil
let soc = lv hT>>HT.soc↑line
[
pbi = GetPBI(statSoc, true); if pbi ne 0 break
FlushQueue(lv statSoc>>PupSoc.iQ)
Block()
] repeat
pbi>>PBI.pup.dPort.net = soc>>PupSoc.frnPort.net
pbi>>PBI.pup.dPort.host = soc>>PupSoc.frnPort.host
pbi>>PBI.pup.words↑1 = soc>>PupSoc.frnPort.net
CompletePup(pbi, typeSendStats, pupOvBytes+2)
let gotIt = false
let timer = nil; SetTimer(lv timer, 10)
[
Block() repeatuntil statSoc>>PupSoc.iQ.head ne 0 %
TimerHasExpired(lv timer)
if TimerHasExpired(lv timer) break
pbi = Dequeue(lv statSoc>>PupSoc.iQ)
if pbi>>PBI.pup.sPort.host eq soc>>PupSoc.frnPort.host
& pbi>>PBI.pup.type eq typeStatsAck then
[ PrintEtherStats(stream, pbi); gotIt = true ]
ReleasePBI(pbi)
if gotIt break
] repeat
if gotIt break
]
CloseLevel1Socket(statSoc)
]
//----------------------------------------------------------------------------
and PrintEtherStats(stream, pbi) be
//----------------------------------------------------------------------------
[
PutTemplate(stream,"*N$UO#$UO#: ", pbi>>PBI.pup.sPort.net,
pbi>>PBI.pup.sPort.host)
let es = lv pbi>>PBI.pup.words↑2
PutTemplate(stream,"Rcv: good $UD, bad $UD, off $UD",
es>>EtherStats.packetsRcvd, es>>EtherStats.numBadRcvStatus,
es>>EtherStats.inputOff)
PutTemplate(stream,"; Xmt: good $UD, bad $UD; I|O $UD",
es>>EtherStats.packetsSent, es>>EtherStats.numBadXmtStatus,
es>>EtherStats.numInUnderOut)
Wss(stream,"*NLds:")
for i = 0 to 15 do
PutTemplate(stream, " $UD", es>>EtherStats.loadTable↑i)
PutTemplate(stream, "; Ovf: $UD", es>>EtherStats.loadTable↑16)
]
//----------------------------------------------------------------------------
and UnAcked() = valof
//----------------------------------------------------------------------------
[
for i = 1 to maxHosts do
if hT>>HT.cb↑i.cmmd ne 0 resultis true
resultis false
]
//----------------------------------------------------------------------------
and SetFlag(string, flag) be
//----------------------------------------------------------------------------
[
Wss(dis, string)
let ck = Confirm()
trys = tryHard
for i = 1 to maxHosts do if hT>>HT.selected↑i then
[
hT>>HT.cb↑i.flags = ck? hT>>HT.cb↑i.flags % flag,
hT>>HT.cb↑i.flags & not flag
hT>>HT.cb↑i.cmmd = $T
]
]
//----------------------------------------------------------------------------
and SingleSelection() = valof
//----------------------------------------------------------------------------
[
let count,line = 0,0
for i = 1 to maxHosts do if hT>>HT.selected↑i then
[ count = count+1; line = i ]
if count ne 1 then
[
Ding(dis)
test count gr 1
ifso Wss(dis, "*NMultiple selection - command terminated")
ifnot Wss(dis, "*NNo selection - command terminated")
]
resultis count eq 1 ? line,0
]
//----------------------------------------------------------------------------
and Ows(stream, col, val, forceString; numargs na) be
//----------------------------------------------------------------------------
//Write val to stream. col tells how to display val
[
SetBitPos(stream, col<<Col.start)
EraseBits(stream, col<<Col.width*10, 0)
SetBitPos(stream, col<<Col.start)
switchon na ls 4 ? col<<Col.type,1 into
[
case 0: //Decimal number/10
[ PutTemplate(stream, "$UD0", val); endcase ]
case 1: //bcpl string
[ Wss(stream, val); endcase ]
case 2: //Net#Host - val points to port structure
[
PutTemplate(stream, "$UO#$UO", val>>Port.net, val>>Port.host)
endcase
]
case 3: //boolean
[ Wss(stream, val ? "On","Off"); endcase ]
]
]
//----------------------------------------------------------------------------
and GetKeys() = valof
//----------------------------------------------------------------------------
[
Block() repeatwhile Endofs(keys)
resultis Gets(keys)
]
//----------------------------------------------------------------------------
and Confirm() = valof
//----------------------------------------------------------------------------
[
Wss(dis," [Confirm] ")
switchon GetKeys() into
[
case $Y: case $y: case $*N:
[ Wss(dis, "Yes."); resultis true ]
case $N: case $n:
[ Wss(dis, "No."); resultis false ]
case $?:
[ Wss(dis, " Yes or No: "); endcase ]
default:
[ Ding(dis); endcase ]
] repeat
]
//----------------------------------------------------------------------------
and Ding(stream) be
//----------------------------------------------------------------------------
[
InvertWindow(stream, true)
Dismiss(25)
InvertWindow(stream, false)
]
//----------------------------------------------------------------------------
and InvertWindow(stream, background) be
//----------------------------------------------------------------------------
[
let dcb = stream>>DS.fdcb
[
dcb>>DCB.background = background
if dcb eq stream>>DS.ldcb return
dcb = dcb>>DCB.next
] repeat
]
//----------------------------------------------------------------------------
and Wss(stream, string) be
//----------------------------------------------------------------------------
for i = 1 to string>>String.length do
Puts(stream, string>>String.char↑i)
//----------------------------------------------------------------------------
and GetName(port, soc1, soc2) = valof
//----------------------------------------------------------------------------
[
let name = vec 127
unless GetString(name) resultis false
resultis GetPartner(name, dis, port, soc1, soc2)
]
//----------------------------------------------------------------------------
and GetString(addr) = valof
//----------------------------------------------------------------------------
[
let count = 0
[
let char = GetKeys(); switchon char into
[
case $*N: case $*S:
[
Puts(dis, $*S)
addr>>String.length = count
resultis count
]
case $*001: case $*010:
[
if count ne 0 then
[
EraseBits(dis, -CharWidth(dis, addr>>String.char↑count))
count = count-1
]
endcase
]
case $*177:
[
for i = count to 1 by -1 do
EraseBits(dis, -CharWidth(dis, addr>>String.char↑i))
count = 0
endcase
]
default:
[
count = count+1
addr>>String.char↑count = char
Puts(dis, char)
endcase
]
]
] repeat
]
//----------------------------------------------------------------------------
and MiscServ() be //a context
//----------------------------------------------------------------------------
[
let socMisc = Allocate(zone,lenPupSoc)
OpenLevel1Socket(socMisc, table [ 0; 0; socketMiscServices ])
InitBootServ(zone, ctxQ, socMisc)
AddNameToBFT(bfnPupTest, "PupTest.boot")
[
Block() repeatuntil socMisc>>PupSoc.iQ.head ne 0
let pbi = Dequeue(lv socMisc>>PupSoc.iQ)
switchon pbi>>PBI.pup.type into
[
case typeSendBootFile: [ MayDayServ(pbi); endcase ]
default: ReleasePBI(pbi)
]
] repeat
]
//----------------------------------------------------------------------------
and MouseWatcher() be //a context
//----------------------------------------------------------------------------
//select and deselect lines
[
Block() repeatwhile (@utilIn & 7) eq 7
let curY, button = @cursorY, @utilIn & 7
for i = 1 to maxHosts do
if (curY ge hT>>HT.yMin↑i) & (curY ls hT>>HT.yMax↑i) then
switchon button into
[
case 3: //top or left or red
[
((hT>>HT.ds↑i)>>DS.cdcb)>>DCB.background = 1
hT>>HT.selected↑i = true
break
]
case 5: //bottom or right or green
[
((hT>>HT.ds↑i)>>DS.cdcb)>>DCB.background = 0
hT>>HT.selected↑i = false
break
]
]
] repeat