UNSAFE MODULE-------------------------------------------------------------- exported ---; IMPORT Wx, Word, Cstring, Ctypes, ASCII, Text, Text8CString; CONST MaxLength = 8192 - BYTESIZE(ADDRESS) (* allocator goo *); NullChar = '\000'; TYPE StrPtr = UNTRACED REF CHAR; CharBuffer = UNTRACED REF ARRAY [0 .. MaxLength - 1] OF CHAR; DescBuffer = REF ARRAY OF Desc; TYPE Desc = RECORD start : StrPtr := NIL; hash : INTEGER := 0; text : TEXT := NIL; END; VAR next_char : CARDINAL := 0; chars := NEW (CharBuffer); next_t : T := 1; ids := NEW (DescBuffer, 2000); hashMask : INTEGER := 2047; (* == 2^11-1 == 11 bits on *) hashTable := NEW (REF ARRAY OF T, 2048); empty_id := Add (""); ID
PROCEDURE-------------------------------------------------------------- internal ---Add (x: TEXT): T = VAR t: T; a: REF ARRAY OF CHAR; l: INTEGER; BEGIN l := Text.Length(x); a := NEW(REF ARRAY OF CHAR, l + 1); FOR i := 0 TO l - 1 DO a^[i] := Text.GetChar(x, i); END; a^[l] := '\000'; t := FromStr (a^, LAST (a^)); IF (ids[t].text = NIL) THEN ids[t].text := x; END; RETURN t; END Add; PROCEDUREFromStr (READONLY buf: ARRAY OF CHAR; length: INTEGER): T = VAR hash, n: INTEGER; bucket: CARDINAL; t: T; p0, p1: StrPtr; BEGIN length := MIN (length, NUMBER (buf)); IF (length <= 0) THEN RETURN empty_id END; p0 := ADR (buf[0]); hash := 0; FOR i := 0 TO length - 1 DO hash := Word.Plus (Word.Times (17, hash), ORD (buf[i])); END; bucket := Word.And (hash, hashMask); LOOP t := hashTable[bucket]; IF (t = NoID) THEN (* empty! *) EXIT; END; IF (ids[t].hash = hash) THEN p0 := ADR (buf[0]); p1 := ids[t].start; n := length; WHILE (n > 0) AND (p0^ = p1^) DO DEC (n); INC (p0, ADRSIZE (p0^)); INC (p1, ADRSIZE (p1^)); END; IF (n = 0) AND (p1^ = NullChar) THEN RETURN t; END; END; INC (bucket); IF (bucket >= NUMBER (hashTable^)) THEN bucket := 0; END; END; (* we didn't find a match => build a new one *) t := next_t; INC (next_t); IF (t >= NUMBER (ids^)) THEN ExpandIDs (); END; hashTable[bucket] := t; (* make sure we've got room to stuff the characters *) IF (next_char + length >= LAST (chars^)) THEN ExpandChars (); END; (* initialize the descriptor and stuff the characters *) WITH z = ids[t] DO z.start := ADR (chars[next_char]); z.hash := hash; z.text := NIL; SUBARRAY (chars^, next_char, length) := SUBARRAY (buf, 0, length); chars [next_char + length] := NullChar; INC (next_char, length + 1); END; (* make sure we're not overloading the hash table *) IF (2 * next_t > NUMBER (hashTable^)) THEN ExpandHashTable (); END; RETURN t; END FromStr; PROCEDUREToText (t: T): TEXT = VAR ptr: StrPtr; x: TEXT; BEGIN <*ASSERT t < next_t*> IF (t = NoID) THEN RETURN NIL END; x := ids[t].text; IF (x = NIL) THEN ptr := ids[t].start; x := Text8CString.New (LOOPHOLE (ptr, Ctypes.char_star)); ids[t].text := x; END; RETURN x; END ToText; PROCEDUREPut (wr: Wx.T; t: T) = VAR ptr := LOOPHOLE (ids[t].start, CharBuffer); len: INTEGER; BEGIN <*ASSERT t < next_t*> IF (t = NoID) THEN RETURN END; len := Cstring.strlen (LOOPHOLE (ptr, Ctypes.char_star)); Wx.PutStr (wr, SUBARRAY (ptr^, 0, len)); END Put; PROCEDUREHash (t: T): INTEGER = BEGIN <*ASSERT t < next_t*> RETURN ids[t].hash; END Hash; PROCEDURECompare (a, b: T): [-1 .. +1] = CONST NUL = '\000'; VAR pa, pb: StrPtr; ca, cb: CHAR; BEGIN <*ASSERT a < next_t AND b < next_t *> IF (a = b) THEN RETURN 0; END; pa := ids[a].start; pb := ids[b].start; LOOP ca := ASCII.Upper [pa^]; cb := ASCII.Upper [pb^]; IF (ca # cb) THEN IF (ca < cb) THEN RETURN -1 ELSE RETURN +1 END; END; IF (ca = NUL) THEN RETURN 0; END; INC (pa, ADRSIZE (pa^)); INC (pb, ADRSIZE (pb^)); END; (******* RETURN Cstring.strcmp (pa, pb) < 0; *******) END Compare;
PROCEDUREExpandChars () = BEGIN chars := NEW (CharBuffer); next_char := 0; END ExpandChars; PROCEDUREExpandIDs () = VAR n := NUMBER (ids^); new := NEW (DescBuffer, n+n); BEGIN SUBARRAY (new^, 0, n) := ids^; ids := new; END ExpandIDs; PROCEDUREExpandHashTable () = VAR n_old := NUMBER (hashTable^); n_new := n_old + n_old; new := NEW (REF ARRAY OF T, n_new); newMask := hashMask + hashMask + 1; t : T; bucket : INTEGER; BEGIN FOR i := 0 TO n_new - 1 DO new[i] := NoID END; FOR i := 0 TO n_old - 1 DO t := hashTable [i]; IF (t # NoID) THEN bucket := Word.And (ids[t].hash, newMask); WHILE (new[bucket] # NoID) DO INC (bucket); IF (bucket >= n_new) THEN bucket := 0; END; END; new[bucket] := t; END; END; hashMask := newMask; hashTable := new; END ExpandHashTable; BEGIN END ID.