gpcp/NameHash.cp

   1 (* ==================================================================== *)
   2 (*                                                                      *)
   3 (*  NameHash Module for the Gardens Point Component Pascal Compiler.    *)
   4 (*  Implements the main symbol hash table. Uses closed hashing algrthm  *)
   5 (*      Copyright (c) John Gough 1999, 2000.                            *)
   6 (*                                                                      *)
   7 (* ==================================================================== *)
   8
   9 MODULE NameHash;
  10
  11   IMPORT
  12         GPCPcopyright,
  13         Console,
  14         GPText,
  15         V := LitValue,
  16         CPascalS,
  17         RTS;
  18
  19 (* ============================================================ *)
  20
  21   VAR
  22     name      : POINTER TO ARRAY OF V.CharOpen;
  23     size-     : INTEGER;
  24     entries-  : INTEGER;
  25     mainBkt*  : INTEGER;
  26     winMain*  : INTEGER;
  27     staBkt*   : INTEGER;
  28
  29 (* ============================================================ *)
  30   PROCEDURE^ enterStr*(IN str : ARRAY OF CHAR) : INTEGER;
  31 (* ============================================================ *)
  32
  33   PROCEDURE Reset;
  34     VAR i : INTEGER;
  35   BEGIN
  36     FOR i := 0 TO size-1 DO name[i] := NIL END;
  37   END Reset;
  38
  39 (* -------------------------------------------- *)
  40
  41   PROCEDURE InitNameHash*(nElem : INTEGER);
  42   BEGIN
  43     IF    nElem <=  4099 THEN nElem :=  4099;
  44     ELSIF nElem <=  8209 THEN nElem :=  8209;
  45     ELSIF nElem <= 12289 THEN nElem := 12289;
  46     ELSIF nElem <= 18433 THEN nElem := 18433;
  47     ELSIF nElem <= 32833 THEN nElem := 32833;
  48     ELSIF nElem <= 46691 THEN nElem := 46691;
  49     ELSE  nElem := 65521;
  50     END;
  51     IF (name # NIL) & (size >= nElem) THEN
  52       Reset();
  53     ELSE
  54       size := nElem;
  55       NEW(name, nElem);
  56     END;
  57     entries := 0;
  58     mainBkt := enterStr("CPmain");
  59     winMain := enterStr("WinMain");
  60     staBkt  := enterStr("STA");
  61   END InitNameHash;
  62
  63 (* ============================================================ *)
  64
  65   PROCEDURE HashtableOverflow();
  66     CONST str = "Overflow: Use -hsize > current ";
  67   BEGIN
  68     RTS.Throw(str + V.intToCharOpen(size)^);
  69   END HashtableOverflow;
  70
  71 (* ============================================================ *)
  72
  73   PROCEDURE hashStr(IN str : ARRAY OF CHAR) : INTEGER;
  74     VAR tot : INTEGER;
  75         idx : INTEGER;
  76         len : INTEGER;
  77   BEGIN [UNCHECKED_ARITHMETIC]
  78     (* need to turn off overflow checking *)
  79     len := LEN(str$);
  80     tot := 0;
  81     FOR idx := 0 TO len-1 DO
  82       INC(tot, tot);
  83       IF tot < 0 THEN INC(tot) END;
  84       INC(tot, ORD(str[idx]));
  85     END;
  86     RETURN tot MOD size;
  87   END hashStr;
  88
  89 (* -------------------------------------------- *)
  90
  91   PROCEDURE hashSubStr(pos,len : INTEGER) : INTEGER;
  92     VAR tot : INTEGER;
  93         idx : INTEGER;
  94   BEGIN [UNCHECKED_ARITHMETIC]
  95     (* need to turn off overflow checking *)
  96     tot := 0;
  97     FOR idx := 0 TO len-1 DO
  98       INC(tot, tot);
  99       IF tot < 0 THEN INC(tot) END;
 100       INC(tot, ORD(CPascalS.charAt(pos+idx)));
 101     END;
 102     RETURN tot MOD size;
 103   END hashSubStr;
 104
 105 (* -------------------------------------------- *)
 106
 107   PROCEDURE equalSubStr(val : V.CharOpen; pos,len : INTEGER) : BOOLEAN;
 108     VAR i : INTEGER;
 109   BEGIN
 110    (*
 111     * LEN(val) includes the terminating nul character.
 112     *)
 113     IF LEN(val) # len+1 THEN RETURN FALSE END;
 114     FOR i := 0 TO len-1 DO
 115       IF CPascalS.charAt(pos+i) # val[i] THEN RETURN FALSE END;
 116     END;
 117     RETURN TRUE;
 118   END equalSubStr;
 119
 120 (* -------------------------------------------- *)
 121
 122   PROCEDURE equalStr(val : V.CharOpen; IN str : ARRAY OF CHAR) : BOOLEAN;
 123     VAR i : INTEGER;
 124   BEGIN
 125    (*
 126     * LEN(val) includes the terminating nul character.
 127     * LEN(str$) does not include the nul character.
 128     *)
 129     IF LEN(val) # LEN(str$)+1 THEN RETURN FALSE END;
 130     FOR i := 0 TO LEN(val)-1 DO
 131       IF str[i] # val[i] THEN RETURN FALSE END;
 132     END;
 133     RETURN TRUE;
 134   END equalStr;
 135
 136 (* -------------------------------------------- *)
 137
 138   PROCEDURE enterStr*(IN str : ARRAY OF CHAR) : INTEGER;
 139     VAR step : INTEGER;
 140         key  : INTEGER;
 141         val  : V.CharOpen;
 142   BEGIN
 143     step := 1;
 144     key  := hashStr(str);
 145     val  := name[key];
 146     WHILE (val # NIL) & ~equalStr(val,str) DO
 147       INC(key, step);
 148       INC(step,2);
 149       IF step >= size THEN HashtableOverflow() END;
 150       IF key >= size THEN DEC(key,size) END; (* wrap-around *)
 151       val := name[key];
 152     END;
 153    (* Loop has been exitted. But for which reason? *)
 154     IF val = NIL THEN
 155       INC(entries);
 156       name[key] := V.strToCharOpen(str);
 157     END;                                (* ELSE val already in table ... *)
 158     RETURN key;
 159   END enterStr;
 160
 161 (* -------------------------------------------- *)
 162
 163   PROCEDURE enterSubStr*(pos,len : INTEGER) : INTEGER;
 164     VAR step : INTEGER;
 165         key  : INTEGER;
 166         val  : V.CharOpen;
 167   BEGIN
 168     step := 1;
 169     key  := hashSubStr(pos,len);
 170     val  := name[key];
 171     WHILE (val # NIL) & ~equalSubStr(val,pos,len) DO
 172       INC(key, step);
 173       INC(step,2);
 174       IF step >= size THEN HashtableOverflow() END;
 175       IF key >= size THEN DEC(key,size) END; (* wrap-around *)
 176       val := name[key];
 177     END;
 178    (* Loop has been exitted. But for which reason? *)
 179     IF val = NIL THEN
 180       INC(entries);
 181       name[key] := V.subStrToCharOpen(pos,len);
 182     END;                                (* ELSE val already in table ... *)
 183     RETURN key;
 184   END enterSubStr;
 185
 186 (* -------------------------------------------- *)
 187
 188   PROCEDURE charOpenOfHash*(hsh : INTEGER) : V.CharOpen;
 189   BEGIN
 190     RETURN name[hsh];
 191   END charOpenOfHash;
 192
 193 (* ============================================================ *)
 194 BEGIN (* ====================================================== *)
 195 END NameHash. (* =========================================== *)
 196 (* ============================================================ *)
 197