UnsafePropListImpl.mesa
Copyright Ó 1992 by Xerox Corporation. All rights reserved.
Created by Christian Jacobi, April 9, 1992 11:48:58 am PDT
Christian Jacobi, April 21, 1992 1:59 pm PDT
DIRECTORY PreDebug, Rope, IO, UnsafePropList, UnsafeFreeList;
UnsafePropListImpl:
CEDAR
MONITOR
LOCKS locks[idx] USING idx: [0..lockNum)
IMPORTS PreDebug, IO, UnsafeFreeList
EXPORTS UnsafePropList ~
BEGIN OPEN UnsafePropList;
debugSelf: BOOL ~ FALSE; --Debugging aid
PropListAddr: TYPE = POINTER TO PropRef;
PropRef: TYPE = REF PropRec;
PropRec: TYPE = RECORD [key: REF, val: REF, next: PropRef ¬ NIL, selfCheck: CARD];
lockNum: CARD = 32; --use multiple locks to avoid lock contention on multiprocessor
shiftRight: CARD = 16; --means shift 4 bits
locks:
ARRAY [0..lockNum)
OF
MONITORED
RECORD [
condition: CONDITION, freeList: PropRef ¬ NIL, freeAvail: INT ¬ localFreeListMax
];
localFreeListMax: INT ~ 15;
globalFreeList: UnsafeFreeList.Context ~ UnsafeFreeList.NewContext[100];
--Local caches would average out nicely, if there weren't Enumerate
BadSelfCheck:
ERROR [listAddr: PropListAddr] =
CODE;
When this error is raised it means that somebody made a copy of a property list. Not detecting this would be bad because a PropRef then could be put on the free-list while it still is in use by the other copy of the property list.
Disguise:
PROC [listAddr: PropListAddr]
RETURNS [
CARD] =
INLINE {
RETURN [CARD.LAST - LOOPHOLE[listAddr, CARD]]
};
New:
INTERNAL
PROC [idx: [0..lockNum)]
RETURNS [p: PropRef] =
TRUSTED {
p ¬ locks[idx].freeList;
IF p#
NIL
THEN {
IF debugSelf
THEN {
IF p.selfCheck#2 THEN ERROR;
};
locks[idx].freeList ¬ p.next;
locks[idx].freeAvail ¬ locks[idx].freeAvail+1;
p.next ¬ NIL;
RETURN
};
p ¬ LOOPHOLE[UnsafeFreeList.Get[globalFreeList]];
IF p=
NIL
THEN p ¬ NEW[PropRec]
ELSE IF debugSelf THEN { IF p.selfCheck#4 THEN ERROR };
};
Dispose:
INTERNAL
PROC [idx: [0..lockNum), p: PropRef] =
TRUSTED {
IF debugSelf THEN {IF p.selfCheck MOD 2 = 0 THEN ERROR};
p.key ¬ NIL; p.val ¬ NIL;
IF locks[idx].freeAvail>0
THEN {
--limit growth of free lists
IF debugSelf THEN {p.selfCheck ← 2};
p.next ¬ locks[idx].freeList; locks[idx].freeList ¬ p;
locks[idx].freeAvail ¬ locks[idx].freeAvail-1;
RETURN;
};
IF debugSelf THEN {p.selfCheck ← 4};
UnsafeFreeList.Free[globalFreeList, LOOPHOLE[p]];
};
InternalDisposeMany:
INTERNAL
PROC [idx: [0..lockNum), p: PropRef] = {
WHILE p#
NIL
DO
next: PropRef ~ p.next;
Dispose[idx, p];
p ¬ next;
ENDLOOP;
};
EntryDisposeMany:
ENTRY
PROC [idx: [0..lockNum), first: PropRef] = {
InternalDisposeMany[idx, first]
};
InternalPut:
INTERNAL
PROC [idx: [0..lockNum), listAddr: PropListAddr, first: PropRef, key, val:
REF]
RETURNS [old:
REF ¬
NIL] =
TRUSTED {
Fine point: first is listAddr^ and is checked. We read listAddr^ just once, to prevent error of clients assigning unchecked PropRef.
FOR p: PropRef ¬ first, p.next
WHILE p#
NIL
DO
IF p.key=key THEN {old ¬ p.val; p.val ¬ val; RETURN};
ENDLOOP;
BEGIN
n: PropRef ~ New[idx];
n.selfCheck ¬ Disguise[listAddr]; n.key ¬ key; n.val ¬ val; n.next ¬ first;
listAddr ¬ n
END;
};
EntryPutProp:
ENTRY
PROC [idx: [0..lockNum), listAddr: PropListAddr, key, val:
REF]
RETURNS [old:
REF ¬
NIL] =
TRUSTED
INLINE {
first: PropRef ¬ listAddr;
IF first#
NIL
AND first.selfCheck#Disguise[listAddr]
THEN
RETURN WITH ERROR BadSelfCheck[listAddr];
old ← InternalPut[idx, listAddr, first, key, val];
};
EntryTrustedAddNewProp:
ENTRY
PROC [idx: [0..lockNum), listAddr: PropListAddr, key, val:
REF] =
TRUSTED
INLINE {
first: PropRef ¬ listAddr;
IF first#
NIL
AND first.selfCheck#Disguise[listAddr]
THEN
RETURN WITH ERROR BadSelfCheck[listAddr];
IF val#
NIL
THEN {
n: PropRef ~ New[idx];
n.selfCheck ¬ Disguise[listAddr]; n.key ¬ key; n.val ¬ val; n.next ¬ first;
listAddr ¬ n
};
};
InternalRem:
INTERNAL
PROC [idx: [0..lockNum), listAddr: PropListAddr, first: PropRef, key:
REF]
RETURNS [old:
REF ¬
NIL] =
TRUSTED {
Fine point: first is listAddr^ and is checked, but we read listAddr^ just once, to prevent error assigning unchecked PropRef
IF first.key=key
THEN {
old ¬ first.val;
listAddr ¬ first.next; Dispose[idx, first];
RETURN;
};
FOR p: PropRef ¬ first, p.next
WHILE p#
NIL
DO
next: PropRef ¬ p.next;
IF next#
NIL
AND next.key=key
THEN {
old ¬ next.val;
p.next ¬ next.next; Dispose[idx, next];
RETURN;
};
ENDLOOP;
};
EntryRemProp:
ENTRY
PROC [idx: [0..lockNum), listAddr: PropListAddr, key:
REF]
RETURNS [old:
REF ¬
NIL] =
TRUSTED
INLINE {
p: PropRef ¬ listAddr;
IF p=NIL THEN RETURN;
IF p.selfCheck#Disguise[listAddr] THEN RETURN WITH ERROR BadSelfCheck[listAddr];
old ← InternalRem[idx, listAddr, p, key];
};
InternalGet:
INTERNAL
PROC [p: PropRef, key:
REF]
RETURNS [val:
REF ¬
NIL] =
INLINE {
WHILE p#
NIL
DO
IF p.key=key THEN RETURN [p.val];
p ¬ p.next
ENDLOOP;
};
EntryGetProp:
ENTRY
PROC [idx: [0..lockNum), listAddr: PropListAddr, key:
REF]
RETURNS [val:
REF ¬
NIL] =
TRUSTED
INLINE {
RETURN [InternalGet[listAddr, key]]
};
EntryConditionalPutProp:
ENTRY
PROC [idx: [0..lockNum), listAddr: PropListAddr, key, expect, new:
REF]
RETURNS [old:
REF ¬
NIL, done:
BOOL ¬
FALSE] =
TRUSTED {
first: PropRef ¬ listAddr;
IF first#
NIL
AND first.selfCheck#Disguise[listAddr]
THEN
RETURN WITH ERROR BadSelfCheck[listAddr];
FOR t: PropRef ¬ first, t.next
WHILE t#
NIL
DO
IF t.key=key
THEN {
old ¬ t.val;
IF old=expect THEN {t.val ¬ new; done ¬ TRUE};
RETURN [old, done];
};
ENDLOOP;
IF expect=
NIL
THEN {
n: PropRef ~ New[idx];
n.selfCheck ¬ Disguise[listAddr]; n.key ¬ key; n.val ¬ new; n.next ¬ first;
listAddr ¬ n;
done ¬ TRUE
};
};
EntryConditionalRemProp:
ENTRY
PROC [idx: [0..lockNum), listAddr: PropListAddr, key, expect:
REF]
RETURNS [old:
REF ¬
NIL, done:
BOOL ¬
FALSE] =
TRUSTED {
first: PropRef ¬ listAddr;
--IF expect=NIL THEN ... not worth special casing because client crazy
IF first#
NIL
THEN {
IF first.selfCheck#Disguise[listAddr]
THEN
RETURN WITH ERROR BadSelfCheck[listAddr];
IF first.key=key
THEN {
old ¬ first.val;
IF old=expect THEN {listAddr ¬ first.next; Dispose[idx, first]; done ¬ TRUE};
RETURN [old, done];
};
FOR p: PropRef ¬ first, p.next
WHILE p#
NIL
DO
next: PropRef ¬ p.next;
IF next#
NIL
AND next.key=key
THEN {
old ¬ first.val;
IF old=expect THEN {p.next ¬ next.next; Dispose[idx, next]; done ¬ TRUE};
RETURN [old, done];
};
ENDLOOP;
};
};
EntryNiloutProp:
ENTRY
PROC [idx: [0..lockNum), listAddr: PropListAddr] =
TRUSTED
INLINE {
first: PropRef ¬ listAddr;
IF first#
NIL
THEN {
listAddr ¬ NIL;
IF first.selfCheck#Disguise[listAddr] THEN RETURN; --It is not the time to raise errors as some applications might call EntryNiloutProp from finalizers. However we have to be careful nevertheless.
InternalDisposeMany[idx, first]
};
};
EntryCopy:
ENTRY
PROC [idx: [0..lockNum), listAddr: PropListAddr, selfCheck:
CARD]
RETURNS [p: PropRef ¬
NIL] =
TRUSTED {
Makes copy of property list WITHOUT special container
tail: PropRef;
source: PropRef ¬ listAddr;
IF source#
NIL
THEN {
IF source.key=mySpecialKey
THEN {
source ← source.next;
IF source=NIL THEN RETURN;
};
p ¬ tail ¬ New[idx];
tail.selfCheck ¬ selfCheck; tail.key ¬ source.key; tail.val ¬ source.val;
source ¬ source.next;
WHILE source#
NIL
DO
IF source.key#mySpecialKey
THEN {
tail.next ¬ New[idx]; tail ¬ tail.next;
tail.selfCheck ¬ selfCheck; tail.key ¬ source.key; tail.val ¬ source.val;
};
source ¬ source.next;
ENDLOOP;
};
};
GetProp:
PUBLIC
PROC [listAddr: PropListAddr, key:
REF]
RETURNS [
REF] = {
idx: [0..lockNum) ~ (LOOPHOLE[listAddr, CARD]/shiftRight) MOD lockNum;
IF listAddr=NIL THEN ERROR;
RETURN [EntryGetProp[idx, listAddr, key]];
};
PutProp:
PUBLIC
PROC [listAddr: PropListAddr, key, val:
REF]
RETURNS [old:
REF] = {
idx: [0..lockNum) ~ (LOOPHOLE[listAddr, CARD]/shiftRight) MOD lockNum;
IF listAddr=NIL THEN ERROR;
IF val#
NIL
THEN old ¬ EntryPutProp[idx, listAddr, key, val]
ELSE old ¬ EntryRemProp[idx, listAddr, key]
};
RemProp:
PUBLIC
PROC [listAddr: PropListAddr, key:
REF]
RETURNS [old:
REF] = {
idx: [0..lockNum) ~ (LOOPHOLE[listAddr, CARD]/shiftRight) MOD lockNum;
IF listAddr=NIL THEN ERROR;
old ← EntryRemProp[idx, listAddr, key];
};
TrustedAddNewProp:
PUBLIC
PROC [listAddr: PropListAddr, key, val:
REF] = {
idx: [0..lockNum) ~ (LOOPHOLE[listAddr, CARD]/shiftRight) MOD lockNum;
IF listAddr=NIL THEN ERROR;
EntryTrustedAddNewProp[idx, listAddr, key, val];
};
Enumerate:
PUBLIC
PROC [listAddr: PropListAddr, map: EachPropProc, data:
REF ¬
NIL]
RETURNS [quit:
BOOL ¬
FALSE] =
TRUSTED {
Copies the property list atomically, then enumerates the copy.
IF listAddr#
NIL
AND listAddr#
NIL
THEN {
idx: [0..lockNum) ~ (LOOPHOLE[listAddr, CARD]/shiftRight) MOD lockNum;
copy: PropRef ¬ EntryCopy[idx, listAddr, 1];
FOR p: PropRef ¬ copy, p.next
WHILE p#
NIL
AND ~quit
DO
quit ¬ map[data, p.key, p.val];
ENDLOOP;
EntryDisposeMany[idx, copy];
};
};
ConditionalPutProp:
PUBLIC
PROC [listAddr: PropListAddr, key, expect, new:
REF]
RETURNS [val:
REF, done:
BOOL] = {
idx: [0..lockNum) ~ (LOOPHOLE[listAddr, CARD]/shiftRight) MOD lockNum;
IF listAddr=NIL THEN ERROR;
IF new#
NIL
THEN [val, done] ¬ EntryConditionalPutProp[idx, listAddr, key, expect, new]
ELSE [val, done] ¬ EntryConditionalRemProp[idx, listAddr, key, expect]
};
NiloutPropList:
PUBLIC
PROC [listAddr: PropListAddr] =
TRUSTED {
p: PropRef ¬ listAddr; --implicite error test of listAddr#NIL
IF p#
NIL
THEN {
idx: [0..lockNum) ~ (LOOPHOLE[listAddr, CARD]/shiftRight) MOD lockNum;
EntryNiloutProp[idx, listAddr];
};
};
mySpecialKey: REF ATOM ¬ NEW[ATOM ¬ $SpecialKey]; --this key hangs in arbitrary property list. Its value is a PropRef whose val field is a property list
EntryAssertSpecial:
ENTRY
PROC [idx: [0..lockNum), listAddr: PropListAddr] =
TRUSTED
INLINE {
Assert that a property containing a special property list is there. This simplifies other procedures by not having to deal with inventing it. However we will not remember it.
first: PropRef ¬ listAddr;
IF first#
NIL
AND first.selfCheck#Disguise[listAddr]
THEN
RETURN WITH ERROR BadSelfCheck[listAddr];
[] ← InternalAssertSpecial[idx, listAddr, first]
};
InternalAssertSpecial:
INTERNAL
PROC [idx: [0..lockNum), listAddr: PropListAddr, first: PropRef]
RETURNS [PropRef] =
TRUSTED {
Assert that a property containing a special property list is there and returns it.
NOTE: Do not remember the special container after the lock is released; I am afraid a turkey fools around with the original property list in the mean time. RE-aquireing it is not expensive as this property is at the front of the list most of the time.
WITH InternalGet[first, mySpecialKey]
SELECT
FROM
s: PropRef => RETURN [s];
ENDCASE => {
container: PropRef ¬ New[idx];
value: PropRef ¬ New[idx];
value.selfCheck ¬ container.selfCheck ¬ Disguise[listAddr];
container.val ¬ value; container.key ¬ mySpecialKey;
container.next ¬ first;
listAddr ¬ container;
RETURN [container];
};
};
EntryLockForInit:
ENTRY
PROC [idx: [0..lockNum), listAddr: PropListAddr, key:
REF]
RETURNS [must: LockingResult, val:
REF] =
TRUSTED {
Blocks the logical lock for key
DO
--terminated only by calling RETURN
BEGIN
--serves to hold an EXITS redoLoopFromStart
special: PropListAddr;
first: PropRef ¬ listAddr;
--try whether value got put there by somebody else in the mean time
FOR p: PropRef ¬ first, p.next
WHILE p#
NIL
DO
IF p.key=key
THEN {
RETURN [notLockedBecauseValueFound, p.val]; --even if val=NIL !
};
ENDLOOP;
--Get the special property list containing blocked keys; it is at the front most often.
WITH InternalGet[first, mySpecialKey]
SELECT
FROM
value: PropRef => special ¬ LOOPHOLE[@value.val];
ENDCASE => {
--somebody removed the special property list. This is bad, but it could really happen with a client erronously overwriting the property list in the mean time.
RETURN WITH ERROR BadSelfCheck[listAddr];
RETURN [notLockedBecauseValueFound, NIL];
};
--Check the special property list whether our key should wait
FOR p: PropRef ¬ special, p.next
WHILE p#
NIL
DO
IF p.key=key
THEN {
--somebody else holds the lock; lets wait until he is done
WAIT locks[idx].condition;
GOTO redoLoopFromStart;
};
ENDLOOP;
--Lock was free; mark it occupied for key
BEGIN
--Use original listAddr disguise instead of special disguise to avoid lock order problem.
--Do not use InternalPut: the disguise would be wrong.
s: PropRef ¬ New[idx];
s.selfCheck ¬ Disguise[listAddr];
s.key ¬ key; s.val ¬ $occupied;
s.next ¬ special;
IF <<
first is not NIL; it contains at least the special property>> first.selfCheck#Disguise[listAddr]
THEN
RETURN WITH ERROR BadSelfCheck[listAddr];
special ¬ s;
RETURN [newlyLocked, NIL];
END;
EXITS redoLoopFromStart => {};
END;
ENDLOOP;
};
EntryLockForUpdate: ENTRY PROC [idx: [0..lockNum), listAddr: PropListAddr, key: REF] RETURNS [val: REF] = TRUSTED {
Blocks the logical lock for key
DO --terminated only by calling RETURN
BEGIN --serves to hold an EXITS redoLoopFromStart
special: PropListAddr;
container: PropRef;
first: PropRef ¬ listAddr;
IF first#NIL AND first.selfCheck#Disguise[listAddr] THEN
RETURN WITH ERROR BadSelfCheck[listAddr];
container ← InternalAssertSpecial[idx, listAddr, first]; --inside loop for safety against NILout
special ¬ LOOPHOLE[@container.val];
--Check the special property list whether our key should wait
FOR p: PropRef ¬ special, p.next WHILE p#NIL DO
IF p.key=key THEN {
--somebody else holds the lock; lets wait until he is done
WAIT locks[idx].condition;
GOTO redoLoopFromStart;
};
ENDLOOP;
val ← InternalGet[first, key];
--Lock was free; mark it occupied for key
BEGIN
--Use original listAddr disguise instead of special disguise to avoid lock order problem.
--Do not use InternalPut: the disguise would be wrong.
s: PropRef ¬ New[idx];
s.selfCheck ¬ Disguise[listAddr];
s.key ¬ key; s.val ¬ $occupied;
s.next ¬ special;
special ¬ s;
END;
EXITS redoLoopFromStart => {};
END;
ENDLOOP;
};
EntryUnlockAndStore:
ENTRY
PROC [idx: [0..lockNum), listAddr: PropListAddr, key, val:
REF, storeVal:
BOOL] =
TRUSTED {
Stores val and frees the logical block for key
InternalRemoveBlocking:
INTERNAL
UNSAFE
PROC [idx: [0..lockNum), listAddr: PropListAddr, first: PropRef, key:
REF] =
TRUSTED
INLINE {
WITH InternalGet[first, mySpecialKey]
SELECT
FROM
s: PropRef => {
special: PropListAddr ¬ LOOPHOLE[@s.val];
specialFirst: PropRef ¬ special;
IF specialFirst=NIL THEN <<oops>> RETURN;
IF specialFirst.next=
NIL
AND specialFirst.key=key
THEN {
--this was the single lock hold (frequent case)
--Order matters as Dispose can be destructive
Dispose[idx, specialFirst];
Dispose[idx, s];
[] ← InternalRem[idx, listAddr, first, mySpecialKey];
}
ELSE {
--there are other locks hold (rare case)
[] ← InternalRem[idx, special, specialFirst, key];
};
};
ENDCASE => {<<oops; turkey already removed it>>};
};
first: PropRef ¬ listAddr;
IF storeVal
THEN {
IF first#
NIL
AND first.selfCheck#Disguise[listAddr]
THEN
RETURN WITH ERROR BadSelfCheck[listAddr];
IF val=
NIL
THEN [] ← InternalRem[idx, listAddr, first, key]
ELSE [] ← InternalPut[idx, listAddr, first, key, val];
};
first ¬ listAddr; --first might have been overwritten by InternalRem or InternalPut
IF first#
NIL
AND first.selfCheck#Disguise[listAddr]
THEN
RETURN WITH ERROR BadSelfCheck[listAddr];
InternalRemoveBlocking[idx, listAddr, first, key];
BROADCAST locks[idx].condition;
};
LockingResult: TYPE = {newlyLocked, notLockedBecauseValueFound, occupiedTryAgain};
GetPropOrInit:
PUBLIC
PROC [listAddr: PropListAddr, key:
REF, init: InitializeProcType, data:
REF]
RETURNS [val:
REF, done:
BOOL ←
FALSE] = {
idx: [0..lockNum) ~ (LOOPHOLE[listAddr, CARD]/shiftRight) MOD lockNum;
IF listAddr=NIL THEN ERROR;
--Check first if the property already is initialized; that is where speed matters
val ¬ EntryGetProp[idx, listAddr, key];
IF val#NIL THEN RETURN;
--Carefully assert a logical lock and init the property if necessary within the logical lock
EntryAssertSpecial[idx, listAddr];
DO
--until success...
res: LockingResult;
[res, val] ¬ EntryLockForInit[idx, listAddr, key];
SELECT res
FROM
newlyLocked => {
val ¬ init[data, key]; --if init crashes this key will not be cleaned but damage is local and doesn't propagate to other property lists or other keys.
EntryUnlockAndStore[idx, listAddr, key, val, TRUE];
done ¬ TRUE;
RETURN
};
notLockedBecauseValueFound => RETURN;
ENDCASE => {};
ENDLOOP
};
UpdateProcType: TYPE = PROC [data: REF, key, val: REF] RETURNS [new: REF ← NIL, store: BOOL ← FALSE];
Update: PUBLIC PROC [listAddr: PropListAddr, key: REF, update: UpdateProcType, data: REF] = {
I have decided not to export this procedure as it is excluding only itself and GetPropOrInit but not PutProp while the client procedure is executing. I would know how to fix PutProp and friends, but I do not want to pay availability of Update by slowing down PutProp. Ch. J. April 15, 1992 4:27:59 pm PDT
new, old: REF; store: BOOL;
idx: [0..lockNum) ~ (LOOPHOLE[listAddr, CARD]/shiftRight) MOD lockNum;
IF listAddr=NIL THEN ERROR;
old ¬ EntryLockForUpdate[idx, listAddr, key];
[new, store] ¬ update[data, key, old ! UNWIND => {store ← FALSE; CONTINUE}];
EntryUnlockAndStore[idx, listAddr, key, new, store];
};
EntryAssign:
ENTRY
PROC [idx: [0..lockNum), destAddr: PropListAddr, newFirst: PropRef] =
TRUSTED {
first: PropRef ¬ destAddr;
IF first#
NIL
THEN {
IF first.selfCheck#Disguise[destAddr]
THEN
RETURN WITH ERROR BadSelfCheck[destAddr];
destAddr ¬ NIL;
InternalDisposeMany[idx, first];
};
destAddr ← newFirst
};
CopyPropList:
PUBLIC
PROC [destAddr, sourceAddr: PropListAddr] = {
sIdx: [0..lockNum) ~ (LOOPHOLE[sourceAddr, CARD]/shiftRight) MOD lockNum;
dIdx: [0..lockNum) ~ (LOOPHOLE[destAddr, CARD]/shiftRight) MOD lockNum;
copy: PropRef;
IF destAddr=NIL OR sourceAddr=NIL THEN ERROR;
copy ¬ EntryCopy[sIdx, sourceAddr, Disguise[destAddr]];
EntryAssign[dIdx, destAddr, copy];
};
MyExplain: PreDebug.Explainer = {
PreDebug.Raise[signalOrError, args ! BadSelfCheck => {
msg ¬ IO.PutFR1["UnsafePropListImpl.BadSelfCheck[listAddr: %g]", IO.card[LOOPHOLE[listAddr]]];
CONTINUE
}];
};
PreDebug.RegisterErrorExplainer[error: BadSelfCheck, explain: MyExplain];
END.