<<>> <> <> <> <> <<>> DIRECTORY XlAssoc, Xl USING [Window, WindowId, nullWindow]; XlAssocImpl: CEDAR MONITOR LOCKS x USING x: Table IMPORTS Xl EXPORTS XlAssoc = BEGIN OPEN Xl, XlAssoc; minMod: SeqIndex = 2; Impl: TYPE ~ REF AssocTabImplRep; AssocTabImplRep: PUBLIC TYPE = RECORD [ size, sizeLimit, inhibitCount: INT, data: REF Seq, dummyParent: Node ]; SeqIndex: TYPE = NAT; Seq: TYPE = RECORD [nodes: SEQUENCE max: SeqIndex OF Node]; Node: TYPE = REF NodeRep; NodeRep: TYPE = RECORD [window: Window ¬ nullWindow, val: REF ¬ NIL, prev: Node ¬ NIL, next: Node ¬ NIL, --in hash table order parent: Node ¬ NIL, firstChild: Node ¬ NIL, nextSib: Node ¬ NIL, prevSib: Node ¬ NIL, --undetermined order of siblings index: SeqIndex ¬ 0 ]; <<--assert: IF fooNode#NIL AND fooNode.firstChild#NIL THEN fooNode.firstChild.prevSib=NIL>> ParentUnknown: PUBLIC ERROR = CODE; NullWindowUsed: PUBLIC ERROR = CODE; CircularParents: PUBLIC ERROR = CODE; Hash: PROC [window: Window] RETURNS [c: CARD16] = INLINE { id: CARD32 ¬ Xl.WindowId[window]; RETURN [(id MOD 100000B) + id / 100000B] }; Create: PUBLIC PROC [mod: SeqIndex] RETURNS [Table] = { seqLen: SeqIndex ~ MAX[mod, minMod]; impl: Impl ~ NEW [AssocTabImplRep ¬ [ size: 0, sizeLimit: seqLen, inhibitCount: 0, data: NEW [Seq[seqLen]], dummyParent: NEW [NodeRep ¬ [window: nullWindow]] ]]; RETURN [NEW [AssocTabRep ¬ [impl: impl]]]; }; <<>> FindNode: INTERNAL PROC [impl: Impl, window: Window] RETURNS [Node ¬ NIL] = { IF window=nullWindow THEN RETURN [impl.dummyParent] ELSE { index: SeqIndex ¬ Hash[window] MOD impl.data.max; node: Node ¬ impl.data[index]; WHILE node # NIL DO IF window=node.window THEN RETURN [node]; node ¬ node.next; ENDLOOP; }; }; FetchValue: PUBLIC ENTRY PROC [x: Table, window: Window] RETURNS [found: BOOL, parent: Window, val: REF] = { ENABLE UNWIND => NULL; node: Node ~ FindNode[x.impl, window]; IF node#NIL THEN RETURN [TRUE, node.parent.window, node.val] ELSE RETURN [FALSE, nullWindow, NIL]; }; StoreValue: PUBLIC ENTRY PROC [x: Table, window: Window, val: REF ¬ NIL] RETURNS [found: BOOL] = { ENABLE UNWIND => NULL; node: Node ~ FindNode[x.impl, window]; IF found ¬ node#NIL THEN node.val ¬ val; }; InsertWindow: PUBLIC ENTRY PROC [x: Table, window: Window, parent: Window ¬ nullWindow, val: REF ¬ NIL] RETURNS [done: BOOL] = { <<--fooNode.nextSib, firstChild modified compatible with EnumerateChildren>> impl: Impl ~ x.impl; node: Node ¬ FindNode[impl, window]; parentNode: Node ¬ FindNode[impl, parent]; IF window=parent THEN RETURN WITH ERROR CircularParents; IF node=NIL THEN { index: SeqIndex ~ Hash[window] MOD impl.data.max; node ¬ NEW[NodeRep ¬ [window: window, index: index, val: val]]; AddChildToParent[node, parentNode]; AddNodeToHashBucket[impl, node]; IF (impl.size ¬ impl.size + 1) > impl.sizeLimit AND impl.inhibitCount = 0 THEN ReHash[impl]; RETURN [TRUE]; } ELSE { IF window=nullWindow THEN RETURN WITH ERROR NullWindowUsed; RETURN [FALSE]; }; }; StoreWindow: PUBLIC ENTRY PROC [x: Table, window: Window, parent: Window ¬ nullWindow] RETURNS [new: BOOL] = { impl: Impl ~ x.impl; node: Node ¬ FindNode[impl, window]; parentNode: Node ¬ FindNode[impl, parent]; IF parentNode=NIL THEN RETURN WITH ERROR ParentUnknown; IF node=NIL THEN { index: SeqIndex ~ Hash[window] MOD impl.data.max; node ¬ NEW[NodeRep ¬ [window: window, index: index]]; AddChildToParent[node, parentNode]; AddNodeToHashBucket[impl, node]; IF (impl.size ¬ impl.size + 1) > impl.sizeLimit AND impl.inhibitCount = 0 THEN ReHash[impl]; RETURN [TRUE]; } ELSE { IF window=nullWindow THEN RETURN WITH ERROR NullWindowUsed; IF parent=node.parent.window THEN RETURN [FALSE]; FOR p: Node ¬ parentNode, p.parent WHILE p#impl.dummyParent DO IF p=node THEN RETURN WITH ERROR CircularParents; ENDLOOP; RemoveChildFromParent[node]; AddChildToParent[node, parentNode]; RETURN [FALSE]; }; }; AddNodeToHashBucket: INTERNAL PROC [impl: Impl, node: Node] = INLINE { node.prev ¬ NIL; node.next ¬ impl.data[node.index]; IF node.next#NIL THEN node.next.prev ¬ node; impl.data[node.index] ¬ node; }; RemoveNodeFromHashBucket: INTERNAL PROC [impl: Impl, node: Node] = INLINE { IF node.next#NIL THEN node.next.prev ¬ node.prev; IF node.prev#NIL THEN node.prev.next ¬ node.next ELSE impl.data[node.index] ¬ node.next; }; AddChildToParent: INTERNAL PROC [child, parent: Node] = INLINE { child.parent ¬ parent; child.prevSib ¬ NIL; child.nextSib ¬ parent.firstChild; IF parent.firstChild#NIL THEN { IF parent.firstChild.prevSib#NIL THEN ERROR; --see assertion parent.firstChild.prevSib ¬ child; }; parent.firstChild ¬ child; --child.prevSib is NIL! }; RemoveChildFromParent: INTERNAL PROC [child: Node] = INLINE { IF child.parent.firstChild=child THEN { IF child.prevSib#NIL THEN ERROR; --see assertion child.parent.firstChild ¬ child.nextSib; --for assertion look statement after if } ELSE { IF child.prevSib=NIL THEN ERROR; child.prevSib.nextSib ¬ child.nextSib; --still points to legal sibling if there is any }; IF child.nextSib#NIL THEN child.nextSib.prevSib ¬ child.prevSib; }; InternalRemoveNode: INTERNAL PROC [impl: Impl, node: Node] = { <<--node must NOT be dummyParent or NIL>> <<--fooNode.nextSib, firstChild modified compatible with EnumerateChildren>> WHILE node.firstChild#NIL DO InternalRemoveNode[impl, node.firstChild]; ENDLOOP; RemoveChildFromParent[node]; RemoveNodeFromHashBucket[impl, node]; impl.size ¬ impl.size - 1; }; RemoveWindow: PUBLIC ENTRY PROC [x: Table, window: Window] RETURNS [found: BOOL] = { ENABLE UNWIND => NULL; node: Node ~ FindNode[x.impl, window]; found ¬ node#NIL; IF window=nullWindow THEN RETURN WITH ERROR NullWindowUsed; IF found THEN InternalRemoveNode[x.impl, node]; }; EnumerateChildren: PUBLIC PROC [x: Table, window: Window, action: EachChildAction, recurse: Recurse ¬ oneLevelOnly, data: REF ¬ NIL] RETURNS [found: BOOL, quit: BOOL] = { Inhibit: ENTRY PROC [x: Table, window: Window] RETURNS [node: Node] ~ { impl: Impl ~ x.impl; impl.inhibitCount ¬ impl.inhibitCount + 1; node ¬ FindNode[impl, window]; }; Release: ENTRY PROC [x: Table] ~ { impl: Impl ~ x.impl; impl.inhibitCount ¬ impl.inhibitCount - 1; IF impl.inhibitCount#0 THEN RETURN; WHILE impl.size > impl.sizeLimit DO ReHash[impl] ENDLOOP; }; Enumerate: PROC [node: Node, action: EachChildAction, recurse: Recurse, data: REF] RETURNS [quit: BOOL ¬ FALSE] ~ { <<--NOT MONITORED !>> FOR n: Node ¬ node.firstChild, n.nextSib WHILE n#NIL DO IF n.firstChild#NIL AND recurse=bottomUp THEN IF Enumerate[n, action, recurse, data] THEN RETURN [TRUE]; IF action[n.window, n.val, node.window, data] THEN RETURN [TRUE]; IF n.firstChild#NIL AND recurse=topDown THEN IF Enumerate[n, action, recurse, data] THEN RETURN [TRUE]; ENDLOOP }; node: Node ¬ Inhibit[x, window]; IF found ¬ (node#NIL) THEN quit ¬ FALSE ELSE quit ¬ Enumerate[node, action, recurse, data ! UNWIND => Release[x]]; Release[x]; }; GetSize: PUBLIC ENTRY PROC [x: Table] RETURNS [INT] = { ENABLE UNWIND => NULL; impl: Impl ~ x.impl; RETURN [impl.size]; }; Erase: PUBLIC ENTRY PROC [x: Table] = { ENABLE UNWIND => NULL; impl: Impl ~ x.impl; FOR i: SeqIndex IN [0..impl.data.max) DO next: Node ¬ NIL; FOR cur: Node ¬ impl.data[i], next WHILE cur#NIL DO next ¬ cur.next; cur­ ¬ []; ENDLOOP; impl.data[i] ¬ NIL ENDLOOP; impl.size ¬ 0; impl.dummyParent­ ¬ []; }; ReHash: INTERNAL PROC [impl: Impl] = { oldData: REF Seq = impl.data; newData: REF Seq; seek: CARDINAL = impl.data.max * 2; newPTI, newMod: CARDINAL ¬ 0; IF primeTable[primeTableSize-1] > LAST[SeqIndex] THEN ERROR; FOR newPTI ¬ 0, newPTI+1 WHILE newPTI+1 < primeTableSize AND primeTable[newPTI] < seek DO NULL ENDLOOP; newMod ¬ primeTable[newPTI]; IF newMod = impl.data.max THEN {impl.sizeLimit ¬ LAST[INT]; RETURN}; impl.sizeLimit ¬ newMod; impl.data ¬ newData ¬ NEW [Seq[newMod]]; FOR i: SeqIndex IN [0..oldData.max) DO next: Node ¬ NIL; FOR cur: Node ¬ oldData[i], next WHILE cur#NIL DO cur.index ¬ Hash[cur.window] MOD newMod; next ¬ cur.next; AddNodeToHashBucket[impl, cur]; ENDLOOP; ENDLOOP; }; primeTableSize: NAT = 14; primeTable: REF ARRAY [0..primeTableSize) OF CARDINAL ~ NEW[ARRAY [0..primeTableSize) OF CARDINAL ¬ [00002, 00005, 00011, 00023, 00053, 00113, 00251, 00509, 01019, 02039, 04079, 08179, 16369, 32749]]; END.