// IfsVMemSpy.bcpl -- virtual memory spy server -- swappable // Copyright Xerox Corporation 1980, 1982 // Last modified September 6, 1982 4:02 PM by Taft get "Pup0.decl" get "Pup1.decl" get "IfsOverlays.decl" get "IfsRs.decl" get "VMem.d" get "IfsVMem.decl" get "IfsVMemSpy.decl" external [ // outgoing procedures InitVMemSpy; VMemSpy // incoming procedures Allocate; Enqueue; Dequeue; MoveBlock; Zero CreateEvent; VMemSpyEvent; Block; CleanupLocks; FindVMD OpenLevel1Socket; CompletePup; ExchangePorts; ReleasePBI // outgoing statics vmemSpySoc // incoming statics ifsCtxQ; sysZone; snarfTable; @HASHMAP; @Bpt; jobT; lenJobT FirstOD; EndOD; LockedCells; LastLockedCell; vmStats; freePageQ ] static vmemSpySoc //---------------------------------------------------------------------------- let InitVMemSpy() be //---------------------------------------------------------------------------- [ vmemSpySoc = Allocate(sysZone, lenPupSoc) OpenLevel1Socket(vmemSpySoc, table [ 0; 1; socketVMemSpy ]) CreateEvent(VMemSpyEvent) ] //---------------------------------------------------------------------------- and VMemSpy() be //---------------------------------------------------------------------------- // Called by VMemSpyEvent when a pbi arrives on vmemSpySoc [ if vmemSpySoc>>PupSoc.iQ.head>>PBI.pup.type eq typeVMemSpyRequest then [ let pbi = Dequeue(lv vmemSpySoc>>PupSoc.iQ) CleanupLocks() let vms = lv pbi>>PBI.pup.words; Zero(vms, lenVMS) // Hash Map for i = 0 to 63 do [ let hm = HASHMAP + (Bpt + (i lshift 2))>>BPT.HASHX*2 let vPage = not hm>>HM.NKEY vms>>VMS.vPage^i = vPage test (vPage & MinDummyVP) eq MinDummyVP ifso if vPage eq EmptyVP then vms>>VMS.type^i = vmiTypeEmpty ifnot [ vms>>VMS.dirty^i = hm>>HM.CLEAN eq 0 vms>>VMS.type^i = FindVMD(vPage)>>VMD.vmi>>VMI.type ] ] // Locked cell list // This will set the lock bit for every overlay page, but // that will be fixed when we process the overlay descriptors let lc = LockedCells; while lc ne LastLockedCell do [ vms>>VMS.locked^(@(lc>>LC.addr) rshift 10) = true lc = lc + LCsize ] // Overlay Descriptors let od = FirstOD; while od ne EndOD+lOD do [ if od>>OD.core ne 0 then [ let base = od>>OD.core rshift 10 let length = (od+lOD)>>OD.firstPn - od>>OD.firstPn for i = base to base+length-1 do [ vms>>VMS.locked^i = od>>OD.onstack ne 0 //see note on locks ^ vms>>VMS.ovNum^i = (od-FirstOD)/lOD +1 ] ] od = od + lOD ] // Snarfed buffers being used for job stacks for i = 0 to lenJobT-1 do if jobT>>JobT^i ne 0 then vms>>VMS.jobType^(jobT>>JobT^i rshift 10) = jobT>>JobT^i>>RSCtx.type+1 // Snarf table for i = 0 to 63 do if snarfTable!i ne -1 then if snarfTable!i ne 0 then for j = 1 to snarfTable!i do vms>>VMS.type^(i+j-1) = vmiTypeSnarf // Retained free pages (IFSAllocate, IFSFree) -- indicate as "empty" let freePage = freePageQ!0 while freePage ne 0 do [ vms>>VMS.type^(freePage rshift 10) = vmiTypeEmpty; freePage = freePage!0 ] // VMStats MoveBlock(lv vms>>VMS.stats, vmStats, lenVMStats) ExchangePorts(pbi) CompletePup(pbi, typeVMemSpyReply, pupOvBytes + size VMS/8) ] while vmemSpySoc>>PupSoc.iQ.head ne 0 do ReleasePBI(Dequeue(lv vmemSpySoc>>PupSoc.iQ)) ]