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