XlAssocImpl.mesa
Copyright Ó 1988, 1990, 1991 by Xerox Corporation. All rights reserved.
Created by Christian Jacobi, April 29, 1988 0:30:08 am PDT
Christian Jacobi, March 7, 1991 4:58 pm PST
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.