// GateConEcho.bcpl
// Last modified February 28, 1979 2:43 AM by Boggs
get "Pup0.decl"
get "Pup1.decl"
get "AltoDefs.d"
get "PupEchoServ.decl"
external
[
// outgoing procedures
CreateEchoCtx; Echo; EchoSummary; RestartEcho
// incoming procedures
Puts; Endofs; PutTemplate; Ws; Resets
MoveBlock; Zero; Allocate; Free
InitializeContext; Block
SetTimer; TimerHasExpired; Enqueue; Dequeue
GetBuf; ReleasePBI; CompletePup
OpenLevel1Socket; CloseLevel1Socket
HLookup; Divide32x16; DoubleIncrement; MultEq
OtherPup; PrintPort; SendCommand
GetPartner; GetString
ResetCmdMenu; CreateCmdBox; TopLevel; ReturnFrom; BoxProc
// incoming statics
pupRT; errorDsp; dsp; keys; sysZone; ctxQ; gcHost; oldStatsQ
]
static @eu
structure EU: // eu -> this 'global frame' for the Echo process
[
soc word // -> PupSoc
stats word // -> Echo stats block
timer word // update stats when this expires
flags word =
[
blank bit 14
checksum bit // Generate and check Pup Checksum
checkData bit // Generate and check Pup data
]
]
manifest lenEU = size EU/16
//----------------------------------------------------------------------------
let CreateEchoCtx() be
//----------------------------------------------------------------------------
[
Enqueue(ctxQ, InitializeContext(Allocate(sysZone, 150), 150, EchoCtx))
eu = Allocate(sysZone, lenEU); Zero(eu, lenEU)
eu>>EU.soc = Allocate(sysZone, lenPupSoc); OpenLevel1Socket(eu>>EU.soc)
]
//----------------------------------------------------------------------------
and RestartEcho() be
//----------------------------------------------------------------------------
[
SetTimer(lv eu>>EU.timer, 0)
if eu>>EU.stats ne 0 then
[ Enqueue(oldStatsQ, eu>>EU.stats); eu>>EU.stats = 0 ]
]
//----------------------------------------------------------------------------
and Echo() be
//----------------------------------------------------------------------------
[
ResetCmdMenu()
CreateCmdBox(TopLevel, "TopLevel")
CreateCmdBox(EchoUser, "EchoUser")
CreateCmdBox(Checksum, (eu>>EU.checksum? "DontChecksum", "Checksum"))
CreateCmdBox(CheckData, (eu>>EU.checkData? "DontCheckData", "CheckData"))
// ResetCmdMenu destroyed the BoxQ which BoxProc is following.
// If we just return now, BoxProc will get horribly confused.
// So don't let it continue: force a return from BoxProc.
ReturnFrom(BoxProc)
]
//----------------------------------------------------------------------------
and EchoCtx(ctx) be // a context
//----------------------------------------------------------------------------
[
Block() repeatuntil TimerHasExpired(lv eu>>EU.timer) & gcHost ne 0
SetTimer(lv eu>>EU.timer, 1000) //10 sec
let pbi = GetBuf(eu>>EU.soc)
pbi>>PBI.pup.dPort.socket↑2 = psEchoServ
pbi = SendCommand(pbi, ptStatsRequest, pupOvBytes, 1)
if pbi ne 0 then
[
let stats = lv pbi>>PBI.pup.words
if pbi>>PBI.pup.type eq ptStatsReply &
stats>>Stats.version eq echoStatsVersion then
[
if eu>>EU.stats then Enqueue(oldStatsQ, eu>>EU.stats)
let lenStatBlock = pbi>>PBI.pup.length - pupOvBytes
eu>>EU.stats = Allocate(sysZone, lenStatBlock)
MoveBlock(eu>>EU.stats, lv pbi>>PBI.pup.words, lenStatBlock)
]
ReleasePBI(pbi)
]
] repeat
//----------------------------------------------------------------------------
and EchoSummary(stream) be
//----------------------------------------------------------------------------
[
if eu>>EU.stats ne 0 then
PutTemplate(stream, "Echo: $EUD ", lv eu>>EU.stats>>Stats.packetsEchoed)
]
//----------------------------------------------------------------------------
and CheckData(box) be
//----------------------------------------------------------------------------
[
eu>>EU.checkData = not eu>>EU.checkData
Echo()
]
//----------------------------------------------------------------------------
and Checksum(box) be
//----------------------------------------------------------------------------
[
eu>>EU.checksum = not eu>>EU.checksum
Echo()
]
//----------------------------------------------------------------------------
and EchoUser() be
//----------------------------------------------------------------------------
[
let name = vec 128
unless GetString("*NEcho to: ", name) return
let port = vec lenPort
unless GetPartner(name, dsp, port, 0, psEchoServ) return
let soc = vec lenPupSoc; OpenLevel1Socket(soc, 0, port)
soc>>PupSoc.doChecksum = eu>>EU.checksum
PutTemplate(dsp, "$P -> ", PrintPort, lv soc>>PupSoc.lclPort)
let rte = HLookup(pupRT, soc>>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(dsp, lv soc>>PupSoc.frnPort)
let out = vec 6; Zero(out, 6)
let in, inTimes100 = out+2, out+4
let pupLength, pupID = -1, -1
let dataBuffer = vec 532/2
structure Byte↑0,532 byte
for i = 0 to 531 do dataBuffer>>Byte↑i = i
let cursor = vec 15; MoveBlock(cursor, cursorBitMap, 16)
for i = 0 to 7 do cursorBitMap!i = 377b
for i = 10b to 17b do cursorBitMap!i = 177400b
[
let pbi = GetBuf(soc)
pupLength = pupLength +1
if pupLength gr 532 then pupLength = 0
pupID = pupID +1
pbi>>PBI.pup.id↑1 = 0
pbi>>PBI.pup.id↑2 = pupID
MoveBlock(lv pbi>>PBI.pup.bytes, dataBuffer, (pupLength+1)/2)
CompletePup(pbi, ptEchoMe, pupOvBytes+pupLength)
DoubleIncrement(out)
let time = nil; SetTimer(lv time, 150)
[
Block() repeatuntil soc>>PupSoc.iQ.head % TimerHasExpired(lv time)
pbi = Dequeue(lv soc>>PupSoc.iQ)
if pbi eq 0 then [ Puts(dsp, $?); break ]
if pbi>>PBI.pup.type ne ptImAnEcho then
[ OtherPup(pbi); loop ]
DoubleIncrement(in); DoubleIncrement(inTimes100, 100)
test pbi>>PBI.pup.id↑2 eq pupID
ifnot [ Puts(dsp, $#); ReleasePBI(pbi) ]
ifso
[
if pupLength gr 0 then
unless MultEq(lv pbi>>PBI.pup.words, dataBuffer,
(pupLength+1)/2) do
Ws("*NDate compare error")
for i = 0 to 17b do cursorBitMap!i = not cursorBitMap!i
Puts(dsp, $!)
ReleasePBI(pbi)
break
]
] repeat
] repeatwhile Endofs(keys)
Resets(keys)
CloseLevel1Socket(soc)
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)
MoveBlock(cursorBitMap, cursor, 16)
]