Topspeed_JPI/TS/REP16/HASH.MOD

IMPLEMENTATION MODULE Hash;
(*
 *  REPERTOIRE
 *  Release 1.6
 *  By Charles Bradford and Cole Brecheen
 *  (c) Copyright 1985-1992 PMI
 *  Green Bay, Wisconsin
 *  All rights reserved
 *  (414) 468-6040
 *
 *  $Header:   D:/logfiles/mods/hash.mov   1.5   10 Mar 1991 15:28:22   coleb  $
 *
 *
 *  Written and contributed by Jonathan March, of San Francisco.
 *
 *)


(* This module must be compiled with all runtime arithmetic checking
   turned off.  The Compute procedure depends on an overflow. *)

(*# check(overflow => off) *)
  (* This turns off overflow checking for the JPI compiler. *)

(*/NOCHECK:O*)
  (* And this does it for Stony Brook. *)

IMPORT ErrorManager;
IMPORT LowLevel;
IMPORT SYSTEM;
IMPORT VStorage;


VAR
  Initialized : BOOLEAN;

  PROCEDURE Init();
    BEGIN
      IF Initialized THEN
        RETURN;
      ELSE
        Initialized := TRUE;
      END;
      ErrorManager.Init();
      LowLevel.Init();
      VStorage.Init();
    END Init;

CONST
  MaxTable = 999;
  (* Note: this is just an error-checking limit. The table is allocated *)
  (* dynamically, so MaxTable is just an upper limit to that allocation. *)
  (* It can be changed with no side effects if desired. *)

  InitCodeValue = 25967;     (* arbitrary. *)

TYPE HashTable = POINTER TO HashHeader;

TYPE
  NodePtr = POINTER TO Node;

  Node    =
    RECORD
      next : NodePtr;
        (* next node in this bin in hash table *)
      hash2, hash3 : CARDINAL;
        (* stored in lieu of actual key *)
      hData : ARRAY [0..1] OF SYSTEM.BYTE;
        (* Dummy. Data is actually longer... *)
    END; (* record  *)

  BinHeader =
    RECORD
      first : NodePtr;
      binCount : CARDINAL;      (* diagnostic use only. *)
    END; (* record  *)

  HashArray  = ARRAY [0..MaxTable-1] OF BinHeader;

  HashHeader =
    RECORD
      initCode     : CARDINAL; (* will be InitCodeValue if initialized. *)
      binCount     : CARDINAL; (* n of bins in hash table *)
      tableCount   : CARDINAL; (* n entries currently in table. *)
      dataSize     : CARDINAL; (* n bytes of user data per entry *)
      nodeSize     : CARDINAL; (* n bytes allocated per entry *)
      tablePtr     : POINTER TO HashArray; (* array of bin headers *)
      currentBinNum: CARDINAL; (* index of last bin accessed *)
      currentNode  : NodePtr;  (* last node accessed. NIL if none. *)
      parentNode   : NodePtr;  (* parent node of currentNode. NIL if top. *)
    END; (* record  *)


PROCEDURE Define
          ( VAR table        : HashTable;         (* out *)
                numberBins   : CARDINAL;          (* in *)
                dataBytes    : CARDINAL           (* in - bytes per data *)
          );
  (* Create and initialize a hash table. Number of bins would typically be
  about the same as the number of expected entries; more for speed, less
  for space saving. The number of bins will be increased by 1 if even.
  Note that the size of all user data in this table will be required to
  be "dataBytes" *)
  VAR
    i : CARDINAL;
BEGIN (* procedure HashDefine *)
  IF (numberBins<2) OR (numberBins>MaxTable) THEN
    ErrorManager.CallHalt(
        "Programmer error initializing hash table: bad table size.");
  END; (* if numberBins *)
  VStorage.DosAlloc(table, SYSTEM.TSIZE(HashHeader) );
  WITH table^ DO
    binCount := CARDINAL( BITSET(numberBins) + BITSET(1)); (* force odd *)
    dataSize  := dataBytes;            (* bytes of user data per element *)
    nodeSize := SYSTEM.TSIZE( Node) - 2 + dataSize;
      (* byte allocated per element. *)
    tableCount:= 0;
    currentBinNum := 0;
    currentNode := NIL;
    parentNode  := NIL;
    VStorage.DosAlloc( tablePtr, SYSTEM.TSIZE( BinHeader) * binCount );
    FOR i := 0 TO binCount-1  DO
      WITH tablePtr^[i] DO
        first := NIL;
        binCount := 0;
      END; (* with tablePtr *)
    END; (* for i *)
    initCode := InitCodeValue;
  END; (* with table *)
END Define; (* procedure  *)


PROCEDURE Dispose( VAR table : HashTable);    (* out *)
  (* releases all memory associated with the table. Table becomes NIL. *)
  (* Does nothing if table was not initialized. *)
  VAR
    pNode, qNode : NodePtr;
    count, iNode : CARDINAL;
BEGIN (* procedure HashDispose *)
  count := 0;
  IF table # NIL THEN
    WITH table^ DO
      IF initCode = InitCodeValue THEN
        FOR iNode := 0 TO binCount-1  DO
          WITH tablePtr^[iNode] DO
            pNode := first;
            WHILE pNode # NIL DO
              INC( count);
              qNode := pNode^.next;
              VStorage.DosDealloc( pNode, nodeSize);
              pNode := qNode;
            END; (* while pNode *)
          END; (* with tablePtr *)
        END; (* for iNode *)
        VStorage.DosDealloc( tablePtr, SYSTEM.TSIZE( BinHeader)* binCount);
        IF count # tableCount THEN
          ErrorManager.CallHalt( "Hash table memory corruption detected.");
        END; (* if count *)
      END; (* if initCode *)
      initCode := 0;         (* in case memory location is re-used. *)
    END; (* with table *)
    VStorage.DosDealloc( table, SYSTEM.TSIZE(HashHeader) );
  END; (* if table *)
END Dispose; (* procedure  *)


PROCEDURE InitCheck(table : HashTable);
  (* Internal only *)
BEGIN (* procedure InitCheck *)
  IF (table = NIL) OR (table^.initCode # InitCodeValue) THEN
    ErrorManager.CallHalt( "Programmer error: uninitialized hash table.");
  END; (* if table *)
END InitCheck; (* procedure  *)

(* ALL THE FOLLOWING PROCEDURES WILL HALT THE PROGRAM IF CALLED WITH AN *)
(* UNINITIALIZED TABLE. Initialization is the programmer's responsibility. *)


(*$O-*)
PROCEDURE Compute(      key : ARRAY OF SYSTEM.BYTE;
                     VAR hash1, hash2, hash3 : CARDINAL);
  (* return 3 independent hashed values of the key. *)
  VAR
    i, j, in1, in2 : CARDINAL;
    temp1, temp2, temp3 : CARDINAL;
BEGIN (* procedure Compute *)
  (*$R-*)(*$T-*)
  temp1 :=  5555H;
  temp2 :=  9753H;
  temp3 := 0E069H;
  j := HIGH(key);
  FOR i := 0 TO HIGH(key)  DO
    (* Each byte of the key is used twice, symmetrically at opposite ends *)
    (* of the hashing. Thus, for example, keys differing only in the last *)
    (* byte will end up hashed completely differently. *)
    in1 := ORD(key[i]);
    in2 := ORD(key[j]);
    DEC(j);
    temp1:= CARDINAL( BITSET(temp1*2) / BITSET(in1*8) / BITSET(temp2) ) +
            temp3 DIV 128 - in2*128;
    temp2:= CARDINAL( BITSET(temp2*4) / BITSET(in1*512 + in2) ) -
            temp1 DIV 64 + temp3;
    temp3:= CARDINAL( BITSET(temp3 DIV 4 - in1) / BITSET(in2*256) ) +
            temp2 * 64 + temp1;
  END; (* for i *)
  hash1 := temp1;
  hash2 := temp2;
  hash3 := temp3;
  (*$R=*)(*$T=*)
END Compute; (* procedure  *)


PROCEDURE KeyFind
          (     table        : HashTable;         (* in *)
                key          : ARRAY OF SYSTEM.BYTE (* in - key to look for *)
          )                  : BOOLEAN;           (* out - key found? *)
  (* See if an entry with this key already exists in this hash table. *)
  VAR
    h1, h2, h3 : CARDINAL;
BEGIN (* procedure KeyFind *)
  InitCheck(table);
  WITH table^ DO
    Compute( key, h1, h2, h3);
    currentBinNum := h1 MOD binCount;
    currentNode := tablePtr^[currentBinNum].first;
    parentNode  := NIL;
    WHILE currentNode # NIL DO
      WITH currentNode^ DO
        IF (h2=hash2) AND (h3=hash3) THEN
          RETURN TRUE;
        END; (* if h2 *)
      END; (* with currentNode *)
      (* no match yet, try the next node in linked list, if any: *)
      parentNode := currentNode;
      currentNode := currentNode^.next;
    END; (* while currentNode *)
    (* no match in the list. *)
    RETURN FALSE;
  END; (* with table *)
END KeyFind; (* procedure  *)


PROCEDURE Insert
          (     table        : HashTable;         (* in/(out) *)
                key          : ARRAY OF SYSTEM.BYTE; (* in - must be unique *)
                data         : ARRAY OF SYSTEM.BYTE (* in - always same size.*)
          );
  (* Halts program if attempt is made to insert a duplicate key.
  This is a partial safeguard against (extremely unlikely) false key matching.
  First call KeyFind if you want to check for a duplicate before
  inserting. *)
  (* Inefficient, because computes the hash twice. *****  *)
  VAR
    h1 : CARDINAL;
    nodeBytes : CARDINAL;
BEGIN (* procedure HashInsert *)
  IF KeyFind( table, key) THEN
    ErrorManager.CallHalt(
        "Programmer error or hash algorithm failure. Duplicate hash key.");
  END; (* if KeyFind *)
  WITH table^ DO
    IF dataSize # (HIGH(data)+1) THEN
      ErrorManager.CallHalt(
          "Programmer error calling HashInsert: wrong data size.");
    END; (* if dataSize *)
    parentNode := NIL;
    (* allocate amount actually needed for node. *)
    VStorage.DosAlloc( currentNode, nodeSize);
    WITH currentNode^ DO
      LowLevel.Move( SYSTEM.ADR(data), SYSTEM.ADR(hData), dataSize);
      Compute( key, h1, hash2, hash3);
    END; (* with currentNode *)
    currentBinNum := h1 MOD binCount; (* redundant, because of KeyFind. *)
    WITH tablePtr^[currentBinNum] DO
      currentNode^.next := first;
      first := currentNode;
      INC(binCount);
    END; (* with tablePtr *)
    INC( tableCount);
  END; (* with table *)
END Insert; (* procedure  *)


PROCEDURE Delete( table : HashTable);
  (* Deletes hash table entry associated with the last Insert or KeyFind. *)
  (* Has no effect if that element was never found or was already deleted. *)
  VAR
    nextNode : NodePtr;
BEGIN (* procedure HashDelete *)
  InitCheck(table);
  WITH table^ DO
    IF currentNode # NIL THEN
      DEC( tableCount);
      nextNode := currentNode^.next;
      VStorage.DosDealloc( currentNode, nodeSize);
      WITH tablePtr^[ currentBinNum] DO
        DEC( binCount);
        IF parentNode = NIL THEN
          first := nextNode;
        ELSE
          parentNode^.next := nextNode;
        END; (* if parentNode *)
      END; (* with tablePtr *)
    END; (* if currentNode *)
  END; (* with table *)
END Delete; (* procedure  *)


PROCEDURE MoveData( table    : HashTable;
                    pIn, pOut : SYSTEM.ADDRESS;
                    dataHigh : CARDINAL);
  (* used in HashGetData and HashChangeData. *)
BEGIN (* procedure DataCheck *)
  WITH table^ DO
    IF (currentNode = NIL) OR (dataSize # dataHigh+1) THEN
      ErrorManager.CallHalt(
          "Programmer error. Attempt to access hash element.");
    END; (* if currentNode *)
    LowLevel.Move( pIn, pOut, dataSize);
  END; (* with table *)
END MoveData; (* procedure  *)


PROCEDURE GetData
          (     table        : HashTable;         (* in *)
            VAR data         : ARRAY OF SYSTEM.BYTE (* out - size must match. *)
          );
  (* Gets the data associated with the last Insert or KeyFind. *)
  (* Fails if no such element or size does not match. *)
BEGIN (* procedure HashGetData *)
  InitCheck( table);
  MoveData(table, SYSTEM.ADR(table^.currentNode^.hData),
      SYSTEM.ADR(data), HIGH(data) );
END GetData; (* procedure  *)


PROCEDURE ChangeData
          (     table        : HashTable;         (* in *)
                data         : ARRAY OF SYSTEM.BYTE (* in - size must match. *)
          );
  (* Changes the data associated with the last Insert or KeyFind. *)
  (* Fails if no such element or size does not match. *)
BEGIN (* procedure HashChangeData *)
  InitCheck( table);
  MoveData(table, SYSTEM.ADR(data),
      SYSTEM.ADR(table^.currentNode^.hData), HIGH(data) );
END ChangeData; (* procedure  *)

PROCEDURE Size( table : HashTable) : CARDINAL;
  (* returns the number of data entries in the hash table. *)
BEGIN (* procedure HashSize *)
  IF (table=NIL) OR (table^.initCode # InitCodeValue) THEN
    RETURN 0;
  END; (* if table *)
  RETURN table^.tableCount;
END Size; (* procedure  *)

BEGIN
  Initialized := FALSE;
  Init();
END Hash. (* implementation module *)