// IFSResUtilb.bcpl - RESIDENT utility stuff
// Copyright Xerox Corporation 1979, 1980, 1981, 1982
// Last modified September 17, 1982 1:20 PM by Taft
get "AltoDefs.d"
get "Ifs.decl"
get logVMPageLength from "IfsVMem.decl"
get "AltoFileSys.d"
get "Disks.d"
get "Tfs.d"
external
[
// outgoing procedures
Lock; Unlock; IFSAllocate; IFSFree; IFSAddToZone; ReturnRetainedFreePages
SysAllocateZero; FreePointer; IFSIdle; IFSError; SysErr
// incoming procedures
Block; SnarfBuffers; UnsnarfBuffers; MulDiv; Zero; Max
Enqueue; Dequeue; Unqueue; QueueLength
Allocate; Free; SysFree; InitializeZone; AddToZone; SysAllocate
Puts; Gets; Endofs; NoBufsProc
// outgoing statics
snarfTable; bigZone; smallZone; oPageQ; chunkQ; freePageQ; dontSnarf
smallZoneOverflows; bigZoneOverflows; numOverflowPages; maxOverflowPages
netAllocBlocks; maxRetainedFreePages
// incoming statics
CtxRunning; sysZone; debugFlag
]
static
[
snarfTable; chunkQ; oPageQ; freePageQ; bigZone; smallZone
smallZoneOverflows = 0
bigZoneOverflows = 0
numOverflowPages = 0
maxOverflowPages = 0
netAllocBlocks = 0
maxRetainedFreePages = 0 // set nonzero in XM configurations
dontSnarf = true // set to False after VMem buffers made available
]
manifest
[
ecIllegalLock = 10
ecWrongLockOwner = 11
ecSnarfTable = 12
ecSnarfBuffer = 13
ecSmallZoneEmpty = 14
ecBigZoneEmpty = 15
ecNotInZoneTable = 32
ecOverflowPage = 33
stdPageLength = 1 lshift logStdPageLength
smallZoneMax = 25
bigZoneMax = stdPageLength/2-10
// The links in freePageQ items are offset from the beginning of the page
// by this amount so that a running context can destroy itself without the
// ifsCtxQ and freePageQ links interfering with each other (see the
// DestroyJob procedure in IfsRSMgrSwap.bcpl).
offsetFreePageLink = 10
]
// NOTE: IfsAllocSpy has a private copy of these structures
structure ZC: // zone chunk
[
link word // link to next chunk
base word // base of chunk
length word // length of chunk
zone word // zone owning chunk
]
manifest lenZC = size ZC/16
structure OPage: // overflow page
[
link word // link to next page
zone word // pointer to zone contained within this page
count word // reference count
// zone created starting here
]
manifest lenOPage = size OPage/16
//----------------------------------------------------------------------------
let IFSError(errNo, p1, p2, p3, p4, p5) be
//----------------------------------------------------------------------------
(table [ 77403b; 1401b ])("IFS.Errors", lv errNo)
//----------------------------------------------------------------------------
and SysErr(p1, errNo, p2, p3, p4, p5) be
//----------------------------------------------------------------------------
[
let temp = p1; p1 = errNo; errNo = temp
(table [ 77403b; 1401b ])("Sys.Errors", lv p1)
]
// Some general-purpose procedures for mutual exclusion.
// A Lock is a 2-word structure defined in IFS.decl.
// It controls read and write access to a resource.
// There can be any number of readers but only one writer at a given time.
//----------------------------------------------------------------------------
and Lock(lock, write, returnOnFail; numargs na) = valof
//----------------------------------------------------------------------------
// Sets a lock: a read lock if write is false or omitted, or
// a write lock if write is true. If returnOnFail
// is false or omitted, blocks until the lock can be set; if
// true, returns false if the lock cannot be set immediately.
[
if na eq 1 then write = false
if lock>>Lock.count ne 0 then
if write % lock>>Lock.count ls 0 then
[
// Have to wait. But if the last locker of the lock was this context,
// a deadlock will result, so...
if lock>>Lock.ctx eq CtxRunning then IFSError(ecIllegalLock, lock)
if na ge 3 & returnOnFail resultis false
test write
ifso Block() repeatuntil lock>>Lock.count eq 0
ifnot Block() repeatuntil lock>>Lock.count ge 0
]
lock>>Lock.count = (write? -1, lock>>Lock.count+1)
lock>>Lock.ctx = CtxRunning
resultis true
]
//----------------------------------------------------------------------------
and Unlock(lock) be
//----------------------------------------------------------------------------
[
if lock>>Lock.count eq 0 %
lock>>Lock.count ls 0 & lock>>Lock.ctx ne CtxRunning then
IFSError(ecWrongLockOwner, lock)
lock>>Lock.count = Max(lock>>Lock.count-1, 0)
lock>>Lock.ctx = 0
]
//----------------------------------------------------------------------------
and IFSAllocate(zone, length, returnOnNoSpace, even; numargs na) = valof
//----------------------------------------------------------------------------
// Allocation requests are divided into three types:
// Requests for up to smallZoneMax words are filled from smallZone,
// for smallZoneMax to bigZoneMax words are filled from bigZone, and
// for bigger than bigZoneMax are filled by snarfing buffer(s)
// from vMem (except during initialization when dontSnarf is true).
// If a zone runs out of space, does one of two things
// depending on the state of debugFlag:
// If debugFlag is true, system personel are present,
// go into swat, since they should know that the zone
// sizes need to be adjusted.
// If debugFlag is false, the system is presumed to be in
// service, and it should recover if possible, by borrowing
// some space from the next bigger zone.
// If bigZone runs out of space, snarfs a buffer and makes a new zone
// out of it to satisfy this request and any future requests that
// also overflow bigZone. The snarfed buffer is reference-counted
// and put on a queue so that it may be returned to vMem when
// all blocks allocated within it have been freed.
// If SnarfBuffers fails, and debugFlag is true, then calls
// IFSError(ecSnarfBuffer). Proceeding will wait a few seconds
// and then try Snarfing again. If debugFlag is false, doesn't
// go into swat, just waits and then tries again.
// This procedure almost exactly emulates the standard Zone
// Allocate except that it does not return the largest block
// available if a request fails and returnOnNoSpace is non-zero
// and not -1 (since the largest block is not a well defined concept
// when one can borrow space from vMem).
// A pool of up to maxRetainedFreePages 1-page blocks is retained
// on freePageQ rather than immediately given back to VMem, and
// handed out during subsequent requests for 1-page blocks.
// This substantially reduces the frequency of calls to SnarfBuffers
// and UnsnarfBuffers, which are very expensive. The pages are given
// back immediately if a VMem shortage occurs, and also periodically
// when the system is idle.
// IFSAllocate (cont'd)
[
if na ls 4 then even = false
if na ls 3 then returnOnNoSpace = false
netAllocBlocks = netAllocBlocks+1
if length le smallZoneMax then
[
let block = Allocate(smallZone, length, true, even)
if block ne 0 resultis block
if debugFlag then IFSError(ecSmallZoneEmpty, length)
smallZoneOverflows = smallZoneOverflows+1
]
if length le bigZoneMax % dontSnarf then
[
let block = Allocate(bigZone, length, true, even)
if block ne 0 then resultis block
if debugFlag % dontSnarf then IFSError(ecBigZoneEmpty, length)
bigZoneOverflows = bigZoneOverflows+1
let oPage = oPageQ!0
while oPage ne 0 do
[ // try allocating from any overflow pages that presently exist
block = Allocate(oPage>>OPage.zone, length, true, even)
if block ne 0 then
[ oPage>>OPage.count = oPage>>OPage.count+1; resultis block ]
oPage = oPage>>OPage.link
]
]
// Snarf buffer(s)
let nPages = (length+(stdPageLength-1)) rshift logStdPageLength
let buf = nil
[ // repeat
if nPages eq 1 & freePageQ!0 ne 0 then
[ buf = Dequeue(freePageQ)-offsetFreePageLink; break ]
manifest nBufs = stdPageLength/256
buf = SnarfBuffers(0, nBufs*nPages, nBufs-1)
if buf ne 0 break
if returnOnNoSpace then
[ netAllocBlocks = netAllocBlocks-1; resultis 0 ]
if debugFlag then IFSError(ecSnarfBuffer)
NoBufsProc()
] repeat
let pageNum = buf rshift logStdPageLength
if snarfTable!pageNum ne 0 then IFSError(ecSnarfTable)
snarfTable!pageNum = nPages
if length le bigZoneMax then
[ // just assigned new overflow page
buf>>OPage.zone = InitializeZone(buf+lenOPage, stdPageLength-lenOPage,
SysErr, 0)
buf>>OPage.count = 1
Enqueue(oPageQ, buf)
numOverflowPages = numOverflowPages+1
maxOverflowPages = Max(numOverflowPages, maxOverflowPages)
resultis Allocate(buf>>OPage.zone, length, false, even)
]
resultis buf
]
//----------------------------------------------------------------------------
and IFSFree(zone, item) = valof
//----------------------------------------------------------------------------
[
netAllocBlocks = netAllocBlocks-1
let pageNum = item rshift logStdPageLength
test snarfTable!pageNum eq -1
ifso
[ // not a vmem page -- must be one of the permanent zones
let chunk = chunkQ!0
while chunk ne 0 do
[
if item-chunk>>ZC.base uls chunk>>ZC.length then
[ Free(chunk>>ZC.zone, item); resultis 0 ]
chunk = chunk>>ZC.link
]
IFSError(ecNotInZoneTable, item)
]
ifnot
[ // within a vmem page
let page = item & -1 lshift logStdPageLength
if item ne page then
[ // returning block to overflow page
Free(page>>OPage.zone, item)
page>>OPage.count = page>>OPage.count-1
if page>>OPage.count gr 0 resultis 0
let chunk = chunkQ!0
[
if chunk eq 0 then IFSError(ecOverflowPage, page)
if chunk>>ZC.zone eq page>>OPage.zone break
chunk = chunk>>ZC.link
] repeat
unless Unqueue(chunkQ, chunk) & Unqueue(oPageQ, page) do
IFSError(ecOverflowPage, page)
numOverflowPages = numOverflowPages-1
]
let nPages = snarfTable!pageNum
test nPages eq 1 & QueueLength(freePageQ) ls maxRetainedFreePages
ifso Enqueue(freePageQ, page+offsetFreePageLink)
ifnot UnsnarfBuffers(page rshift logVMPageLength,
nPages lshift (logStdPageLength-logVMPageLength))
snarfTable!pageNum = 0
]
resultis 0
]
//----------------------------------------------------------------------------
and ReturnRetainedFreePages() = valof
//----------------------------------------------------------------------------
// Gives pages retained on freePageQ back to VMem.
// Returns the number of pages that were given back.
[
let nPages = 0
while freePageQ!0 ne 0 do
[
let page = Dequeue(freePageQ)-offsetFreePageLink
UnsnarfBuffers(page rshift logVMPageLength,
1 lshift (logStdPageLength-logVMPageLength))
nPages = nPages+1
]
resultis nPages
]
//----------------------------------------------------------------------------
and IFSAddToZone(zone, base, length) be
//----------------------------------------------------------------------------
// This procedure's static's value is exchanged with that of AddToZone,
// so all callers who think they are calling AddToZone are really
// calling this procedure.
[
IFSAddToZone(zone, base, length) // the real AddToZone, not a recursive call!
let chunk = Allocate(zone, lenZC)
chunk>>ZC.zone = zone
chunk>>ZC.base = base
chunk>>ZC.length = length
Enqueue(chunkQ, chunk)
]
// See IFSResUtila.asm for the following:
// SysAllocate(nWords) = Allocate(sysZone, nWords)
// SysFree(block) = Free(sysZone, block)
//----------------------------------------------------------------------------
and SysAllocateZero(nWords) = valof
//----------------------------------------------------------------------------
// Allocates from sysZone and zeroes a block of length nWords.
[
let block = SysAllocate(nWords)
Zero(block, nWords)
resultis block
]
//----------------------------------------------------------------------------
and FreePointer(lvPointer, nil, nil, nil, nil; numargs na) be
//----------------------------------------------------------------------------
// Takes a list of up to 5 pointers to cells containing pointers to
// allocated storage blocks. For any nonzero cell, frees the
// storage block and zeroes the cell.
[
for i = 0 to na-1 do
[
let lvP = (lv lvPointer)!i
if @lvP ne 0 then
[ SysFree(@lvP); @lvP = 0 ]
]
]
//----------------------------------------------------------------------------
and IFSIdle() be
//----------------------------------------------------------------------------
// The Idle() procedure called while TFS is waiting for the disk
[
static lastRTC
if @realTimeClock ne lastRTC then // at once most per RTC tick
[
@cursorX = 20 + ((606-40-16)/nDrives)*KBLK>>KBLK.drive
@cursorY = (KBLK>>KBLK.track ls 0? 0,
20+MulDiv(808-40-16, KBLK>>KBLK.track, 815))
lastRTC = @realTimeClock
]
Block()
]