// VMemSpyCore.bcpl
// Copyright Xerox Corporation 1980
// Last modified December 28, 1980 6:31 PM by Boggs
get "Pup0.decl"
get "Pup1.decl"
get "Streams.d"
get "AltoDefs.d"
get "IfsRs.decl"
get "VMem.d"
get "IfsVMem.decl"
get "IfsVMemSpy.decl"
get "VMemSpy.decl"
external
[
// outgoing procedures
Spy
// incoming procedures
Puts; Resets; Endofs; PutTemplate; Wss
SetBitPos; EraseBits; CharWidth
CallSwat; MoveBlock; Dequeue; MultEq
Block; SetTimer; TimerHasExpired
OpenLevel1Socket; CloseLevel1Socket
GetPBI; CompletePup; ReleasePBI; FlushQueue
// incoming statics
dt; nt; port; show; noshow; keys; dsp
]
//----------------------------------------------------------------------------
let Spy() be
//----------------------------------------------------------------------------
[
port>>Port.socket↑1 = 1
port>>Port.socket↑2 = socketVMemSpy
let spySoc = vec lenPupSoc
OpenLevel1Socket(spySoc, 0, port)
let oldStats = vec lenVMStats
while Endofs(keys) do
[ // main program loop
let pbi, timer = nil, nil
if spySoc>>PupSoc.iQ.head eq 0 then
[ // send a probe
[
pbi = GetPBI(spySoc, true)
if pbi ne 0 break
FlushQueue(lv spySoc>>PupSoc.iQ)
Block()
] repeat
CompletePup(pbi, typeVMemSpyRequest, pupOvBytes)
SetTimer(lv timer, 100) //1 second
]
// wait for an answer
Block() repeatuntil TimerHasExpired(lv timer) % spySoc>>PupSoc.iQ.head ne 0
pbi = Dequeue(lv spySoc>>PupSoc.iQ); if pbi eq 0 loop //timed out
if pbi>>PBI.pup.type eq typeVMemSpyReply then
[
for i = 0 to 15 do cursorBitMap!i = not cursorBitMap!i
let vms = lv pbi>>PBI.pup.words
// All loops go from 1 to 63, ignoring real page 0 since it is
// special in many ways and we know it can't be a vMem buffer.
let numPages = 0
for rPage = 1 to 63 if vms>>VMS.type↑rPage ne 0 then
numPages = numPages +1
if numPages gr maxLines then CallSwat("Increase maxLines")
for line = 1 to maxLines do dt>>DT↑line.address = 0
let line = (maxLines-numPages)/2
for rPage = 1 to 63 if vms>>VMS.type↑rPage ne 0 then
[
dt>>DT↑line.address = rPage
line = line +1
]
// Spy (cont'd)
for rPage = 1 to 63 do
[
let line = 0
for j = 1 to maxLines do
if dt>>DT↑j.address eq rPage then
[ line = j; break ]
if line eq 0 loop
dt>>DT↑line.vPage = vms>>VMS.vPage↑rPage
dt>>DT↑line.dirty = vms>>VMS.dirty↑rPage ne 0
dt>>DT↑line.locked = vms>>VMS.locked↑rPage ne 0
switchon vms>>VMS.type↑rPage into
[
case 0: endcase //not a VM buffer
case vmiTypeOverlay:
[
dt>>DT↑line.name = nt!(vms>>VMS.ovNum↑rPage)
endcase
]
case vmiTypeVFile:
[
dt>>DT↑line.name = "VFile"
endcase
]
case vmiTypeDD:
[
dt>>DT↑line.name = "DiskDescriptor"
endcase
]
case vmiTypeLeaf:
[
dt>>DT↑line.name = "Leaf"
endcase
]
case maxVMIType+1: //snarfed
[
dt>>DT↑line.locked = true
dt>>DT↑line.vPage = 0
dt>>DT↑line.name = selecton vms>>VMS.jobType↑rPage -1 into
[
case jobTypeFTP: "FTP job"
case jobTypeMTP: "MTP job"
case jobTypeTelnet: "Telnet job"
case jobTypeBackup: "Backup job"
case jobTypeMail: "Mail job"
case jobTypeMiscellaneous: "MiscServ job"
case jobTypeLeaf: "Leaf job"
case jobTypePress: "Press job"
case jobTypeNameUpdate: "NameUpdate job"
case jobTypeBootUpdate: "BootUpdate job"
case jobTypeCopyDisk: "CopyDisk job"
default: "Snarfed"
]
endcase
]
case maxVMIType+2: // free page
[
dt>>DT↑line.name = "Free page"
dt>>DT↑line.vPage = 0
endcase
]
default:
[
dt>>DT↑line.name = "[Unknown page type]"
endcase
]
]
]
// Spy (cont'd)
for line = 1 to maxLines do
[
let ds = dt>>DT↑line.ds
// address
if dt>>DT↑line.lastAddress ne dt>>DT↑line.address then
[
dt>>DT↑line.lastAddress = dt>>DT↑line.address
Resets(ds)
dt>>DT↑line.lastLocked = false
if dt>>DT↑line.address eq 0 loop
SetBitPos(ds, posAddress)
PutTemplate(ds, "$6UO", dt>>DT↑line.address lshift 10)
SetBitPos(ds, posLBorder)
EraseBits(ds, widthBorder, 1) //left
SetBitPos(ds, posRBorder)
EraseBits(ds, widthBorder, 1) //right
]
if dt>>DT↑line.address eq 0 loop
// vPage
if dt>>DT↑line.lastVPage ne dt>>DT↑line.vPage then
[
dt>>DT↑line.lastVPage = dt>>DT↑line.vPage
SetBitPos(ds, posVPage)
EraseBits(ds, widthVPage, 0)
if dt>>DT↑line.vPage ne 0 then
[
SetBitPos(ds, posVPage)
PutTemplate(ds, "$6UO", dt>>DT↑line.vPage)
]
if dt>>DT↑line.lastLocked then
[
SetBitPos(ds, posVPage)
EraseBits(ds, widthVPage, -1)
]
]
// name
if dt>>DT↑line.lastName ne dt>>DT↑line.name then
[
dt>>DT↑line.lastName = dt>>DT↑line.name
SetBitPos(ds, posName)
EraseBits(ds, widthName, 0)
if dt>>DT↑line.name ne 0 then
[
SetBitPos(ds, posName)
Wss(ds, dt>>DT↑line.name)
]
if dt>>DT↑line.lastLocked then
[
SetBitPos(ds, posName)
EraseBits(ds, widthName, -1)
]
]
// Spy (cont'd)
// dirty
if dt>>DT↑line.lastDirty ne dt>>DT↑line.dirty then
[
dt>>DT↑line.lastDirty = dt>>DT↑line.dirty
SetBitPos(ds, posDirty)
test dt>>DT↑line.dirty
ifso Puts(ds, $*377) //mark dirty
ifnot EraseBits(ds, 16, (dt>>DT↑line.lastLocked? 1, 0))
]
// Background
if dt>>DT↑line.lastLocked ne dt>>DT↑line.locked then
[
dt>>DT↑line.lastLocked = dt>>DT↑line.locked
SetBitPos(ds, posDirty)
EraseBits(ds, posRBorder-posDirty, -1)
]
]
// process vmem stats
let vmStats = lv vms>>VMS.stats
unless MultEq(oldStats, vmStats, lenVMStats) do
[
Resets(noshow)
Wss(noshow, "VMem Overlay VFile DD Leaf")
Wss(noshow, "*NReads ")
for type = 1 to maxVMIType do
PutTemplate(noshow, "$9ED", lv vmStats>>VMStats.reads↑type)
Wss(noshow, "*NWrites")
for type = 1 to maxVMIType do
PutTemplate(noshow, "$9ED", lv vmStats>>VMStats.writes↑type)
let p = lv vmStats>>VMStats.ovXMReads
if p!0 ne 0 % p!1 ne 0 then
PutTemplate(noshow, "*N$ED overlay reads from XM, $ED from disk",
lv vmStats>>VMStats.ovXMReads, lv vmStats>>VMStats.ovDiskReads)
dt>>DT↑1.ds>>DS.ldcb>>DCB.next = noshow>>DS.fdcb
let temp = show; show = noshow; noshow = temp
MoveBlock(oldStats, vmStats, lenVMStats)
]
]
ReleasePBI(pbi)
]
CloseLevel1Socket(spySoc)
]