<> <> <> <> <> 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; <> <<>> <> 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; }; <> <> 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 { <> 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; }; <> Size: PROC [table: Table] RETURNS [size: INT _ 0] = { Count: PROC [Instance, Value] = {size _ size + 1}; Enumerate[table, Count]; }; END.