InstanceTableImpl.mesa
Copyright Ó 1987 by Xerox Corporation. All rights reversed.
From Intervals, created by Bertrand Serlet, November 16, 1985 7:22:05 pm PST
Bertrand Serlet, August 9, 1987 2:00:14 am PDT
Jean-Marc Frailong January 16, 1988 5:30:56 pm PST
DIRECTORY
Basics USING [LongNumber, BITSHIFT, BITOR, BITAND],
CD, CDBasics, Core, CoreGeometry,
InstanceTable;
InstanceTableImpl:
CEDAR
MONITOR
IMPORTS Basics, CDBasics, CoreGeometry
EXPORTS InstanceTable =
BEGIN OPEN InstanceTable;
freeInstanceValues:
LIST
OF InstanceValue ←
NIL;
Hand allocation for efficiency reasons
equivalent to: new ← CONS [iw, list];
Cons:
PRIVATE
PROC [iw: InstanceValue, list:
LIST
OF InstanceValue]
RETURNS [new:
LIST
OF InstanceValue] = {
IF freeInstanceValues=NIL THEN freeInstanceValues ← LIST [[[], NIL]]; -- too bad!
IF freeInstanceValues.first#[[], NIL] THEN ERROR; -- something real bad going on!
new ← freeInstanceValues; freeInstanceValues ← freeInstanceValues.rest; new.first ← iw; new.rest ← list;
};
equivalent to: rest ← list.rest;
only disposes of the first element!
Dispose:
PRIVATE
PROC [list:
LIST
OF InstanceValue]
RETURNS [rest:
LIST
OF InstanceValue] = {
rest ← list.rest; list.first ← [[], NIL]; list.rest ← freeInstanceValues; freeInstanceValues ← list;
IF freeInstanceValues.first#[[], NIL] THEN ERROR; -- something real bad going on!
};
Halve:
PROC [n:
INT]
RETURNS [
INT] ~
INLINE {
Because the compiler is brain-damaged and calls general division for INT/2
ln: Basics.LongNumber;
ln.li ← n;
ln.lo ← Basics.BITOR[Basics.BITSHIFT[ln.lo, -1], Basics.BITSHIFT[ln.hi, 15]];
ln.hi ← Basics.BITOR[Basics.BITSHIFT[ln.hi, -1], Basics.BITAND[ln.hi, 08000H]];
RETURN [ln.li];
};
Divide:
PROC [bucket: Rect]
RETURNS [bucket1, bucket2: Rect] =
INLINE {
bucket1 ← bucket2 ← bucket;
IF bucket.x2-bucket.x1>=bucket.y2-bucket.y1
THEN {mid: INT ← Halve[bucket.x1+bucket.x2]; bucket1.x2 ← mid; bucket2.x1 ← mid+1}
ELSE {mid: INT ← Halve[bucket.y1+bucket.y2]; bucket1.y2 ← mid; bucket2.y1 ← mid+1};
};
HashRect:
PROC [table: Table, rect: Rect]
RETURNS [hash:
NAT ← 1] = {
bucket: Rect ← table.range;
IF NOT CDBasics.Inside[rect, bucket] THEN ERROR;
WHILE hash * 2 < table.data.size
DO
bucket1, bucket2: Rect;
[bucket1, bucket2] ← Divide[bucket];
SELECT
TRUE
FROM
CDBasics.Inside[rect, bucket1] => {hash ← hash * 2; bucket ← bucket1};
CDBasics.Inside[rect, bucket2] => {hash ← hash * 2 + 1; bucket ← bucket2};
ENDCASE => RETURN;
ENDLOOP;
};
HashInstance:
PROC [table: Table, instance: Instance]
RETURNS [hash:
NAT] =
INLINE {
hash ← HashRect[table, CoreGeometry.InlineBBox[instance]];
};
Create:
PUBLIC
PROC [range: Rect, logSize:
NAT ← 2]
RETURNS [Table] = {
data: REF TableData ← NEW [TableData[Basics.BITSHIFT[value: 1, count: logSize]]];
RETURN [NEW [TableRec ← [range: range, leafBuckets: 0, data: data]]];
};
ReHash:
PROC [table: Table] = {
oldData: REF TableData ← table.data;
newData: REF TableData ← NEW [TableData[oldData.size*2]];
table.data ← newData;
table.leafBuckets ← 0;
FOR i:
NAT
IN [1 .. oldData.size)
DO
values: LIST OF InstanceValue ← oldData[i];
WHILE values#
NIL
DO
hash: NAT ← HashInstance[table, values.first.instance];
IF newData[hash]=NIL THEN table.leafBuckets ← table.leafBuckets+1;
newData[hash] ← Cons[values.first, newData[hash]];
values ← Dispose[values];
ENDLOOP;
ENDLOOP;
};
Insert:
PUBLIC
ENTRY
PROC [table: Table, instance: Instance, value: Value] = {
ENABLE UNWIND => NULL;
hash: NAT ← HashInstance[table, instance];
IF table.data[hash]=NIL THEN table.leafBuckets ← table.leafBuckets+1;
table.data[hash] ← Cons[[instance, value], table.data[hash]];
IF table.leafBuckets * 2 > table.data.size THEN ReHash[table];
};
Enumerate:
PUBLIC
PROC [table: Table, action:
PROC [Instance, Value], rect: Rect ← universe] = {
EnumerateBucket:
PROC [hash:
NAT] = {
FOR ivs:
LIST
OF InstanceValue ← data[hash], ivs.rest
WHILE ivs#
NIL
DO
IF CDBasics.Intersect[CoreGeometry.InlineBBox[ivs.first.instance], clipped]
THEN action[ivs.first.instance, ivs.first.value];
ENDLOOP;
};
data: REF TableData ← table.data; -- stored in the local frame to avoid concurrent inconsistencies
clipped: Rect ← CDBasics.Intersection[rect, table.range];
hash1, hash2, hash: NAT;
IF NOT CDBasics.NonEmpty[clipped] THEN RETURN; -- empty rect
hash1 ← hash2 ← hash ← HashRect[table, clipped];
WHILE hash>0 DO EnumerateBucket[hash]; hash ← hash/2 ENDLOOP;
DO
hash1 ← 2 * hash1; hash2 ← 2 * hash2 + 1;
IF hash2>=data.size THEN RETURN;
FOR hash IN [hash1 .. hash2] DO EnumerateBucket[hash] ENDLOOP;
ENDLOOP;
};
DeleteOutside:
PUBLIC
ENTRY
PROC [table: Table, rect: Rect] = {
FOR i:
NAT
IN [1 .. table.data.size)
DO
IF table.data[i]#
NIL
THEN {
current: LIST OF InstanceValue ← table.data[i];
previous: LIST OF InstanceValue ← NIL; -- either NIL or the node before current
allDeleted: BOOL ← TRUE;
UNTIL current =
NIL
DO
SELECT
TRUE
FROM
CDBasics.Intersect[rect, CoreGeometry.InlineBBox[current.first.instance]] => {
allDeleted ← FALSE; previous ← current; current ← current.rest;
};
previous = NIL => current ← table.data[i] ← Dispose[current];
ENDCASE => current ← previous.rest ← Dispose[current];
ENDLOOP;
IF allDeleted THEN table.leafBuckets ← table.leafBuckets-1;
};
ENDLOOP;
};
For debugging!
Size:
PROC [table: Table]
RETURNS [size:
INT ← 0] = {
Count: PROC [Instance, Value] = {size ← size + 1};
Enumerate[table, Count];
};