// IFSVMemRes.bcpl - Interim File System VMem interface -- resident portion
// Copyright Xerox Corporation 1979, 1980, 1982

// Last modified September 17, 1982  2:15 PM by Taft

get "IfsVMem.decl"
get "VMem.d"

external
[
// outgoing procedures
DOPAGEIO; CleanupLocks; PageType; NoBufsProc
PageGroupAlign; PageGroupBase; PageGroupSize
FindVMD; SnarfBuffers; UnsnarfBuffers; VirtualPage

// incoming procedures
IFSError; Dismiss; DoubleIncrement; ReturnRetainedFreePages; SetBlock
FindFreeBuf; FlushBufs

// outgoing statics
vmdt; vmStats; vmemBufferShortages

// incoming statics
@Bpt; @BptLast; @HASHMAP; LockedCells; LastLockedCell; EMPTYXX; NAXX
availableListChanged
]

static [ vmdt; vmStats; vmemBufferShortages ]

manifest
[
// error codes
ecFindVMD = 1
ecBadVMemGroup = 29
ecUnsnarfBuffer = 25
]

//----------------------------------------------------------------------------
let FindVMD(vPage) = valof
//----------------------------------------------------------------------------
// Returns a pointer to the Virtual memory descriptor for vPage.
// Requires that there be "zero" and "infinity" entries in vmdt
// with a VMI such that any call will result in IFSError.
[
let low, high = 1, vmdt>>VMDT.length
while low ls high do
   [  // Find greatest VMDT entry less than or equal to vPage
   let probe = (low+high+1) rshift 1
   test vPage uge vmdt>>VMDT.vmd↑probe>>VMD.base
      ifso low = probe
      ifnot high = probe-1
   ]
let vmd = vmdt>>VMDT.vmd↑low
if vPage-vmd>>VMD.base uge vmd>>VMD.length then
   IFSError(ecFindVMD, vPage)
resultis vmd
]

//----------------------------------------------------------------------------
and NoBufsProc() be  // Called when VMem can't find a buffer to assign
//----------------------------------------------------------------------------
   if ReturnRetainedFreePages() eq 0 then
      [
      Dismiss(100)  // 1 second
      vmemBufferShortages = vmemBufferShortages +1
      CleanupLocks()  // so overlay locks are reevaluated
      ]

// These are the routines that the VMem package calls.
// The general idea is to find the virtual memory descriptor
//  for the virtual page in question, and pass the call on via the
//  procedure pointers in the corresponding virtual memory interface.

//----------------------------------------------------------------------------
and CleanupLocks() be
//----------------------------------------------------------------------------
[
// Call all owners of VMem to clean up their locks
for i = 1 to vmdt>>VMDT.length do
   [
   let vmd = vmdt>>VMDT.vmd↑i
   vmd>>VMD.vmi>>VMI.CleanupLocks(vmd)
   ]
]

//----------------------------------------------------------------------------
and DOPAGEIO(vPage, core, nPgs, wFlag) be
//----------------------------------------------------------------------------
[
let vmd = FindVMD(vPage)
let vmi = vmd>>VMD.vmi
DoubleIncrement((wFlag? lv vmStats>>VMStats.writes↑(vmi>>VMI.type),
 lv vmStats>>VMStats.reads↑(vmi>>VMI.type)))

// Check for attempt to transfer partial 'write' groups
// (a symptom of a VMem bug that was fixed long ago)
// let groupSize = vmi>>VMI.PageGroupSize(vmd, vPage)
// if groupSize ls 0 &
//  (vPage ne vmi>>VMI.PageGroupBase(vmd, vPage) % nPgs ls -groupSize) then
//    IFSError(ecBadVMemGroup)

// Pass request off to the correct DOPAGEIO procedure
vmi>>VMI.DOPAGEIO(vmd, vPage, core, nPgs, wFlag)
]

//----------------------------------------------------------------------------
and PageType(vPage, wFlag) = valof
//----------------------------------------------------------------------------
[
let vmd = FindVMD(vPage)
resultis vmd>>VMD.vmi>>VMI.PageType(vmd, vPage, wFlag)
]

//----------------------------------------------------------------------------
and PageGroupAlign(vPage) = valof
//----------------------------------------------------------------------------
[
let vmd = FindVMD(vPage)
resultis vmd>>VMD.vmi>>VMI.PageGroupAlign(vmd, vPage)
]

//----------------------------------------------------------------------------
and PageGroupBase(vPage) = valof
//----------------------------------------------------------------------------
[
let vmd = FindVMD(vPage)
resultis vmd>>VMD.vmi>>VMI.PageGroupBase(vmd, vPage)
]

//----------------------------------------------------------------------------
and PageGroupSize(vPage) = valof
//----------------------------------------------------------------------------
[
let vmd = FindVMD(vPage)
resultis vmd>>VMD.vmi>>VMI.PageGroupSize(vmd, vPage)
]

// IFS substitutes for certain procedures in VMemAux.bcpl
// Note that the arguments to SnarfBuffers and UnsnarfBuffers are not quite
// the same, which is why the names were changed by appending 's'.
// In all calls, cPage is a VMem core page number (i.e., 256-word page)
// and nBufs is a count of VMem pages.

//----------------------------------------------------------------------------
and SnarfBuffers(cPage, nBufs, align) = valof
//----------------------------------------------------------------------------
// Attempts to find a contiguous group of available pages of length nBufs.
// If successful, makes the pages unavailable to VMem and returns a pointer to
// the first word of the first page of the group; if unsuccessful, returns zero.
// If cPage is nonzero, will return only the nBufs starting at cPage, else
// will fail.  If align is nonzero, the returned group of pages is constrained
// to begin at a core page number such that ((page number) & align) eq 0.
[
CleanupLocks()

// Find block of desired size, or ensure requested one is available
let foundPage = FindFreeBuf(nBufs, align, cPage)
if foundPage eq 0 resultis 0
if cPage eq 0 then cPage = foundPage

// Remove buffers from chain, flush them out, and delete from map
FlushBufs(cPage, nBufs, -1)

// Mark them unavailable to VMem
SetBlock(Bpt+cPage, NAXX, nBufs)

resultis cPage lshift logVMPageLength
]

//----------------------------------------------------------------------------
and UnsnarfBuffers(cPage, nBufs) be
//----------------------------------------------------------------------------
// Releases a group of pages of length nBufs starting at cPage.
[
let p = cPage+nBufs-1
if @Bpt eq 0 then BptLast = p
while p uge cPage do
   [
   unless Bpt!p eq NAXX do IFSError(ecUnsnarfBuffer)
   Bpt!p = EMPTYXX+@Bpt
   @Bpt = p
   p = p-1
   ]
availableListChanged = true
]

//----------------------------------------------------------------------------
and VirtualPage(cPage) = not (HASHMAP+(Bpt+cPage)>>BPT.HASHX*2)>>HM.NKEY
//----------------------------------------------------------------------------
// Returns the virtual page number for a given core page number.
// If page is not mapped into virtual memory, returns one of the special
// "virtual" page numbers (EmptyVP = -2 if empty; NaVP = -3 if not available
// to VMem).