MODULE TFClasses;
IMPORT Strings, SYSTEM;
TYPE
ObjectArray* = POINTER TO ARRAY OF ANY;
List* = OBJECT
VAR
list : ObjectArray;
count : LONGINT;
readLock : LONGINT;
PROCEDURE &New*;
BEGIN NEW(list, 8); readLock := 0
END New;
PROCEDURE GetCount*():LONGINT;
BEGIN
RETURN count
END GetCount;
PROCEDURE Grow;
VAR old: ObjectArray;
i : LONGINT;
BEGIN
old := list;
NEW(list, LEN(list)*2);
FOR i := 0 TO count-1 DO list[i] := old[i] END
END Grow;
PROCEDURE Add*(x : ANY);
BEGIN {EXCLUSIVE}
AWAIT(readLock = 0);
IF count = LEN(list) THEN Grow END;
list[count] := x;
INC(count)
END Add;
PROCEDURE Replace*(x, y : ANY);
VAR i : LONGINT;
BEGIN {EXCLUSIVE}
AWAIT(readLock = 0);
i := IndexOf(x);
IF i >= 0 THEN list[i] := y END
END Replace;
PROCEDURE IndexOf *(x:ANY) : LONGINT;
VAR i : LONGINT;
BEGIN
i := 0 ; WHILE i < count DO IF list[i] = x THEN RETURN i END; INC(i) END;
RETURN -1
END IndexOf;
PROCEDURE Remove*(x : ANY);
VAR i : LONGINT;
BEGIN {EXCLUSIVE}
AWAIT(readLock = 0);
i:=0; WHILE (i<count) & (list[i]#x) DO INC(i) END;
IF i<count THEN
WHILE (i<count-1) DO list[i]:=list[i+1]; INC(i) END;
DEC(count);
list[count]:=NIL
END
END Remove;
PROCEDURE Clear*;
VAR i : LONGINT;
BEGIN {EXCLUSIVE}
AWAIT(readLock = 0);
FOR i := 0 TO count - 1 DO list[i] := NIL END;
count := 0
END Clear;
PROCEDURE GetItem*(i:LONGINT) : ANY;
BEGIN
ASSERT((i >= 0) & (i < count), 101);
RETURN list[i]
END GetItem;
PROCEDURE Lock*;
BEGIN {EXCLUSIVE}
INC(readLock); ASSERT(readLock > 0)
END Lock;
PROCEDURE Unlock*;
BEGIN {EXCLUSIVE}
DEC(readLock); ASSERT(readLock >= 0)
END Unlock;
END List;
TYPE
CompareMethod* = PROCEDURE {DELEGATE} (first, second: ANY): LONGINT;
SortedList* = OBJECT(List);
VAR
compare: CompareMethod;
PROCEDURE &Init*(m: CompareMethod);
BEGIN
compare := m;
NEW(list, 8); readLock := 0
END Init;
PROCEDURE SetCompareMethod*(m:CompareMethod);
BEGIN
compare := m;
END SetCompareMethod;
PROCEDURE Add*(x : ANY);
BEGIN {EXCLUSIVE}
AWAIT(readLock = 0);
AddUnlocked(x);
END Add;
PROCEDURE AddUnlocked(x: ANY);
VAR i, pos: LONGINT;
BEGIN
IF count = LEN(list) THEN Grow END;
pos := FindPosition(x);
i := count-1;
WHILE i >= pos DO
list[i+1] := list[i];
DEC(i);
END;
list[pos] := x;
INC(count)
END AddUnlocked;
PROCEDURE FindPosition(x: ANY): LONGINT;
VAR
lowerBound, upperBound: LONGINT;
middle: LONGINT;
value: LONGINT;
BEGIN
IF count = 0 THEN RETURN 0; END;
IF compare(list[0], x) >= 1 THEN RETURN 0; END;
IF compare(list[count-1], x) <= -1 THEN RETURN count; END;
lowerBound := 0;
upperBound := count - 1;
WHILE (upperBound - lowerBound) > 1 DO
middle := (lowerBound + upperBound) DIV 2;
value := compare(list[middle], x);
IF value = 0 THEN RETURN middle; END;
IF value < 0 THEN
lowerBound := middle;
ELSE
upperBound := middle;
END;
END;
IF compare(list[lowerBound], x) = 0 THEN
RETURN lowerBound;
ELSE
RETURN upperBound;
END;
END FindPosition;
PROCEDURE Remove*(x : ANY);
BEGIN {EXCLUSIVE}
AWAIT(readLock = 0);
RemoveUnlocked(x);
END Remove;
PROCEDURE RemoveUnlocked(x: ANY);
VAR i : LONGINT;
BEGIN
i:=0; WHILE (i<count) & (list[i]#x) DO INC(i) END;
IF i<count THEN
WHILE (i<count-1) DO list[i]:=list[i+1]; INC(i) END;
DEC(count);
list[count]:=NIL
END
END RemoveUnlocked;
PROCEDURE Replace*(x, y : ANY);
BEGIN {EXCLUSIVE}
AWAIT(readLock = 0);
RemoveUnlocked(x);
AddUnlocked(y);
END Replace;
PROCEDURE SearchByKey*(x: ANY): ANY;
VAR pos : LONGINT;
BEGIN {EXCLUSIVE}
pos := FindPosition(x);
IF (x=NIL) OR (list[pos]=NIL) THEN RETURN NIL
ELSIF compare(x, list[pos]) = 0 THEN RETURN list[pos];
ELSE RETURN NIL;
END;
END SearchByKey;
END SortedList;
StringMapEntry = POINTER TO RECORD
key : Strings.String;
value : ANY;
next : StringMapEntry;
hash : LONGINT;
END;
StringMapEntryArray = POINTER TO ARRAY OF StringMapEntry;
StringHashMap* = OBJECT
VAR
hashtable : StringMapEntryArray;
PROCEDURE &Init*;
BEGIN
NEW(hashtable, 256);
END Init;
PROCEDURE CalcHash(CONST buffer : ARRAY OF CHAR) : LONGINT;
VAR hash, i : LONGINT; ch : CHAR;
BEGIN
hash := 0;
i := 0; ch := buffer[0]; hash := 0;
WHILE ch # 0X DO
hash :=SYSTEM.VAL(LONGINT, SYSTEM.VAL(SET, SYSTEM.ROT(hash, 7)) / SYSTEM.VAL(SET, LONG(ORD(ch))));
INC(i); ch := buffer[i]
END;
RETURN hash
END CalcHash;
PROCEDURE Find*(CONST key : ARRAY OF CHAR) : ANY;
VAR hash : LONGINT;
e : StringMapEntry;
BEGIN
hash := CalcHash(key);
e := hashtable[hash MOD LEN(hashtable)];
WHILE (e # NIL) & (e.key^ # key) DO e := e.next END;
IF e # NIL THEN RETURN e.value
ELSE RETURN NIL
END;
END Find;
PROCEDURE Add*(CONST key : ARRAY OF CHAR; value : ANY);
VAR hash : LONGINT;
e : StringMapEntry;
BEGIN
IF Find(key) # NIL THEN HALT(123) END;
hash := CalcHash(key);
NEW(e);
e.hash := hash;
e.key := Strings.NewString(key);
e.value := value;
e.next := hashtable[hash MOD LEN(hashtable)];
hashtable[hash MOD LEN(hashtable)] := e;
END Add;
PROCEDURE GetKeys;
BEGIN
END GetKeys;
END StringHashMap;
END TFClasses.
System.Free TFClasses ~
SystemTools.Free TFClasses~