SourceMarksImpl.mesa
Copyright Ó 1988, 1991 by Xerox Corporation. All rights reserved.
Russ Atkinson (RRA) December 6, 1989 5:51:15 pm PST
Willie-s, September 24, 1991 1:45 pm PDT
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] = {
Starts a source range. Duplicates are discarded.
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] = {
Ends a source range.
object: Object = TableFetch[table, startPos];
IF object = NIL THEN ERROR NoSuchSource;
object.endPos ¬ endPos;
};
MarkSource:
PUBLIC
PROC [startPos:
INT, mark:
REF, overWrite:
BOOL] = {
Sets the mark for the given source position.
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] = {
For the given source position, returns the current properties.
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 = {
Resets the storage to the ground state.
IF table # NIL THEN ResetTable[table];
};
Table handling
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 {
The only kid on the block, no problem
table.head ¬ object;
}
ELSE {
IF object.startPos < table.tail.startPos
THEN {
Sigh, must do a linear search to properly insert this object
IF object.startPos < table.head.startPos
THEN {
Insert at the front
object.sortLink ¬ table.head;
object.nextPos ¬ table.head.startPos;
table.head ¬ object;
RETURN;
}
ELSE {
Scan the list to find the insertion point
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.