<<>> <> <> <> <> DIRECTORY Basics, SourceMarks; SourceMarksImpl: CEDAR PROGRAM IMPORTS Basics EXPORTS SourceMarks = BEGIN Object: TYPE = REF ObjectRep; ObjectRep: TYPE = RECORD [ sortLink: Object Ź NIL, tableLink: Object Ź NIL, startPos: INT Ź 0, endPos: INT Ź -1, nextPos: INT Ź -1, mark: REF Ź NIL ]; table: MyTable Ź NIL; MyTable: TYPE = REF MyTableRep; MyTableRep: TYPE = RECORD [ size: INT Ź 0, head: Object Ź NIL, tail: Object Ź NIL, free: Object Ź NIL, mask: CARDINAL Ź 0, objs: SEQUENCE len: NAT OF Object]; NoSuchSource: PUBLIC ERROR = CODE; StartSource: PUBLIC PROC [startPos: INT, mark: REF] = { <> IF table = NIL THEN table Ź CreateTable[]; IF TableFetch[table, startPos] = NIL THEN { new: Object Ź NewObject[table]; new.startPos Ź startPos; new.mark Ź mark; TableStore[table, startPos, new]; }; }; <<>> EndSource: PUBLIC PROC [startPos: INT, endPos: INT] = { <> object: Object = TableFetch[table, startPos]; IF object = NIL THEN ERROR NoSuchSource; object.endPos Ź endPos; }; <<>> MarkSource: PUBLIC PROC [startPos: INT, mark: REF, overWrite: BOOL] = { <> object: Object = TableFetch[table, startPos]; IF object = NIL THEN ERROR NoSuchSource; IF overWrite OR object.mark = NIL THEN object.mark Ź mark; }; <<>> GetProps: PUBLIC PROC [startPos: INT] RETURNS [found: BOOL, endPos: INT, mark: REF] = { <> object: Object = TableFetch[table, startPos]; IF object # NIL THEN RETURN [TRUE, object.endPos, object.mark]; RETURN [FALSE, -1, NIL]; }; GetNext: PUBLIC PROC [startPos: INT] RETURNS [INT] = { object: Object = TableFetch[table, startPos]; IF object = NIL THEN ERROR NoSuchSource; RETURN [object.nextPos]; }; <<>> Reset: PUBLIC PROC = { <> IF table # NIL THEN ResetTable[table]; }; <> <<>> CreateTable: PROC [size: [0..16*1024) Ź 2000] RETURNS [MyTable] = { table: MyTable Ź NIL; mask: CARDINAL Ź 1; IF size < 100 THEN size Ź 100; WHILE mask < size DO mask Ź mask + mask + 1; ENDLOOP; table Ź NEW[MyTableRep[mask+1]]; table.mask Ź mask; RETURN [table]; }; HashForTable: PROC [int: INT] RETURNS [CARDINAL] = INLINE { ln: Basics.LongNumber = [int[int]]; RETURN [ln.lo + ln.hi]; }; TableStore: PROC [table: MyTable, int: INT, object: Object] = { hash: CARDINAL = Basics.BITAND[table.mask, HashForTable[int]]; object.tableLink Ź table.objs[hash]; table.objs[hash] Ź object; IF table.tail = NIL THEN { <> table.head Ź object; } ELSE { IF object.startPos < table.tail.startPos THEN { <> IF object.startPos < table.head.startPos THEN { <> object.sortLink Ź table.head; object.nextPos Ź table.head.startPos; table.head Ź object; RETURN; } ELSE { <> lag: Object Ź table.head; FOR each: Object Ź lag.sortLink, each.sortLink WHILE each # NIL DO IF object.startPos < each.startPos THEN { object.nextPos Ź each.startPos; object.sortLink Ź each; lag.sortLink Ź object; lag.nextPos Ź object.startPos; RETURN; }; lag Ź each; ENDLOOP; ERROR; }; }; table.tail.nextPos Ź object.startPos; table.tail.sortLink Ź object; }; table.tail Ź object; }; TableFetch: PROC [table: MyTable, int: INT] RETURNS [Object] = { hash: CARDINAL = Basics.BITAND[table.mask, HashForTable[int]]; object: Object Ź table.objs[hash]; WHILE object # NIL AND object.startPos # int DO object Ź object.tableLink; ENDLOOP; RETURN [object]; }; NewObject: PROC [table: MyTable] RETURNS [Object] = { object: Object Ź table.free; IF object # NIL THEN { table.free Ź object.tableLink; object.tableLink Ź NIL; } ELSE { object Ź NEW[ObjectRep Ź []]; }; RETURN [object]; }; ResetTable: PROC [table: MyTable] = { FOR i: NAT IN [0..table.len) DO table.objs[i] Ź NIL; ENDLOOP; table.tail Ź NIL; WHILE table.head # NIL DO this: Object Ź table.head; next: Object Ź this.sortLink; this Ź [tableLink: table.free]; table.free Ź this; table.head Ź next; ENDLOOP; table.size Ź 0; }; END.