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