(*********************************************************************)
(* Title:	HashStrings - Implementation			     *)
(* Author: 	Mick Jordan,107,x304				     *)
(* 		Copyright (C) 1985 by Acorn Research Centre	     *)
(*********************************************************************)

(*
  $Revision: 1.3 $
  $Author: mjj $
  $Date: 85/06/04 18:05:24 $
  $Source: /util/m2/lib/Standard/RCS/HashStrings.mod,v $
  $State: Exp $
*)

(* $T-, $R- module is self checking *)
(*
    This version uses a table of linked lists.
    The computed hash value identifies a table entry and
    this the head of one of the linked lists.
    An object entered in the hashtable is identified by
    the address of the record element in the list.
*)

IMPLEMENTATION MODULE HashStrings;

FROM SYSTEM IMPORT WORD, TSIZE, ADR, MAXINT;
FROM Storage IMPORT ALLOCATE, DEALLOCATE;
IMPORT Strings; FROM Strings IMPORT String, CaseMode, Comparison;
FROM CharCodes IMPORT CapitalCh;

IMPORT Slist;

CONST HashTableUpb = 4096;      (* nominal max size *)

TYPE
    HashPtr = POINTER TO Hash;
    Hash = RECORD
            link: HashPtr;
            s: String;
            value: WORD;
        END (* record *);

    HashId = HashPtr;
    HashTable = POINTER TO RECORD
            size: CARDINAL;
            caseMode: CaseMode;
            table: POINTER TO ARRAY [0 .. HashTableUpb] OF HashPtr;
        END (* record *);

VAR
    hashval: CARDINAL;

PROCEDURE NewC(s: CARDINAL; cM: CaseMode): HashTable;
    VAR
        i: CARDINAL;
        ht: HashTable;
    BEGIN
      NEW(ht);
      WITH ht^ DO
        size := s;
        caseMode := cM;
        ALLOCATE(table, s*TSIZE(HashPtr));
        FOR i := 0 TO s-1 DO
            table^[i] := NIL;
        END (* for *);
      END (* with *);
      RETURN ht;
    END NewC;

PROCEDURE New(s: CARDINAL): HashTable;
  BEGIN
    RETURN NewC(s, ConsiderCase);
  END New;
  
PROCEDURE Dispose(VAR ht: HashTable);
    VAR
        h, nh: HashId;
        i: CARDINAL;
    BEGIN
      WITH ht^ DO
        FOR i := 0 TO size-1 DO
            IF table^[i] # NIL THEN
                h := table^[i];
                WHILE h # NIL DO
                    nh := h^.link;
                    Strings.Dispose(h^.s);
                    DISPOSE(h);
                    h := nh;
                END (* while *);
            END (* if *);
        END (* for *);
        DEALLOCATE(table, size*TSIZE(HashPtr));
      END (* with *);
      DISPOSE(ht);
      ht := NIL;
    END Dispose;

PROCEDURE EnterChars(ht: HashTable; chars: ARRAY OF CHAR; 
                     VAR h: HashId): BOOLEAN;
    BEGIN
        IF LookupChars(ht, chars, h) THEN
            RETURN FALSE;
        ELSE
            NEW(h);
            h^.s := Strings.CopyCS(chars);
            Slist.Add(ht^.table^[hashval], h);
            RETURN TRUE;
        END (* if *);
    END EnterChars;

PROCEDURE EnterString(ht: HashTable; s: String; 
                     VAR h: HashId): BOOLEAN;
    BEGIN
        IF LookupString(ht, s, h) THEN
            RETURN FALSE;
        ELSE
            NEW(h);
            h^.s := Strings.CopySS(s);
            Slist.Add(ht^.table^[hashval], h);
            RETURN TRUE;
        END (* if *);
    END EnterString;

PROCEDURE LookupString(ht: HashTable; s: String;
                      VAR h: HashId): BOOLEAN;
    BEGIN
        h := ComputeHashVal(ht, s, MAXINT);
        WHILE h # NIL DO
          IF ht^.caseMode = ConsiderCase THEN
            IF (s^[0] = h^.s^[0]) AND 
               Strings.EqualSS(s, h^.s) THEN
                RETURN TRUE;
            END (* if *);
          ELSE
            IF (CapitalCh(s^[0]) = CapitalCh(h^.s^[0])) AND
              (Strings.CompareSS(s, h^.s, IgnoreCase) = EQ) THEN
                RETURN TRUE;
            END;
          END;
          h := h^.link;
        END (* while *);
        RETURN FALSE;
    END LookupString;

PROCEDURE LookupChars(ht: HashTable; chars: ARRAY OF CHAR;
                      VAR h: HashId): BOOLEAN;
    BEGIN
        h := ComputeHashVal(ht, String(ADR(chars)), HIGH(chars));
        WHILE h # NIL DO
          IF ht^.caseMode = ConsiderCase THEN
            IF (chars[0] = h^.s^[0]) AND 
               Strings.EqualCS(chars, h^.s) THEN
                RETURN TRUE;
            END (* if *);
          ELSE
            IF (CapitalCh(chars[0]) = CapitalCh(h^.s^[0])) AND
              (Strings.CompareCS(chars, h^.s, IgnoreCase) = EQ) THEN
                RETURN TRUE;
            END;
          END;
          h := h^.link;
        END (* while *);
        RETURN FALSE;
    END LookupChars;

PROCEDURE ComputeHashVal(ht: HashTable; s: String; limit: CARDINAL): HashId;
    VAR
        i: CARDINAL;
        lhashval: CARDINAL;
  BEGIN
        i := 0; lhashval := 0;
        IF ht^.caseMode = ConsiderCase THEN
          WHILE (s^[i] # 0C) AND (i <= limit) DO
              INC(lhashval, CARDINAL(s^[i]));
              INC(i);
          END (* while *);
        ELSE
          WHILE (s^[i] # 0C) AND (i <= limit) DO
              INC(lhashval, CARDINAL(CapitalCh(s^[i])));
              INC(i);
          END (* while *);
        END;

        lhashval := lhashval MOD ht^.size;
        hashval := lhashval;
        RETURN ht^.table^[lhashval];
  END ComputeHashVal;

PROCEDURE Assoc(ht: HashTable; h: HashId; w: WORD);
(*  Since elements are actually identified by addresses
    which are unique across all hash tables, 'ht' is redundant.
*)
    BEGIN
        h^.value := w;
    END Assoc;

PROCEDURE Retrieve(ht: HashTable; h: HashId): WORD;
    BEGIN
        RETURN h^.value;
    END Retrieve;

PROCEDURE StringAt(ht: HashTable; h: HashId): String;
    BEGIN
        RETURN h^.s;
    END StringAt;

PROCEDURE CharsAt(ht: HashTable; h: HashId; VAR chars: ARRAY OF CHAR);
BEGIN
    Strings.CopySC(h^.s, chars);
END CharsAt;

END HashStrings.

(*
$Log:	HashStrings.mod,v $
Revision 1.3  85/06/04  18:05:24  mjj
Make Dispose set argument to NIL. 
Fix storage leak in Dispose (not disposing copied strings)

Revision 1.2  85/04/10  11:56:10  mjj
Add case-insensitive hashing.

*)