<> <> <> <<>> <> <> <> <> <> <> <> DIRECTORY AlpineEnvironment, AlpineInternal, Basics, BasicTime, FileLock, Lock, LockControl, LockInternal, Process, SafeStorage, TransactionMap; LockCoreImpl: MONITOR <> IMPORTS Basics, BasicTime, FileLock, Process, SafeStorage, TransactionMap, LockInternal EXPORTS AlpineInternal, Lock, LockControl, LockInternal = BEGIN LockID: TYPE = Lock.LockID; nullLockID: LockID = Lock.nullLockID; LockMode: TYPE = Lock.LockMode; CacheModes: TYPE = LockMode [cache .. intendCache]; ModeReleasableSet: TYPE = Lock.ModeReleasableSet; Handle: TYPE = LockInternal.Handle; Object: TYPE = LockInternal.Object; HeaderHandle: TYPE = LockInternal.HeaderHandle; RequestHandle: TYPE = LockInternal.RequestHandle; GrantedRequestHandle: TYPE = LockInternal.GrantedRequestHandle; WaitingRequestHandle: TYPE = LockInternal.WaitingRequestHandle; LockTransHeaderHandle: TYPE = LockInternal.LockTransHeaderHandle; LockTransHeaderObject: PUBLIC TYPE = LockInternal.Object.request.transHeader; <> Failed: PUBLIC ERROR [why: AlpineEnvironment.LockFailure] = CODE; <> Error: PUBLIC ERROR [Lock.ErrorType] = CODE; <> TransAborting: PUBLIC ERROR = CODE; <> Compat: PUBLIC ARRAY LockMode OF PACKED ARRAY LockMode OF BOOL _ [ <> none: [none: TRUE, read: TRUE, update: TRUE, write: TRUE, readIntendUpdate: TRUE, readIntendWrite: TRUE, intendRead: TRUE, intendUpdate: TRUE, intendWrite: TRUE, cache: TRUE, intendCache: TRUE], read: [none: TRUE, read: TRUE, update: TRUE, write: FALSE, readIntendUpdate: TRUE, readIntendWrite: FALSE, intendRead: TRUE, intendUpdate: TRUE, intendWrite: FALSE, cache: TRUE, intendCache: TRUE], update: [none: TRUE, read: TRUE, update: FALSE, write: FALSE, readIntendUpdate: FALSE, readIntendWrite: FALSE, intendRead: TRUE, intendUpdate: FALSE, intendWrite: FALSE, cache: TRUE, intendCache: TRUE], write: [none: TRUE, read: FALSE, update: FALSE, write: FALSE, readIntendUpdate: FALSE, readIntendWrite: FALSE, intendRead: FALSE, intendUpdate: FALSE, intendWrite: FALSE, cache: FALSE, intendCache: FALSE], readIntendUpdate: [none: TRUE, read: TRUE, update: FALSE, write: FALSE, readIntendUpdate: FALSE, readIntendWrite: FALSE, intendRead: TRUE, intendUpdate: TRUE, intendWrite: FALSE, cache: TRUE, intendCache: TRUE], readIntendWrite: [none: TRUE, read: FALSE, update: FALSE, write: FALSE, readIntendUpdate: FALSE, readIntendWrite: FALSE, intendRead: TRUE, intendUpdate: TRUE, intendWrite: FALSE, cache: FALSE, intendCache: TRUE], intendRead: [none: TRUE, read: TRUE, update: TRUE, write: FALSE, readIntendUpdate: TRUE, readIntendWrite: TRUE, intendRead: TRUE, intendUpdate: TRUE, intendWrite: TRUE, cache: FALSE, intendCache: TRUE], intendUpdate: [none: TRUE, read: TRUE, update: FALSE, write: FALSE, readIntendUpdate: TRUE, readIntendWrite: TRUE, intendRead: TRUE, intendUpdate: TRUE, intendWrite: TRUE, cache: TRUE, intendCache: TRUE], intendWrite: [none: TRUE, read: FALSE, update: FALSE, write: FALSE, readIntendUpdate: FALSE, readIntendWrite: FALSE, intendRead: TRUE, intendUpdate: TRUE, intendWrite: TRUE, cache: FALSE, intendCache: TRUE], cache: [none: TRUE, read: TRUE, update: TRUE, write: FALSE, readIntendUpdate: TRUE, readIntendWrite: FALSE, intendRead: TRUE, intendUpdate: TRUE, intendWrite: FALSE, cache: TRUE, intendCache: TRUE], intendCache: [none: TRUE, read: TRUE, update: TRUE, write: FALSE, readIntendUpdate: TRUE, readIntendWrite: FALSE, intendRead: TRUE, intendUpdate: TRUE, intendWrite: FALSE, cache: TRUE, intendCache: TRUE]]; Sup: PUBLIC ARRAY LockMode OF PACKED ARRAY LockMode OF LockMode _ [ <> none: [none: none, read: read, update: update, write: write, readIntendUpdate: readIntendUpdate, readIntendWrite: readIntendWrite, intendRead: intendRead, intendUpdate: intendUpdate, intendWrite: intendWrite, cache: cache, intendCache: intendCache], read: [none: read, read: read, update: update, write: write, readIntendUpdate: readIntendUpdate, readIntendWrite: readIntendWrite, intendRead: read, intendUpdate: readIntendUpdate, intendWrite: readIntendWrite, cache: read, intendCache: read], update: [none: update, read: update, update: update, write: write, readIntendUpdate: update, readIntendWrite: update, intendRead: update, intendUpdate: update, intendWrite: update, cache: update, intendCache: update], write: [none: write, read: write, update: write, write: write, readIntendUpdate: write, readIntendWrite: write, intendRead: write, intendUpdate: write, intendWrite: write, cache: write, intendCache: write], readIntendUpdate: [none: readIntendUpdate, read: readIntendUpdate, update: update, write: write, readIntendUpdate: readIntendUpdate, readIntendWrite: readIntendWrite, intendRead: readIntendUpdate, intendUpdate: readIntendUpdate, intendWrite: readIntendWrite, cache: readIntendUpdate, intendCache: readIntendUpdate], readIntendWrite: [none: readIntendWrite, read: readIntendWrite, update: update, write: write, readIntendUpdate: readIntendWrite, readIntendWrite: readIntendWrite, intendRead: readIntendWrite, intendUpdate: readIntendWrite, intendWrite: readIntendWrite, cache: readIntendWrite, intendCache: readIntendWrite], intendRead: [none: intendRead, read: read, update: update, write: write, readIntendUpdate: readIntendUpdate, readIntendWrite: readIntendWrite, intendRead: intendRead, intendUpdate: intendUpdate, intendWrite: intendWrite, cache: intendRead, intendCache: intendRead], intendUpdate: [none: intendUpdate, read: readIntendUpdate, update: update, write: write, readIntendUpdate: readIntendUpdate, readIntendWrite: readIntendWrite, intendRead: intendUpdate, intendUpdate: intendUpdate, intendWrite: intendWrite, cache: intendUpdate, intendCache: intendUpdate], intendWrite: [none: intendWrite, read: readIntendWrite, update: update, write: write, readIntendUpdate: readIntendWrite, readIntendWrite: readIntendWrite, intendRead: intendWrite, intendUpdate: intendWrite, intendWrite: intendWrite, cache: intendWrite, intendCache: intendWrite], cache: [none: cache, read: read, update: update, write: write, readIntendUpdate: readIntendUpdate, readIntendWrite: readIntendWrite, intendRead: read, intendUpdate: update, intendWrite: write, cache: cache, intendCache: cache], intendCache: [none: intendCache, read: read, update: update, write: write, readIntendUpdate: readIntendUpdate, readIntendWrite: readIntendWrite, intendRead: intendRead, intendUpdate: intendUpdate, intendWrite: intendWrite, cache: cache, intendCache: intendCache]]; retainedCacheMode: PACKED ARRAY LockMode OF LockMode _ [ none: none, read: cache, update: cache, write: cache, readIntendUpdate: cache, readIntendWrite: cache, intendRead: intendCache, intendUpdate: intendCache, intendWrite: intendCache, cache: cache, intendCache: intendCache ];  z: ZONE; <> lookupAndInsertHandle: HeaderHandle; <> nLocks, nRequests, nSetCalls, nSetCallsWaited: INT; <> <<>> nullTransID: AlpineEnvironment.TransID = AlpineEnvironment.nullTransID; Set: PUBLIC ENTRY PROC [ trans: AlpineInternal.TransHandle, lock: LockID, mode: LockMode, wait: BOOL, cacheTrans: AlpineEnvironment.TransID _ nullTransID] RETURNS [resultMode: LockMode] = { <> h: HeaderHandle; <> wr: WaitingRequestHandle _ NIL; <> thisTransGrantedRequest, cacheTransGrantedRequest: GrantedRequestHandle; <> useMode: LockMode; BreakCacheLocks: INTERNAL PROC [newlyGrantedRequest: GrantedRequestHandle] ~ { <> header: HeaderHandle; FOR h: Handle _ newlyGrantedRequest.requestList, h.requestList UNTIL h = newlyGrantedRequest DO WITH h SELECT FROM rh: RequestHandle => WITH rh SELECT FROM grh: GrantedRequestHandle => { trans: AlpineInternal.TransHandle _ grh.trans; IF (grh.mode IN CacheModes) AND (NOT Compat[newlyGrantedRequest.mode][grh.mode]) THEN { UnlinkFromTrans[trans, grh]; RemoveFromRequestList[grh]; }; }; ENDCASE; hh: HeaderHandle => header _ hh; ENDCASE; ENDLOOP; DemoteWaitingRequests[header, trans]; }; { -- EXITS CreateGrantedRequest, ConvertExistingRequest nSetCalls _ nSetCalls + 1; lookupAndInsertHandle.lockID _ lock; IF (h _ LookupAndInsert[lookupAndInsertHandle]) = lookupAndInsertHandle THEN { <> lookupAndInsertHandle _ z.NEW[Object.header _ [body: header []]]; lookupAndInsertHandle.requestList _ lookupAndInsertHandle; nLocks _ nLocks + 1; GOTO CreateGrantedRequest; }; <> <<(a) if the request is a conversion, the loop is traveled first with the requested mode, then again with the supremum of the current and requested modes.>> <<(b) if the request cannot be granted without waiting, the loop is traveled by the request as it attempts to acquire the lock. Only the first waiting request for a given LockID may acquire the lock, and usually this is the only request that wakes up when something interesting changes, but a request may travel the loop only to find that it is not first in line (and go right back to sleep) under some conditions.>> useMode _ mode; DO { -- EXITS Conflict, TryConversionMode { -- EXITS NoWaitingRequests, WaitingRequests <> <> <> thisTransGrantedRequest _ NIL; cacheTransGrantedRequest _ NIL; FOR r: Handle _ h.requestList, r.requestList DO WITH r SELECT FROM hh: HeaderHandle => GOTO NoWaitingRequests; rh: RequestHandle => WITH rh SELECT FROM grh: GrantedRequestHandle => { IF TransactionMap.GetTransID[grh.trans] = cacheTrans THEN cacheTransGrantedRequest _ grh; IF grh.trans = trans THEN thisTransGrantedRequest _ grh ELSE IF (NOT Compat[useMode][grh.mode]) AND (NOT grh.mode IN CacheModes) THEN GOTO CannotGrant; }; wrh: WaitingRequestHandle => { IF wr # NIL AND wr # wrh THEN GOTO CannotGrant; <> GOTO WaitingRequests; <> }; th: LockTransHeaderHandle => ERROR; ENDCASE; ENDCASE; ENDLOOP; EXITS NoWaitingRequests => { IF thisTransGrantedRequest = NIL THEN GOTO CreateGrantedRequest; IF Sup[mode][thisTransGrantedRequest.mode] = useMode THEN GOTO ConvertExistingRequest; GOTO TryConversionMode; }; WaitingRequests => { IF thisTransGrantedRequest # NIL AND Sup[mode][thisTransGrantedRequest.mode] # useMode THEN GOTO TryConversionMode; <> IF wr # NIL THEN { UnregisterWaitingRequest[wr]; RemoveFromRequestList[r: wr, deleteHeaderIfNoRequests: FALSE]; nRequests _ nRequests - 1; }; IF thisTransGrantedRequest # NIL THEN GOTO ConvertExistingRequest; PromoteWaitingRequests[h, trans]; GOTO CreateGrantedRequest; }; };-- EXITS NoWaitingRequests, WaitingRequests EXITS CannotGrant => { <> IF NOT wait THEN RETURN WITH ERROR Failed [conflict]; IF (cacheTrans#nullTransID) AND (cacheTransGrantedRequest=NIL) THEN RETURN WITH ERROR Failed [cantConvert]; IF wr = NIL THEN { <> wr _ RegisterWaitingRequest[trans, lock, mode]; EnterWaitingInRequestList[h, wr]; nRequests _ nRequests + 1; nSetCallsWaited _ nSetCallsWaited + 1; }; WAIT wr.somethingChanged; IF wr.giveUp THEN { UnregisterWaitingRequest[wr]; RemoveFromRequestList[wr]; SELECT wr.whyGivingUp FROM abort => RETURN WITH ERROR TransAborting; timeout => RETURN WITH ERROR Failed [timeout]; ENDCASE => ERROR; }; useMode _ mode; }; TryConversionMode => { <> useMode _ Sup[mode][thisTransGrantedRequest.mode]; }; };-- EXITS Conflict, TryConversionMode ENDLOOP; EXITS <> CreateGrantedRequest => { IF (cacheTrans#nullTransID) AND (cacheTransGrantedRequest=NIL) THEN RETURN WITH ERROR Failed[cantConvert]; { t: LockTransHeaderHandle = TransactionMap.GetLockHeader[trans]; r: GrantedRequestHandle _ z.NEW[Object.request.granted _ [ requestList: h.requestList, body: request [ trans: trans, transList: t.transList, lockID: lock, mode: mode, rest: granted [count: 1]]]]; h.requestList _ r; t.transList _ r; t.nLocks _ t.nLocks + 1; nRequests _ nRequests + 1; BreakCacheLocks[r]; RETURN [mode]; }; }; ConvertExistingRequest => { thisTransGrantedRequest.mode _ useMode; thisTransGrantedRequest.count _ thisTransGrantedRequest.count + 1; BreakCacheLocks[thisTransGrantedRequest]; RETURN [useMode]; }; };-- EXITS CreateGrantedRequest, ConvertExistingRequest };--Set  Release: PUBLIC ENTRY PROC [trans: AlpineInternal.TransHandle, lock: LockID, releasable: ModeReleasableSet, retainCacheLock: BOOLEAN _ FALSE] RETURNS [LockMode] = { <> h: HeaderHandle; IF (h _ Lookup[lock]) = NIL THEN RETURN WITH ERROR Error [unknown]; FOR r: Handle _ h.requestList, r.requestList DO WITH r SELECT FROM hh: HeaderHandle => RETURN WITH ERROR Error [unknown]; rh: RequestHandle => WITH rh SELECT FROM grh: GrantedRequestHandle => IF grh.trans = trans THEN { IF releasable[grh.mode] = no THEN RETURN WITH ERROR Error [lockUnreleasable]; IF (grh.count _ grh.count - 1) = 0 THEN { IF retainCacheLock THEN { grh.count _ 1; grh.mode _ retainedCacheMode[grh.mode]; RETURN[grh.mode]; } ELSE { UnlinkFromTrans[trans, grh]; RemoveFromRequestList[grh]; DemoteWaitingRequests[h, trans]; RETURN [none]; }; } ELSE RETURN [grh.mode]; }; wrh: WaitingRequestHandle => RETURN WITH ERROR Error [unknown]; th: LockTransHeaderHandle => ERROR; ENDCASE; ENDCASE; ENDLOOP; }; ReleaseFileLocks: PUBLIC ENTRY PROC [trans: AlpineInternal.TransHandle, prototype: LockID, releasable: ModeReleasableSet, retainCacheLocks: BOOLEAN _ FALSE] = { <> transHeader: LockTransHeaderHandle = TransactionMap.GetLockHeader[trans]; rNext: RequestHandle; FOR rh: RequestHandle _ transHeader.transList, rNext DO rNext _ rh.transList; WITH rh SELECT FROM grh: GrantedRequestHandle => IF releasable[grh.mode] = yes THEN { handleLockID: LockID _ LockInternal.LockIDFromRH[ grh ]; IF handleLockID.entity = prototype.entity AND handleLockID.subEntity = prototype.subEntity THEN { IF retainCacheLocks THEN { grh.count _ 1; grh.mode _ retainedCacheMode[grh.mode]; } ELSE { UnlinkFromTrans[trans, grh]; RemoveFromRequestList[grh]; }; }; }; wrh: WaitingRequestHandle => ERROR; th: LockTransHeaderHandle => RETURN; ENDCASE; ENDLOOP; }; RemoveFromRequestList: INTERNAL PROC [ r: RequestHandle, deleteHeaderIfNoRequests: BOOL _ TRUE] = { <> <> rPred: Handle; notifyDone: BOOL _ FALSE; FOR rPred _ r.requestList, rPred.requestList UNTIL rPred.requestList = r DO WITH rPred SELECT FROM wrh: WaitingRequestHandle => IF NOT notifyDone THEN { NOTIFY wrh.somethingChanged; notifyDone _ TRUE; }; ENDCASE; ENDLOOP; IF rPred = r.requestList AND deleteHeaderIfNoRequests THEN { rPred.requestList _ NIL; Delete[NARROW[rPred]]; nLocks _ nLocks - 1; } ELSE { rPred.requestList _ r.requestList; }; r.requestList _ NIL; nRequests _ nRequests - 1; }; Initialize: PUBLIC ENTRY PROC [lockZoneInitialSize: INT, hashArraySize: NAT] = { <> z _ SafeStorage.GetSystemZone[]; InitWaitingRequestList[]; InitializeHashTable[ numHashSlotsDesired: hashArraySize, hashTableZone: z, hashHandle: z.NEW[Object.header _ [body: header []]]]; lookupAndInsertHandle _ z.NEW[Object.header _ [body: header []]]; lookupAndInsertHandle.requestList _ lookupAndInsertHandle; nLocks _ 0; nRequests _ 0; nSetCalls _ 0; nSetCallsWaited _ 0; };  <> <> EnterWaitingInRequestList: INTERNAL PROC [ h: HeaderHandle, wr: WaitingRequestHandle] = { <> <> r: Handle; FOR r _ h, r.requestList UNTIL r.requestList = h DO ENDLOOP; r.requestList _ wr; wr.requestList _ h; }; PromoteWaitingRequests: INTERNAL PROC [ h: HeaderHandle, trans: AlpineInternal.TransHandle] = { <> <> }; DemoteWaitingRequests: INTERNAL PROC [ h: HeaderHandle, trans: AlpineInternal.TransHandle] = { <> <> };  <> ConsTransHeader: PUBLIC PROC [trans: AlpineInternal.TransHandle] RETURNS [lockHeader: LockTransHeaderHandle] = { <> lockHeader _ z.NEW[Object.request.transHeader _ [body: request [ trans: trans, transList: NIL, mode: none, rest: transHeader [nLocks: 0]]]]; lockHeader.transList _ lockHeader; RETURN [lockHeader]; }; UpgradeLocks: PUBLIC PROC [trans: AlpineInternal.TransHandle] = { <> <> <> ugh: LockTransHeaderHandle = TransactionMap.GetLockHeader[trans]; r: RequestHandle _ ugh; lockID: LockID; DO [r, lockID] _ GetNextInTransNeedingUpgrade[r]; IF r = NIL THEN RETURN; [] _ Set[trans, lockID, Upgrade[r.mode], TRUE]; ENDLOOP; }; GetNextInTransNeedingUpgrade: ENTRY PROC [r: RequestHandle] RETURNS [next: RequestHandle, nextLockID: LockID] = { <> FOR next _ r.transList, next.transList DO IF ISTYPE[next, LockTransHeaderHandle] THEN RETURN [NIL, nullLockID]; IF NeedsUpgrade[next.mode] THEN EXIT; ENDLOOP; <> FOR h: Handle _ next.requestList, h.requestList DO WITH h SELECT FROM hh: HeaderHandle => RETURN [next, hh.lockID]; ENDCASE; ENDLOOP; }; <> Upgrade: ARRAY LockMode OF LockMode _ [ none: none, read: read, update: write, write: write, readIntendUpdate: readIntendWrite, readIntendWrite: readIntendWrite, intendRead: intendRead, intendUpdate: intendWrite, intendWrite: intendWrite, cache: cache, intendCache: intendCache]; NeedsUpgrade: ARRAY LockMode OF BOOL _ [ none: FALSE, read: FALSE, update: TRUE, write: FALSE, readIntendUpdate: TRUE, readIntendWrite: FALSE, intendRead: FALSE, intendUpdate: TRUE, intendWrite: FALSE, cache: FALSE, intendCache: FALSE]; <<>> <> Downgrade: ARRAY LockMode OF LockMode _ [ none: none, read: read, update: read, write: read, readIntendUpdate: read, readIntendWrite: read, intendRead: intendRead, intendUpdate: intendRead, intendWrite: intendRead, cache: cache, intendCache: intendCache]; ReleaseLocks: PUBLIC ENTRY PROC [trans: AlpineInternal.TransHandle] = { <> transHeader: LockTransHeaderHandle = TransactionMap.GetLockHeader[trans]; rNext: RequestHandle; FOR r: RequestHandle _ transHeader.transList, rNext DO rNext _ r.transList; r.transList _ NIL; WITH r SELECT FROM gr: GrantedRequestHandle => { IF gr.mode NOT IN CacheModes THEN { RemoveFromRequestList[gr]; r.trans _ NIL; }; }; wr: WaitingRequestHandle => ERROR; th: LockTransHeaderHandle => { r.trans _ NIL; RETURN; }; ENDCASE; ENDLOOP; }; UnlinkFromTrans: INTERNAL PROC [ trans: AlpineInternal.TransHandle, gr: GrantedRequestHandle] = { <> transHeader: LockTransHeaderHandle = TransactionMap.GetLockHeader[trans]; rPred: RequestHandle; FOR rPred _ transHeader, rPred.transList UNTIL rPred.transList = gr DO ENDLOOP; rPred.transList _ gr.transList; gr.transList _ NIL; gr.trans _ NIL; transHeader.nLocks _ transHeader.nLocks - 1; }; TransferLocks: PUBLIC ENTRY PROC [from, to: AlpineInternal.TransHandle] = { <> transHeader: LockTransHeaderHandle = TransactionMap.GetLockHeader[from]; FOR r: RequestHandle _ transHeader.transList, r.transList DO r.trans _ to; IF NOT (FileLock.IsWholeFileLock[r.lockID] AND (r.mode=write OR r.mode=update)) THEN r.mode _ Downgrade[r.mode]; IF r = transHeader THEN RETURN; ENDLOOP; };  <> waitingRequestList: WaitingRequestHandle; <> <> <> InitWaitingRequestList: INTERNAL PROC [] = { waitingRequestList _ z.NEW[Object.request.waiting _ [body: request [ trans: NIL, transList: NIL, mode: none, rest: waiting [startTime: BasicTime.earliestGMT]]]]; }; RegisterWaitingRequest: INTERNAL PROC [ trans: AlpineInternal.TransHandle, lockID: LockID, mode: LockMode] RETURNS [wr: WaitingRequestHandle] = { wr _ z.NEW[Object.request.waiting _ [ requestList: NIL, body: request [ trans: trans, transList: waitingRequestList.transList, lockID: lockID, mode: mode, rest: waiting [ startTime: BasicTime.Now[]]]]]; waitingRequestList.transList _ wr; Process.DisableTimeout[@wr.somethingChanged]; }; UnregisterWaitingRequest: INTERNAL PROC [wr: WaitingRequestHandle] = { r: RequestHandle; FOR r _ waitingRequestList, r.transList UNTIL r.transList = wr DO ENDLOOP; r.transList _ wr.transList; wr.transList _ NIL; wr.trans _ NIL; }; AbortWaitingRequests: PUBLIC ENTRY PROC [trans: AlpineInternal.TransHandle] = { <> FOR r: RequestHandle _ waitingRequestList.transList, r.transList UNTIL r = NIL DO IF r.trans = trans THEN WITH r SELECT FROM wr: WaitingRequestHandle => { wr.giveUp _ TRUE; wr.whyGivingUp _ abort; NOTIFY wr.somethingChanged; }; ENDCASE => ERROR; ENDLOOP; }; TimeoutWaitingRequest: PUBLIC ENTRY PROC [wr: WaitingRequestHandle] = { <> wr.giveUp _ TRUE; wr.whyGivingUp _ timeout; NOTIFY wr.somethingChanged; }; EnumerateWaitingRequests: INTERNAL PROC [ proc: PROC [wr: WaitingRequestHandle] RETURNS [stop: BOOL]] = { FOR r: RequestHandle _ waitingRequestList.transList, r.transList UNTIL r = NIL DO IF proc[NARROW[r]].stop THEN RETURN; ENDLOOP; };  GetInfo: PUBLIC ENTRY PROC [ generalInfoProc: LockInternal.GeneralInfoProc, lockEnumProc: LockInternal.LockEnumProc, waitingRequestEnumProc: LockInternal.WaitingRequestEnumProc, waitingRequestEnumProc2: LockInternal.WaitingRequestEnumProc] = { IF generalInfoProc # NIL THEN generalInfoProc[nLocks, nRequests, nSetCalls, nSetCallsWaited]; IF lockEnumProc # NIL THEN EnumerateWithProc[lockEnumProc]; IF waitingRequestEnumProc # NIL THEN EnumerateWaitingRequests[waitingRequestEnumProc]; IF waitingRequestEnumProc2 # NIL THEN EnumerateWaitingRequests[waitingRequestEnumProc2]; };  <> HashHandle: TYPE = HeaderHandle; Key: TYPE = LockID; PrimeTable: ARRAY PrimeTableIndex OF NAT _ [37, 67, 131, 257, 513, 1031, 2003]; PrimeTableIndex: TYPE = [0 .. 6]; ClientHashInit: PROC [numHashSlotsDesired: NAT] RETURNS [numHashSlotsAllowed: NAT] = { FOR i: PrimeTableIndex IN PrimeTableIndex DO IF PrimeTable[i] >= numHashSlotsDesired THEN RETURN [PrimeTable[i]]; ENDLOOP; RETURN [PrimeTable[PrimeTableIndex.LAST]]; }; ClientHash: INTERNAL PROC [hashHandle: HashHandle] RETURNS [NAT--[0..numHashSlots)--] = INLINE { ID10: TYPE = RECORD [a, b, c, d, e, f, g, h, i, j: WORD]; RETURN [Basics.BITXOR[ Basics.BITXOR[ LOOPHOLE[hashHandle.lockID, ID10].d, LOOPHOLE[hashHandle.lockID, ID10].f], Basics.BITXOR[ LOOPHOLE[hashHandle.lockID, ID10].g, LOOPHOLE[hashHandle.lockID, ID10].i]] MOD numHashSlots]; }; ClientEqualKeys: INTERNAL PROC [hashHandle1, hashHandle2: HashHandle] RETURNS [equal: BOOL] = INLINE { <> <> ID5: TYPE = RECORD [a, b, c, d, e: LONG CARDINAL]; RETURN [ LOOPHOLE[hashHandle1.lockID, ID5].b = LOOPHOLE[hashHandle2.lockID, ID5].b AND LOOPHOLE[hashHandle1.lockID, ID5].d = LOOPHOLE[hashHandle2.lockID, ID5].d AND LOOPHOLE[hashHandle1.lockID, ID5].c = LOOPHOLE[hashHandle2.lockID, ID5].c AND LOOPHOLE[hashHandle1.lockID, ID5].e = LOOPHOLE[hashHandle2.lockID, ID5].e AND LOOPHOLE[hashHandle1.lockID, ID5].a = LOOPHOLE[hashHandle2.lockID, ID5].a]; }; ClientSetKey: INTERNAL PROC [hashHandle: HashHandle, key: Key] = INLINE { hashHandle.lockID _ key; }; <> LookupAndInsert: INTERNAL PROC [hashHandle: HashHandle] RETURNS [HashHandle] = INLINE { index: NAT _ ClientHash[hashHandle]; FOR newHashHandle: HashHandle _ hashSlots[index], newHashHandle.next UNTIL newHashHandle = NIL DO IF ClientEqualKeys[newHashHandle, hashHandle] THEN RETURN [newHashHandle]; ENDLOOP; hashHandle.next _ hashSlots[index]; hashSlots[index] _ hashHandle; RETURN [hashHandle]; }; <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <<[hashHandle: HashHandle];>> <> <> <> <> <> <> <> hashSlots: REF HashSlots _ NIL; HashSlots: TYPE = RECORD[SEQUENCE nSlots: NAT OF HashHandle]; numHashSlots: NAT _ 0; -- boy, will they be sorry if they don't init this package. lookupHashHandle: HashHandle _ NIL; -- for the "package's" use only. <> HashPkgCallerProgrammingError: ERROR = CODE; -- various fatal conditions. HashPkgDuplicateKey: ERROR = CODE; -- from Insert. InitializeHashTable: INTERNAL PROCEDURE[numHashSlotsDesired: NAT, hashTableZone: ZONE, hashHandle: HashHandle] = BEGIN -- errors: HashPkgCallerProgrammingError (numHashSlotsDesired = 0). numHashSlots _ ClientHashInit[numHashSlotsDesired]; IF numHashSlots = 0 THEN ERROR HashPkgCallerProgrammingError; lookupHashHandle _ hashHandle; hashSlots _ hashTableZone.NEW[HashSlots[numHashSlots]]; FOR index: NAT IN [0..numHashSlots) DO hashSlots[index] _ NIL; ENDLOOP; END; Insert: INTERNAL PROCEDURE[hashHandle: HashHandle] = INLINE BEGIN -- errors: HashPkgDuplicateKey. index: NAT _ ClientHash[hashHandle]; FOR newHashHandle: HashHandle _ hashSlots[index], newHashHandle.next UNTIL newHashHandle = NIL DO IF ClientEqualKeys[newHashHandle, hashHandle] THEN ERROR HashPkgDuplicateKey; ENDLOOP; hashHandle.next _ hashSlots[index]; hashSlots[index] _ hashHandle; END; Lookup: INTERNAL PROCEDURE[key: Key] RETURNS [hashHandle: HashHandle] = INLINE BEGIN -- returns hashHandle = NIL if not found. ClientSetKey[lookupHashHandle, key]; FOR hashHandle _ hashSlots[ClientHash[lookupHashHandle]], hashHandle.next UNTIL hashHandle = NIL DO IF ClientEqualKeys[hashHandle, lookupHashHandle] THEN RETURN; ENDLOOP; RETURN[NIL]; END; Delete: INTERNAL PROCEDURE[hashHandle: HashHandle] = INLINE BEGIN -- errors: HashPkgCallerProgrammingError (not found). index: NAT _ ClientHash[hashHandle]; prevHashHandle: HashHandle _ NIL; FOR newHashHandle: HashHandle _ hashSlots[index], newHashHandle.next UNTIL newHashHandle = NIL DO IF ClientEqualKeys[newHashHandle, hashHandle] THEN EXIT; prevHashHandle _ newHashHandle; REPEAT FINISHED => ERROR HashPkgCallerProgrammingError; ENDLOOP; IF prevHashHandle = NIL THEN hashSlots[index] _ hashHandle.next ELSE prevHashHandle.next _ hashHandle.next; hashHandle.next _ NIL; END; <> EnumerateNext: INTERNAL PROCEDURE[prevHashHandle: HashHandle] RETURNS [hashHandle: HashHandle] = BEGIN -- errors: none. index: NAT; IF prevHashHandle = NIL THEN index _ 0 ELSE BEGIN index _ ClientHash[prevHashHandle]; FOR hashHandle _ hashSlots[index], hashHandle.next UNTIL hashHandle = NIL DO IF ClientEqualKeys[hashHandle, prevHashHandle] THEN GOTO found; REPEAT found => BEGIN IF hashHandle.next # NIL THEN RETURN[hashHandle.next]; index _ index + 1; END; ENDLOOP; END; UNTIL index >= numHashSlots DO IF hashSlots[index] # NIL THEN RETURN[hashSlots[index]]; index _ index + 1; ENDLOOP; RETURN[NIL]; END; EnumerateWithProc: INTERNAL PROCEDURE[proc: PROCEDURE[hashHandle: HashHandle] RETURNS[stop: BOOLEAN]] = BEGIN -- errors: none. FOR index: NAT IN [0..numHashSlots) DO FOR hashHandle: HashHandle _ hashSlots[index], hashHandle.next UNTIL hashHandle = NIL DO IF proc[hashHandle] THEN RETURN; ENDLOOP; ENDLOOP; END; <> END.--LockCoreImpl CHANGE LOG Changed by MBrown on February 8, 1983 5:47 pm <> Changed by MBrown on February 9, 1983 4:16 pm <> <> <> <<>> <> <> <<>>