LockCoreImpl.mesa
Copyright © 1984 by Xerox Corporation. All rights reserved.
Carl Hauser, June 18, 1986 10:03:42 am PDT
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;
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;
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,
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 ← [
Lock.Sup
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;
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.
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] = {
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, cacheTransGrantedRequest: 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;
BreakCacheLocks:
INTERNAL PROC [newlyGrantedRequest: GrantedRequestHandle] ~ {
When a new lock is granted, existing incompatible cache locks must be broken.
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 {
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;
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;
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 (cacheTrans#nullTransID) AND (cacheTransGrantedRequest=NIL) THEN RETURN WITH ERROR Failed [cantConvert];
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 => {
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] = {
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 {
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] = {
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 {
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] = {
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,
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 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,
cache: cache, intendCache: intendCache];
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;
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] = {
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.
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.
Carl Hauser, May 16, 1986 9:57:44 am PDT
Added Cache Lock facilities.