// IFSVMemSwap.bcpl - Interim File System VMem interface -- swappable portion // Copyright Xerox Corporation 1979, 1982, 1983 // Last modified September 23, 1983 2:51 PM by Taft get "IfsVMem.decl" get "VMem.d" external [ // outgoing procedures AllocateVMem; FreeVMem; PurgeVMem; FlushBuffers // incoming procedures VirtualPage; SnarfBuffers; UnsnarfBuffers; FlushBufs; PageGroupSize IFSError; Dismiss // incoming statics vmdt; availableListChanged; @Bpt; @HASHMAP ] manifest [ // error codes ecVMemAllocate = 2 ecPurgeLockedPage = 4 ] //---------------------------------------------------------------------------- let AllocateVMem(vmd, vmi, numPages) be //---------------------------------------------------------------------------- // A primitive first-fit virtual memory allocator. Initializes the VMD to // describe the vmem region allocated. Does not touch the VMI. // Assumes that the VMDT contains "zero" and "infinity" entries. [ // Round numPages up to next multiple of 4 vmem pages, leaving a gap of // at least one vmem page so as to prevent DOPAGEIO calls from bridging VMDs vmd>>VMD.length = numPages numPages = (numPages+4) & -4 // Search for a free vmem region vmd>>VMD.base = 0 unless vmdt>>VMDT.length eq maxVMD do for i = 1 to vmdt>>VMDT.length do [ let tvmd = vmdt>>VMDT.vmd^i if tvmd>>VMD.base-vmd>>VMD.base uge numPages then [ // Insert vmd into table vmd>>VMD.vmi = vmi for j = vmdt>>VMDT.length to i by -1 do vmdt>>VMDT.vmd^(j+1) = vmdt>>VMDT.vmd^j vmdt>>VMDT.length = vmdt>>VMDT.length+1 vmdt>>VMDT.vmd^i = vmd vmdt>>VMDT.version = vmdt>>VMDT.version+1 return ] vmd>>VMD.base = tvmd>>VMD.base + tvmd>>VMD.length ] // Either the VMDT is full or we can't find a vmem block that is big enough IFSError(ecVMemAllocate, numPages) ] //---------------------------------------------------------------------------- and FreeVMem(vmd) be //---------------------------------------------------------------------------- // Frees the virtual memory belonging to vmd. Does not attempt to // destroy the vmd (or vmi) objects, however. [ // Flush pages and invalidate hash map PurgeVMem(vmd) // Remove vmd from table for i = 1 to vmdt>>VMDT.length do if vmd>>VMD.base ule vmdt>>VMDT.vmd^i>>VMD.base then vmdt>>VMDT.vmd^i = vmdt>>VMDT.vmd^(i+1) vmdt>>VMDT.length = vmdt>>VMDT.length-1 vmdt>>VMDT.version = vmdt>>VMDT.version+1 ] //---------------------------------------------------------------------------- and PurgeVMem(vmd) be //---------------------------------------------------------------------------- // Updates disk state and purges from memory any vPages belonging to vmd. // This does not invalidate the vmd, it simply invalidates the hash map // for all virtual addresses belonging to vmd, thereby requiring them to // be read anew from disk on a subsequent reference. This permits the // range of virtual addresses belonging to vmd to be reassigned. // If any of vmd's pages are locked, an error will result. // The results are undefined (and possibly erroneous) if there are any // concurrent references (VRRP, VWRP) to the virtual addresses in question. [ let tries = 0 let cPage = 1 // Don't start at 0 -- VirtualPage(0) returns funny results while cPage ls 1 lshift (16-logVMPageLength) do [ let nPages = 1 // go one-at-a-time for pages NOT belonging to vmd let vPage = VirtualPage(cPage) if vPage-vmd>>VMD.base uls vmd>>VMD.length then [ // vPage belongs to vmd. Assert: vPage is the first page of a group. // Snarf all pages of the group at once so as to keep them together // on the replacement list. nPages = PageGroupSize(vPage); if nPages ls 0 then nPages = -nPages test SnarfBuffers(cPage, nPages, 0) eq 0 ifso [ // SnarfBuffers failed because the page is locked. // The page might be locked because another process is in the // midst of swapping it out (which causes it to be locked). // Allow up to 10 seconds for this to finish. tries = tries+1 if tries gr 100 then IFSError(ecPurgeLockedPage, cPage lshift logVMPageLength) Dismiss(10) // Careful: now re-evaluate whether VirtualPage(cPage) still // belongs to vmd, since it might have gotten flushed by // some other process in the meantime. loop ] ifnot UnsnarfBuffers(cPage, nPages) ] cPage = cPage+nPages tries = 0 ] ] //---------------------------------------------------------------------------- and FlushBuffers(thoroughly; numargs na) be //---------------------------------------------------------------------------- // "Safe" replacement for the FlushBuffers procedure in VMemAux. // Flushes only pages that are on the available list, thereby circumventing // the notorious "Can't flush locked page" bug. // If thoroughly is true, guarantees to flush all pages that were dirty at the // time of the call, even in the face of other concurrent VMem activity that // causes the available list to be reordered. If thorougly is false or omitted, // may leave some dirty pages behind in the face of concurrent VMem activity. [ // repeat availableListChanged = false let cPage = @Bpt until cPage eq 0 do [ if (HASHMAP + (Bpt+cPage)>>BPT.HASHX*2)>>HM.CLEAN eq 0 then [ // Found dirty page; flush it out (but do not remove or mark empty) FlushBufs(cPage, 1, 0) // Note: at first blush it would seem that continuing to follow the list // from cPage is now unsafe, since contexts switched during FlushBufs and // there might have been other VMem activity that could reorder the list. // However, FlushBufs locked the page while flushing it, which means that // FindFreeBuf cannot have selected the page for replacement, and that is // the only way by which pages are removed from the list. Therefore, cPage // is still on the list, though other parts of the list may have been // reordered. // Now attempt to skip to the end of the page group, so as to avoid // flushing a dirty locked page group multiple times. This works only // if pages of a group are together in the available list, a // condition which CleanupLocks attempts to maintain. The following // statement will skip to the end of the group assuming that the pages // in the group are chained together in ascending order of page number. while (HASHMAP + (Bpt+cPage)>>BPT.HASHX*2)>>HM.NLPG ne 0 & (Bpt+cPage)>>BPT.NEXT eq cPage+1 do cPage = cPage+1 ] cPage = (Bpt+cPage)>>BPT.NEXT ] ] repeatwhile na gr 0 & thoroughly & availableListChanged