UNSAFE MODULE HashWord;

(***************************************************************************)
(*                      Copyright (C) Olivetti 1989                        *)
(*                          All Rights reserved                            *)
(*                                                                         *)
(* Use and copy of this software and preparation of derivative works based *)
(* upon this software are permitted to any person, provided this same      *)
(* copyright notice and the following Olivetti warranty disclaimer are     *) 
(* included in any copy of the software or any modification thereof or     *)
(* derivative work therefrom made by any person.                           *)
(*                                                                         *)
(* This software is made available AS IS and Olivetti disclaims all        *)
(* warranties with respect to this software, whether expressed or implied  *)
(* under any law, including all implied warranties of merchantibility and  *)
(* fitness for any purpose. In no event shall Olivetti be liable for any   *)
(* damages whatsoever resulting from loss of use, data or profits or       *)
(* otherwise arising out of or in connection with the use or performance   *)
(* of this software.                                                       *)
(***************************************************************************)

(*
This implementation uses a hash table whose size is a power of two and 
doubles the size whenever it gets too full.  

The original implementation was written by William Stoye of Acorn Computers
Ltd., Cambridge, England.
*)

IMPORT Thread;
IMPORT Word;

TYPE
  EntryStatus = {New, Old};

  Entry = RECORD
    r: Word.T := NullEntry;
    val: REFANY := NIL;
  END;

  Entries = REF ARRAY OF Entry;

  Id = INTEGER;

REVEAL
  Table = Thread.Mutex BRANDED OBJECT
    size: INTEGER;  (* size must be a power of 2 *)
    entries: Entries;
    generation := FIRST(INTEGER);
    slotsFilled, maxSlotsFilled: INTEGER;
  END;


CONST
  DefaultSize = 4096;

TYPE
  Bitset = SET OF [0..Word.Size-1];

<*INLINE*> PROCEDURE WordHash(mask: INTEGER; k: Word.T): INTEGER RAISES {} =
  BEGIN
    RETURN 
     LOOPHOLE(LOOPHOLE(mask, Bitset) * LOOPHOLE(k, Bitset), INTEGER);
  END WordHash;

PROCEDURE New(s: CARDINAL := 0): Table RAISES {} =
  VAR  
    ht := NEW(Table);
    size2: INTEGER;
  BEGIN
    IF s = 0 THEN 
      s := DefaultSize
    ELSE
      (* adjust size to next larger power of 2 *)
      size2 := 32; (* the min size table *)
      WHILE size2 < s DO
        INC(size2, size2);
      END;
      s := size2;
    END;
    ht.size := s;
    ht.entries := NEW(Entries, s);

    ht.maxSlotsFilled := 3 * (s DIV 4);
    ht.slotsFilled := 0;
    RETURN ht;
  END New;

(* This routine must return because the table must have at least one empty
   entry.
*)
PROCEDURE Find(e: Entries;
               r: Word.T;
               mask: INTEGER;
               VAR (*out*) id: Id): EntryStatus RAISES {}=
  VAR
    entry: Entry;
  BEGIN
    id := WordHash(mask, r);
    LOOP
      entry := e[id];
      IF entry.r = NullEntry THEN RETURN EntryStatus.New;
      ELSIF entry.r = r THEN RETURN EntryStatus.Old;
      ELSE 
        (* mod arithmetic par excellence.  Wraps around at end of array *)
        id := LOOPHOLE(LOOPHOLE(mask, Bitset) * LOOPHOLE(id+1, Bitset), Id);
      END;
    END;
  END Find;

