text: (* ==================================================================== *)
  (*									*)
  (*  NameHash Module for the Gardens Point Component Pascal Compiler.	*)
  (*  Implements the main symbol hash table. Uses closed hashing algrthm  *)
  (*	Copyright (c) John Gough 1999, 2000.				*)
  (*									*)
  (* ==================================================================== *)
  
  MODULE NameHash;
  
    IMPORT 
  	GPCPcopyright,
  	Console,
  	GPText,
  	V := LitValue,
  	CPascalS,
  	RTS;
  
  (* ============================================================ *)
  
    VAR
      name      : POINTER TO ARRAY OF V.CharOpen;
      size-     : INTEGER;
      entries-  : INTEGER;
      mainBkt*  : INTEGER;
      winMain*  : INTEGER;
      staBkt*   : INTEGER;
  
  (* ============================================================ *)
    PROCEDURE^ enterStr*(IN str : ARRAY OF CHAR) : INTEGER;
  (* ============================================================ *)
  
    PROCEDURE Reset;
      VAR i : INTEGER;
    BEGIN
      FOR i := 0 TO size-1 DO name[i] := NIL END;
    END Reset;
  
  (* -------------------------------------------- *)
  
    PROCEDURE InitNameHash*(nElem : INTEGER);
    BEGIN
      IF    nElem <=  4099 THEN nElem :=  4099;
      ELSIF nElem <=  8209 THEN nElem :=  8209;
      ELSIF nElem <= 12289 THEN nElem := 12289;
      ELSIF nElem <= 18433 THEN nElem := 18433;
      ELSIF nElem <= 32833 THEN nElem := 32833;
      ELSIF nElem <= 46691 THEN nElem := 46691;
      ELSE  nElem := 65521;
      END;
      IF (name # NIL) & (size >= nElem) THEN
        Reset();
      ELSE
        size := nElem;
        NEW(name, nElem); 
      END;
      entries := 0;
      mainBkt := enterStr("CPmain");
      winMain := enterStr("WinMain");
      staBkt  := enterStr("STA");
    END InitNameHash;
  
  (* ============================================================ *)
  
    PROCEDURE HashtableOverflow();
      CONST str = "Overflow: Use -hsize > current ";
    BEGIN
      RTS.Throw(str + V.intToCharOpen(size)^);
    END HashtableOverflow;
  
  
  
    PROCEDURE hashStr(IN str : ARRAY OF CHAR) : INTEGER;
      VAR tot : INTEGER;
  	idx : INTEGER;
  	len : INTEGER;
    BEGIN [UNCHECKED_ARITHMETIC]
      (* need to turn off overflow checking *)
      len := LEN(str$);
      tot := 0;
      FOR idx := 0 TO len-1 DO
        INC(tot, tot);
        IF tot < 0 THEN INC(tot) END;
        INC(tot, ORD(str[idx]));
      END;
      RETURN tot MOD size; 
    END hashStr;
  
  (* -------------------------------------------- *)
  
    PROCEDURE hashSubStr(pos,len : INTEGER) : INTEGER;
      VAR tot : INTEGER;
  	idx : INTEGER;
    BEGIN [UNCHECKED_ARITHMETIC]
      (* need to turn off overflow checking *)
      tot := 0;
      FOR idx := 0 TO len-1 DO
        INC(tot, tot);
        IF tot < 0 THEN INC(tot) END;
        INC(tot, ORD(CPascalS.charAt(pos+idx)));
      END;
      RETURN tot MOD size; 
    END hashSubStr;
  
  (* -------------------------------------------- *)
  
    PROCEDURE equalSubStr(val : V.CharOpen; pos,len : INTEGER) : BOOLEAN;
      VAR i : INTEGER;
    BEGIN
     (* 
      * LEN(val) includes the terminating nul character.
      *)
      IF LEN(val) # len+1 THEN RETURN FALSE END;
      FOR i := 0 TO len-1 DO
        IF CPascalS.charAt(pos+i) # val[i] THEN RETURN FALSE END;
      END;
      RETURN TRUE;
    END equalSubStr;
  
  (* -------------------------------------------- *)
  
    PROCEDURE equalStr(val : V.CharOpen; IN str : ARRAY OF CHAR) : BOOLEAN;
      VAR i : INTEGER;
    BEGIN
     (*
      * LEN(val) includes the terminating nul character.
      * LEN(str$) does not include the nul character.
      *)
      IF LEN(val) # LEN(str$)+1 THEN RETURN FALSE END;
      FOR i := 0 TO LEN(val)-1 DO
        IF str[i] # val[i] THEN RETURN FALSE END;
      END;
      RETURN TRUE;
    END equalStr;
  
  (* -------------------------------------------- *)
  
    PROCEDURE enterStr*(IN str : ARRAY OF CHAR) : INTEGER;
      VAR step : INTEGER;
  	key  : INTEGER;
  	val  : V.CharOpen;
    BEGIN
      step := 1;
      key  := hashStr(str);
      val  := name[key];
  
      WHILE (val # NIL) & ~equalStr(val,str) DO
  	 (* hash table collision, find new slot *)
        INC(key, step);
        INC(step,2); 
        IF step >= size THEN HashtableOverflow() END;
        IF key >= size THEN DEC(key,size) END; (* wrap-around *)
        val := name[key];
      END;
     (* Loop has been exitted. But for which reason? *)
      IF val = NIL THEN
        INC(entries);
        name[key] := V.strToCharOpen(str);
      END;				(* ELSE val already in table ... *)
      RETURN key;
    END enterStr;
  
  (* -------------------------------------------- *)
  
    PROCEDURE enterSubStr*(pos,len : INTEGER) : INTEGER;
      VAR step : INTEGER;
  	key  : INTEGER;
  	val  : V.CharOpen;
    BEGIN
      step := 1;
      key  := hashSubStr(pos,len);
      val  := name[key];
      WHILE (val # NIL) & ~equalSubStr(val,pos,len) DO
        INC(key, step);
        INC(step,2); 
        IF step >= size THEN HashtableOverflow() END;
        IF key >= size THEN DEC(key,size) END; (* wrap-around *)
        val := name[key];
      END;
     (* Loop has been exitted. But for which reason? *)
      IF val = NIL THEN
        INC(entries);
        name[key] := V.subStrToCharOpen(pos,len);
      END;				(* ELSE val already in table ... *)
      RETURN key;
    END enterSubStr;
  
  (* -------------------------------------------- *)
  
    PROCEDURE charOpenOfHash*(hsh : INTEGER) : V.CharOpen;
    BEGIN
      RETURN name[hsh];
    END charOpenOfHash;
  
  (* ============================================================ *)
  BEGIN (* ====================================================== *)
  END NameHash. (* =========================================== *)
  (* ============================================================ *)
  
  