LockCoreImpl.mesa
Copyright © 1984 by Xerox Corporation. All rights reserved.
Carl Hauser, January 25, 1986 12:25:39 pm PST
Last edited by
MBrown on January 31, 1984 10:04:32 am PST
Last Edited by: Kupfer, July 23, 1984 11:16:49 am PDT
NOTES
Lock.Set has a long argument record. It also calls TransactionMap.GetLockHeader, which can be avoided at the cost of being compilation dependent upon Worker (as LogImpl is).
Revise the ClientEqualKeys proc after conversion to Trinity instruction set.
Implement a better scheduling algorithm for waiting requests.
DIRECTORY
AlpineEnvironment,
AlpineInternal,
Basics,
BasicTime,
FileLock,
Lock,
LockControl,
LockInternal,
Process,
SafeStorage,
TransactionMap;
LockCoreImpl: MONITOR
Do not call out of this monitor into any other Alpine 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;
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;
AlpineInternal.LockTransHeaderObject
Failed: PUBLIC ERROR [why: AlpineEnvironment.LockFailure] = CODE;
Lock.Failed
Error: PUBLIC ERROR [Lock.ErrorType] = CODE;
Lock.Error
TransAborting: PUBLIC ERROR = CODE;
Lock.TransAborting
Compat: PUBLIC ARRAY LockMode OF PACKED ARRAY LockMode OF BOOL ← [
Lock.Compat
none: [none: TRUE, read: TRUE, update: TRUE, write: TRUE,
readIntendUpdate: TRUE, readIntendWrite: TRUE,
intendRead: TRUE, intendUpdate: TRUE, intendWrite: TRUE],
read: [none: TRUE, read: TRUE, update: TRUE, write: FALSE,
readIntendUpdate: TRUE, readIntendWrite: FALSE,
intendRead: TRUE, intendUpdate: TRUE, intendWrite: FALSE],
update: [none: TRUE, read: TRUE, update: FALSE, write: FALSE,
readIntendUpdate: FALSE, readIntendWrite: FALSE,
intendRead: TRUE, intendUpdate: FALSE, intendWrite: FALSE],
write: [none: TRUE, read: FALSE, update: FALSE, write: FALSE,
readIntendUpdate: FALSE, readIntendWrite: FALSE,
intendRead: FALSE, intendUpdate: FALSE, intendWrite: FALSE],
readIntendUpdate: [none: TRUE, read: TRUE, update: FALSE, write: FALSE,
readIntendUpdate: FALSE, readIntendWrite: FALSE,
intendRead: TRUE, intendUpdate: TRUE, intendWrite: FALSE],
readIntendWrite: [none: TRUE, read: FALSE, update: FALSE, write: FALSE,
readIntendUpdate: FALSE, readIntendWrite: FALSE,
intendRead: TRUE, intendUpdate: TRUE, intendWrite: FALSE],
intendRead: [none: TRUE, read: TRUE, update: TRUE, write: FALSE,
readIntendUpdate: TRUE, readIntendWrite: TRUE,
intendRead: TRUE, intendUpdate: TRUE, intendWrite: TRUE],
intendUpdate: [none: TRUE, read: TRUE, update: FALSE, write: FALSE,
readIntendUpdate: TRUE, readIntendWrite: TRUE,
intendRead: TRUE, intendUpdate: TRUE, intendWrite: TRUE],
intendWrite: [none: TRUE, read: FALSE, update: FALSE, write: FALSE,
readIntendUpdate: FALSE, readIntendWrite: FALSE,
intendRead: TRUE, intendUpdate: TRUE, intendWrite: TRUE]];
Sup: PUBLIC ARRAY LockMode OF PACKED ARRAY LockMode OF LockMode ← [
Lock.Sup
none: [none: none, read: read, update: update, write: write,
readIntendUpdate: readIntendUpdate, readIntendWrite: readIntendWrite,
intendRead: intendRead, intendUpdate: intendUpdate, intendWrite: intendWrite],
read: [none: read, read: read, update: update, write: write,
readIntendUpdate: readIntendUpdate, readIntendWrite: readIntendWrite,
intendRead: read, intendUpdate: readIntendUpdate, intendWrite: readIntendWrite],
update: [none: update, read: update, update: update, write: write,
readIntendUpdate: update, readIntendWrite: update,
intendRead: update, intendUpdate: update, intendWrite: update],
write: [none: write, read: write, update: write, write: write,
readIntendUpdate: write, readIntendWrite: write,
intendRead: write, intendUpdate: write, intendWrite: write],
readIntendUpdate: [none: readIntendUpdate,
read: readIntendUpdate, update: update, write: write,
readIntendUpdate: readIntendUpdate, readIntendWrite: readIntendWrite,
intendRead: readIntendUpdate, intendUpdate: readIntendUpdate,
intendWrite: readIntendWrite],
readIntendWrite: [none: readIntendWrite,
read: readIntendWrite, update: update, write: write,
readIntendUpdate: readIntendWrite, readIntendWrite: readIntendWrite,
intendRead: readIntendWrite, intendUpdate: readIntendWrite,
intendWrite: readIntendWrite],
intendRead: [none: intendRead, read: read, update: update, write: write,
readIntendUpdate: readIntendUpdate, readIntendWrite: readIntendWrite,
intendRead: intendRead, intendUpdate: intendUpdate, intendWrite: intendWrite],
intendUpdate: [
none: intendUpdate, read: readIntendUpdate, update: update, write: write,
readIntendUpdate: readIntendUpdate, readIntendWrite: readIntendWrite,
intendRead: intendUpdate, intendUpdate: intendUpdate, intendWrite: intendWrite],
intendWrite: [
none: intendWrite, read: readIntendWrite, update: update, write: write,
readIntendUpdate: readIntendWrite, readIntendWrite: readIntendWrite,
intendRead: intendWrite, intendUpdate: intendWrite, intendWrite: intendWrite]];
z: ZONE;
All lock data structures are allocated from this zone.
lookupAndInsertHandle: HeaderHandle;
Holds a free lock header for use in Set. Set may add this lock header to the lock data structure, in which case it replenishes this value by NEWing. This odd arrangement keeps the interface to the hash routines simple and yet avoids the overhead of two hash calls for the most common case.
nLocks, nRequests, nSetCalls, nSetCallsWaited: INT;
Instrumentation, available outside of the monitor through GetInfo.
Set: PUBLIC ENTRY PROC [
trans: AlpineInternal.TransHandle, lock: LockID, mode: LockMode, wait: BOOL]
RETURNS [resultMode: LockMode] = {
Lock.Set
h: HeaderHandle;
Holds lock header corresponding to LockID "lock". This is a constant during execution of this procedure, even if the procedure waits.
wr: WaitingRequestHandle ← NIL;
If this procedure waits, wr holds the record of the waiting request.
thisTransGrantedRequest: GrantedRequestHandle;
If this request is for a LockID already held in some mode by trans, thisTransGrantedRequest holds the existing granted request (reevaluated if the procedure waits).
useMode: LockMode;
{ -- EXITS CreateGrantedRequest, ConvertExistingRequest
nSetCalls ← nSetCalls + 1;
lookupAndInsertHandle.lockID ← lock;
IF (h ← LookupAndInsert[lookupAndInsertHandle]) = lookupAndInsertHandle THEN {
Request is for a lock not previously held by any transaction.
lookupAndInsertHandle ← z.NEW[Object.header ← [body: header []]];
lookupAndInsertHandle.requestList ← lookupAndInsertHandle;
nLocks ← nLocks + 1;
GOTO CreateGrantedRequest;
};
The main loop. This loop is traveled multiple times for two reasons:
(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
Is useMode compatible with all granted requests for other transactions?
Is the lock granted in some mode to this transaction?
Is there a first waiting request for this lock (and are we it)?
thisTransGrantedRequest ← 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 grh.trans = trans THEN thisTransGrantedRequest ← grh
ELSE IF NOT Compat[useMode][grh.mode] THEN GOTO CannotGrant;
};
wrh: WaitingRequestHandle => {
IF wr # NIL AND wr # wrh THEN GOTO CannotGrant;
This request is not first in line for this LockID, so go back to sleep.
GOTO WaitingRequests;
All granted requests have been examined.
};
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;
This request will be granted.
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 => {
This request cannot be granted now. Wait or fail.
IF NOT wait THEN RETURN WITH ERROR Failed [conflict];
IF wr = NIL THEN {
Create waiting request
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 => {
This request is a conversion. Retry with a stronger lock mode.
useMode ← Sup[mode][thisTransGrantedRequest.mode];
};
};-- EXITS Conflict, TryConversionMode
ENDLOOP;
EXITS
CreateGrantedRequest is outside of the loop to allow the loop to be bypassed when the request is for a LockID not previously held by any transaction.
CreateGrantedRequest => {
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;
RETURN [mode];
};
ConvertExistingRequest => {
thisTransGrantedRequest.mode ← useMode;
thisTransGrantedRequest.count ← thisTransGrantedRequest.count + 1;
RETURN [useMode];
};
};-- EXITS CreateGrantedRequest, ConvertExistingRequest
};--Set
Release: PUBLIC ENTRY PROC [trans: AlpineInternal.TransHandle, lock: LockID,
releasable: ModeReleasableSet] RETURNS [LockMode] = {
Lock.Release
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 {
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] = {
Lock.ReleaseFileLocks --
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 {
UnlinkFromTrans[trans, grh];
RemoveFromRequestList[grh];
};
};
wrh: WaitingRequestHandle => ERROR;
th: LockTransHeaderHandle => RETURN;
ENDCASE;
ENDLOOP;
};
RemoveFromRequestList: INTERNAL PROC [
r: RequestHandle, deleteHeaderIfNoRequests: BOOL ← TRUE] = {
NOTIFY the first waiting request, if any, following r. Then remove r from its requestList. If this leaves this requestList empty, delete the header.
Called from Set, Release, ReleaseLocks.
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] = {
LockControl.Initialize
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;
};
Scheduling policy for waiting requests.
The present scheduling algorithm for waiting requests is strict FIFO. However, by elaborating the procedures EnterWaitingInRequestList, PromoteWaitingRequests, and DemoteWaitingRequests it is possible to implement System R's scheduling strategy (e.g. priority for waiting conversion requests), as well as others.
EnterWaitingInRequestList: INTERNAL PROC [
h: HeaderHandle, wr: WaitingRequestHandle] = {
Link wr into h, by its requestList, where it belongs.
For now: link wr in at end of h's requestList.
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] = {
We are about to grant a lock to transaction trans. Promote any waiting requests for h from trans to be conversions.
For now: no-op.
};
DemoteWaitingRequests: INTERNAL PROC [
h: HeaderHandle, trans: AlpineInternal.TransHandle] = {
We are about to release a lock now held by transaction trans. Demote any waiting requests for h from trans to be non-conversions. If the identity of the first waiting request changes, NOTIFY the new first waiting request.
For now: no-op.
};
Transaction lock list (one per transaction)
ConsTransHeader: PUBLIC PROC [trans: AlpineInternal.TransHandle]
RETURNS [lockHeader: LockTransHeaderHandle] = {
LockControl.ConsTransHeader
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] = {
LockControl.UpgradeLocks
Note: Proc is EXTERNAL to monitor, so that it can call Set like a normal client.
This form of enumeration, and the unmonitored access to r.mode below, are ok because client will make no concurrent lock calls for this transaction.
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] = {
Find next granted request needing upgrade, return NIL if none.
FOR next ← r.transList, next.transList DO
IF ISTYPE[next, LockTransHeaderHandle] THEN RETURN [NIL, nullLockID];
IF NeedsUpgrade[next.mode] THEN EXIT;
ENDLOOP;
Find the LockID of this request, and return.
FOR h: Handle ← next.requestList, h.requestList DO
WITH h SELECT FROM
hh: HeaderHandle => RETURN [next, hh.lockID];
ENDCASE;
ENDLOOP;
};
Upgrade function: Upgrade[e] is the lock mode that a lock of mode e must be converted to by UpgradeLocks. NeedsUpgrade[e] = (Upgrade[e] # e).
Upgrade: ARRAY LockMode OF LockMode ← [
none: none, read: read, update: write, write: write,
readIntendUpdate: readIntendWrite, readIntendWrite: readIntendWrite,
intendRead: intendRead, intendUpdate: intendWrite, intendWrite: intendWrite];
NeedsUpgrade: ARRAY LockMode OF BOOL ← [
none: FALSE, read: FALSE, update: TRUE, write: FALSE,
readIntendUpdate: TRUE, readIntendWrite: FALSE,
intendRead: FALSE, intendUpdate: TRUE, intendWrite: FALSE];
Downgrade function: Downgrade[e] is the mode that a lock of mode e must be converted to by TransferLocks in the process of Commit and continue.
Downgrade: ARRAY LockMode OF LockMode ← [
none: none, read: read, update: read, write: read,
readIntendUpdate: read, readIntendWrite: read,
intendRead: intendRead, intendUpdate: intendRead, intendWrite: intendRead];
ReleaseLocks: PUBLIC ENTRY PROC [trans: AlpineInternal.TransHandle] = {
LockControl.ReleaseLocks
transHeader: LockTransHeaderHandle = TransactionMap.GetLockHeader[trans];
rNext: RequestHandle;
FOR r: RequestHandle ← transHeader.transList, rNext DO
rNext ← r.transList;
r.transList ← NIL;
r.trans ← NIL;
WITH r SELECT FROM
gr: GrantedRequestHandle => RemoveFromRequestList[gr];
wr: WaitingRequestHandle => ERROR;
th: LockTransHeaderHandle => RETURN;
ENDCASE;
ENDLOOP;
};
UnlinkFromTrans: INTERNAL PROC [
trans: AlpineInternal.TransHandle, gr: GrantedRequestHandle] = {
Called from Release.
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] = {
LockControl.TransferLocks
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;
};
Waiting request list (global)
waitingRequestList: WaitingRequestHandle;
list (linked through the transList field) of all waiting lock requests.
permanent header node starts list.
each request represents a suspended process, waiting in this monitor.
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] = {
LockControl.AbortWaitingRequests
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] = {
LockInternal.TimeoutWaitingRequest
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];
};
Client-supplied parameters to hash package begin here:
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 {
Goal is to make "not equal" determinations run as fast as possible, while not slowing "equal" determinations.
Doubleword "b" contains the least significant bits of the sequence number plus part of the processor ID. Doubleword "d" contains part of the lock sub ID.
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;
};
Special procedure for Lock application.
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];
};
Client-supplied parameters to hash package end here.
Hash table package.
Explanation of client-supplied parameters:
The procedure ClientHashInit is called during hash table initialization, to allow the hash function to precompute values based on the range and to make any small adjustments to the range that are necessary.
HashHandle must:
be a REF type.
contain a field "next" of type HashHandle, under the exclusive control of the hash package.
Key is an arbitrary type.
SetKey sets the "key value" associated with a HashHandle. The key value must not change between the time the handle is Inserted into the table and the time it is deleted from the table.
Hash must be a function of the key value of the parameter "hashHandle".
EqualKeys must be the equality relation on the key values of the parameters "hashHandle1" and "hashHandle2".
Interface description:
InitializeHashTable: INTERNAL PROCEDURE[numHashSlotsDesired: NAT, hashTableZone:
ZONE, hashHandle: HashHandle];
errors: HashPkgCallerProgrammingError (numHashSlotsDesired = 0).
Insert: INTERNAL PROCEDURE[hashHandle: HashHandle];
errors: HashPkgDuplicateKey.
Lookup: INTERNAL PROCEDURE[key: Key] RETURNS [hashHandle: HashHandle];
returns hashHandle = NIL if not found.
Delete: INTERNAL PROCEDURE[hashHandle: HashHandle];
errors: HashPkgCallerProgrammingError (not found).
EnumerateNext: INTERNAL PROCEDURE[prevHashHandle: HashHandle] RETURNS
[hashHandle: HashHandle];
errors: none.
prevHashHandle = NIL starts the enumeration, returned hashHandle = NIL is the end of the enumeration. This procedure guarantees that any hashHandle in existence throughout the entire enumeration will be seen. Other handles may or not not be seen. HashHandles may be seen more than once.
EnumerateWithProc: INTERNAL PROCEDURE[proc: PROCEDURE[hashHandle: HashHandle]
RETURNS[stop: BOOLEAN]];
errors: none.
start of invariant hash package code:
The INTERNAL procedures below expect to be called from a client procedure holding the module monitor lock, which protects the following data structures:
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.
errors:
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;
prevHashHandle = NIL starts the enumeration, returned hashHandle = NIL is the end of the enumeration. This procedure guarantees that any hashHandle in existence throughout the entire enumeration will be seen. Other handles may or not not be seen. HashHandles may be seen more than once.
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 of invariant hash package code.
END.--LockCoreImpl
CHANGE LOG
Changed by MBrown on February 8, 1983 5:47 pm
Bug in Set: did not decrement nRequests when a waiting request was granted.
Changed by MBrown on February 9, 1983 4:16 pm
Bug in Set: when deleting a waiting request that is about to be granted, RemoveFromRequestList deleted the lock header if the requestList was empty. but Set was holding on to the lock header. Added deleteHeaderIfNoRequests parm to fix.
Edited on July 23, 1984 11:16:08 am PDT, by Kupfer
Converted to Tioga node structure with Mesa formatting.