PROCEDURE Enter(ht: Table; r: Word.T; v: REFANY := NIL): BOOLEAN RAISES {} =
  VAR
    oldSize, newSize: INTEGER;
    oldEntries, newEntries: Entries;
    slotsFilled: INTEGER := 0;
    newMask: INTEGER;
    id, newId: Id;
  BEGIN
    WITH mask = ht.size - 1 DO

      CASE Find(ht.entries, r, mask, id) OF
      | EntryStatus.Old =>
          RETURN(FALSE);
      | EntryStatus.New =>
          INC(ht.slotsFilled);

          (* Now work out if we need to expand the table, before putting in the
             new entry:-
          *)
          IF ht.slotsFilled >= ht.maxSlotsFilled THEN (* rehash *)

            (* We need oldEntries later.  Efficient to load and use it now:- *)
            oldEntries := ht.entries;

            (*  new size is twice old:- *)
            oldSize := ht.size;
            newSize := oldSize + oldSize;
            INC(ht.maxSlotsFilled, ht.maxSlotsFilled);

            (* This table is generated without altering the current one.  We
               take care to ensure that other operations can occur in parallel
               with this.  NOTE that we have altered maxSlotsFilled already; 
               but this is ONLY used here in Enter.
            *)
            newEntries := NEW(Entries, newSize);
            newMask := newSize - 1;

            FOR i := 0 TO oldSize - 1 DO
              WITH oldEntry = oldEntries^[i] DO
                IF (oldEntry.r # NullEntry) THEN 
                  (* MUST be a new entry *)
                  EVAL(Find(newEntries,
                            oldEntry.r,
                            newMask,
                            newId));
                  WITH newEntry = newEntries[newId] DO
                    newEntry := oldEntry;
                  END;
                  INC(slotsFilled);
                END;
              END; (* with *)
            END (*for*);

            ht.size := newSize;
            ht.entries := newEntries;
            ht.slotsFilled := slotsFilled;

            (* now, repeat the lookup because everything has changed *)
            EVAL(Find(ht.entries, r, newMask, id));
          END;

      END;
      WITH e = ht.entries[id] DO
        e.r := r; e.val := v;
      END;
      INC(ht.generation);
      RETURN(TRUE);
    END;
  END Enter;

PROCEDURE Lookup(ht: Table; r: Word.T; VAR (*out*) v: REFANY): BOOLEAN RAISES {}=
  VAR 
    rc: BOOLEAN;
    id: Id;
  BEGIN
    rc := Find(ht.entries, r, ht.size - 1, id) = EntryStatus.Old;
    v := ht.entries[id].val;
    RETURN rc;
  END Lookup;

EXCEPTION BadRemove;

PROCEDURE Remove(ht: Table; r: Word.T) RAISES {}=
  VAR id: Id;
  BEGIN
    IF Find(ht.entries, r, ht.size-1, id) = EntryStatus.Old THEN
      ht.entries[id].r := NullEntry;
    ELSE
      RAISE BadRemove;
    END; (* if *)
  END Remove;


(* Iterator *)

REVEAL
  Iter = BRANDED OBJECT
    table: Table;
    id: Id;
    generation: INTEGER;
  END;


PROCEDURE NewIterator(table: Table): Iter RAISES {} =
  BEGIN
    RETURN NEW(Iter,
        table := table,
        id := 0,
        generation := table.generation);
  END NewIterator;


PROCEDURE Next(
    iter: Iter;
    VAR (*out*) key: Word.T;
    VAR (*out*) val: REFANY)
    : BOOLEAN
    RAISES {Broken} =
  VAR
    table := iter.table;
    entry: UNTRACED REF Entry;
  BEGIN
    IF iter.generation # table.generation THEN RAISE Broken END;
    WITH
      size = table.size,
      id = iter.id DO
      entry := ADR(table.entries[id]);
      LOOP 
        IF id >= size THEN RETURN FALSE;
        ELSIF entry.r # NullEntry THEN
          key := entry.r;
          val := entry.val;
          INC(id);
          RETURN(TRUE);
        ELSE
          INC(id);
          (*INC(entry, ADRSIZE(Entry));*) (* 1.6 BUG *)
          entry := entry + ADRSIZE(Entry);
        END;
      END;
    END;
  END Next;


BEGIN
END HashWord.