Listing: 1 IMPLEMENTATION MODULE Hash; 2 (* 3 * REPERTOIRE 4 * Release 1.6 5 * By Charles Bradford and Cole Brecheen 6 * (c) Copyright 1985-1992 PMI 7 * Green Bay, Wisconsin 8 * All rights reserved 9 * (414) 468-6040 10 * 11 * $Header: D:/logfiles/mods/hash.mov 1.5 10 Mar 1991 15:28:22 coleb $ 12 * 13 * 14 * Written and contributed by Jonathan March, of San Francisco. 15 * 16 *) 17 18 19 (* This module must be compiled with all runtime arithmetic checking 20 turned off. The Compute procedure depends on an overflow. *) 21 22 (*# check(overflow => off) *) 23 (* This turns off overflow checking for the JPI compiler. *) 24 25 (*/NOCHECK:O*) 26 (* And this does it for Stony Brook. *) 27 28 IMPORT ErrorManager; 29 IMPORT LowLevel; 30 IMPORT SYSTEM; 31 IMPORT VStorage; 32 33 34 VAR 35 Initialized : BOOLEAN; 36 37 PROCEDURE Init(); 38 BEGIN 39 IF Initialized THEN 40 RETURN; 41 ELSE 42 Initialized := TRUE; 43 END; 44 ErrorManager.Init(); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 45 LowLevel.Init(); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 46 VStorage.Init(); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 47 END Init; ***** ^ not supported yet 48 49 CONST 50 MaxTable = 999; 51 (* Note: this is just an error-checking limit. The table is allocated *) 52 (* dynamically, so MaxTable is just an upper limit to that allocation. *) 53 (* It can be changed with no side effects if desired. *) 54 55 InitCodeValue = 25967; (* arbitrary. *) 56 57 TYPE HashTable = POINTER TO HashHeader; ***** ^ undeclared identifier 58 59 TYPE 60 NodePtr = POINTER TO Node; ***** ^ undeclared identifier 61 62 Node = 63 RECORD 64 next : NodePtr; 65 (* next node in this bin in hash table *) 66 hash2, hash3 : CARDINAL; 67 (* stored in lieu of actual key *) 68 hData : ARRAY [0..1] OF SYSTEM.BYTE; ***** ^ not supported yet ***** ^ not supported yet 69 (* Dummy. Data is actually longer... *) 70 END; (* record *) ***** ^ not supported yet 71 72 BinHeader = 73 RECORD 74 first : NodePtr; 75 binCount : CARDINAL; (* diagnostic use only. *) 76 END; (* record *) ***** ^ not supported yet 77 78 HashArray = ARRAY [0..MaxTable-1] OF BinHeader; ***** ^ not supported yet ***** ^ not supported yet 79 80 HashHeader = 81 RECORD 82 initCode : CARDINAL; (* will be InitCodeValue if initialized. *) 83 binCount : CARDINAL; (* n of bins in hash table *) 84 tableCount : CARDINAL; (* n entries currently in table. *) 85 dataSize : CARDINAL; (* n bytes of user data per entry *) 86 nodeSize : CARDINAL; (* n bytes allocated per entry *) 87 tablePtr : POINTER TO HashArray; (* array of bin headers *) ***** ^ not supported yet 88 currentBinNum: CARDINAL; (* index of last bin accessed *) 89 currentNode : NodePtr; (* last node accessed. NIL if none. *) 90 parentNode : NodePtr; (* parent node of currentNode. NIL if top. *) 91 END; (* record *) ***** ^ not supported yet 92 93 94 PROCEDURE Define 95 ( VAR table : HashTable; (* out *) 96 numberBins : CARDINAL; (* in *) 97 dataBytes : CARDINAL (* in - bytes per data *) 98 ); 99 (* Create and initialize a hash table. Number of bins would typically be 100 about the same as the number of expected entries; more for speed, less 101 for space saving. The number of bins will be increased by 1 if even. 102 Note that the size of all user data in this table will be required to 103 be "dataBytes" *) 104 VAR 105 i : CARDINAL; 106 BEGIN (* procedure HashDefine *) 107 IF (numberBins<2) OR (numberBins>MaxTable) THEN 108 ErrorManager.CallHalt( ***** ^ not supported yet ***** ^ not supported yet 109 "Programmer error initializing hash table: bad table size."); ***** ^ not supported yet 110 END; (* if numberBins *) 111 VStorage.DosAlloc(table, SYSTEM.TSIZE(HashHeader) ); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 112 WITH table^ DO ***** ^ not supported yet 113 binCount := CARDINAL( BITSET(numberBins) + BITSET(1)); (* force odd *) ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 114 dataSize := dataBytes; (* bytes of user data per element *) ***** ^ undeclared identifier 115 nodeSize := SYSTEM.TSIZE( Node) - 2 + dataSize; ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier 116 (* byte allocated per element. *) 117 tableCount:= 0; ***** ^ undeclared identifier 118 currentBinNum := 0; ***** ^ undeclared identifier 119 currentNode := NIL; ***** ^ undeclared identifier 120 parentNode := NIL; ***** ^ undeclared identifier 121 VStorage.DosAlloc( tablePtr, SYSTEM.TSIZE( BinHeader) * binCount ); ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier 122 FOR i := 0 TO binCount-1 DO ***** ^ undeclared identifier ***** ^ FOR needs integer variable and bounds 123 WITH tablePtr^[i] DO ***** ^ undeclared identifier ***** ^ not supported yet 124 first := NIL; ***** ^ undeclared identifier 125 binCount := 0; ***** ^ undeclared identifier 126 END; (* with tablePtr *) ***** ^ not supported yet 127 END; (* for i *) 128 initCode := InitCodeValue; ***** ^ undeclared identifier 129 END; (* with table *) ***** ^ not supported yet 130 END Define; (* procedure *) ***** ^ not supported yet 131 132 133 PROCEDURE Dispose( VAR table : HashTable); (* out *) 134 (* releases all memory associated with the table. Table becomes NIL. *) 135 (* Does nothing if table was not initialized. *) 136 VAR 137 pNode, qNode : NodePtr; ***** ^ not supported yet 138 count, iNode : CARDINAL; 139 BEGIN (* procedure HashDispose *) 140 count := 0; 141 IF table # NIL THEN ***** ^ not supported yet 142 WITH table^ DO ***** ^ not supported yet 143 IF initCode = InitCodeValue THEN ***** ^ undeclared identifier 144 FOR iNode := 0 TO binCount-1 DO ***** ^ undeclared identifier ***** ^ FOR needs integer variable and bounds 145 WITH tablePtr^[iNode] DO ***** ^ undeclared identifier ***** ^ not supported yet 146 pNode := first; ***** ^ not supported yet ***** ^ undeclared identifier 147 WHILE pNode # NIL DO ***** ^ not supported yet 148 INC( count); ***** ^ undeclared identifier ***** ^ not supported yet 149 qNode := pNode^.next; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 150 VStorage.DosDealloc( pNode, nodeSize); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier 151 pNode := qNode; ***** ^ not supported yet ***** ^ not supported yet 152 END; (* while pNode *) 153 END; (* with tablePtr *) ***** ^ not supported yet 154 END; (* for iNode *) 155 VStorage.DosDealloc( tablePtr, SYSTEM.TSIZE( BinHeader)* binCount); ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier 156 IF count # tableCount THEN ***** ^ undeclared identifier ***** ^ undeclared identifier 157 ErrorManager.CallHalt( "Hash table memory corruption detected."); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 158 END; (* if count *) 159 END; (* if initCode *) 160 initCode := 0; (* in case memory location is re-used. *) ***** ^ undeclared identifier 161 END; (* with table *) ***** ^ not supported yet 162 VStorage.DosDealloc( table, SYSTEM.TSIZE(HashHeader) ); ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 163 END; (* if table *) 164 END Dispose; (* procedure *) ***** ^ not supported yet 165 166 167 PROCEDURE InitCheck(table : HashTable); 168 (* Internal only *) 169 BEGIN (* procedure InitCheck *) 170 IF (table = NIL) OR (table^.initCode # InitCodeValue) THEN ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 171 ErrorManager.CallHalt( "Programmer error: uninitialized hash table."); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 172 END; (* if table *) 173 END InitCheck; (* procedure *) ***** ^ not supported yet 174 175 (* ALL THE FOLLOWING PROCEDURES WILL HALT THE PROGRAM IF CALLED WITH AN *) 176 (* UNINITIALIZED TABLE. Initialization is the programmer's responsibility. *) 177 178 179 (*$O-*) 180 PROCEDURE Compute( key : ARRAY OF SYSTEM.BYTE; ***** ^ not supported yet 181 VAR hash1, hash2, hash3 : CARDINAL); 182 (* return 3 independent hashed values of the key. *) 183 VAR 184 i, j, in1, in2 : CARDINAL; 185 temp1, temp2, temp3 : CARDINAL; 186 BEGIN (* procedure Compute *) 187 (*$R-*)(*$T-*) 188 temp1 := 5555H; 189 temp2 := 9753H; 190 temp3 := 0E069H; 191 j := HIGH(key); ***** ^ undeclared identifier ***** ^ not supported yet 192 FOR i := 0 TO HIGH(key) DO ***** ^ undeclared identifier ***** ^ not supported yet 193 (* Each byte of the key is used twice, symmetrically at opposite ends *) 194 (* of the hashing. Thus, for example, keys differing only in the last *) 195 (* byte will end up hashed completely differently. *) 196 in1 := ORD(key[i]); ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 197 in2 := ORD(key[j]); ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 198 DEC(j); ***** ^ undeclared identifier ***** ^ not supported yet 199 temp1:= CARDINAL( BITSET(temp1*2) / BITSET(in1*8) / BITSET(temp2) ) + ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 200 temp3 DIV 128 - in2*128; 201 temp2:= CARDINAL( BITSET(temp2*4) / BITSET(in1*512 + in2) ) - ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 202 temp1 DIV 64 + temp3; 203 temp3:= CARDINAL( BITSET(temp3 DIV 4 - in1) / BITSET(in2*256) ) + ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 204 temp2 * 64 + temp1; 205 END; (* for i *) 206 hash1 := temp1; 207 hash2 := temp2; 208 hash3 := temp3; 209 (*$R=*)(*$T=*) 210 END Compute; (* procedure *) ***** ^ not supported yet 211 212 213 PROCEDURE KeyFind 214 ( table : HashTable; (* in *) 215 key : ARRAY OF SYSTEM.BYTE (* in - key to look for *) ***** ^ not supported yet 216 ) : BOOLEAN; (* out - key found? *) 217 (* See if an entry with this key already exists in this hash table. *) 218 VAR 219 h1, h2, h3 : CARDINAL; 220 BEGIN (* procedure KeyFind *) 221 InitCheck(table); ***** ^ not supported yet ***** ^ not supported yet 222 WITH table^ DO ***** ^ not supported yet 223 Compute( key, h1, h2, h3); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 224 currentBinNum := h1 MOD binCount; ***** ^ undeclared identifier ***** ^ undeclared identifier 225 currentNode := tablePtr^[currentBinNum].first; ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet 226 parentNode := NIL; ***** ^ undeclared identifier 227 WHILE currentNode # NIL DO ***** ^ undeclared identifier 228 WITH currentNode^ DO ***** ^ undeclared identifier 229 IF (h2=hash2) AND (h3=hash3) THEN ***** ^ undeclared identifier ***** ^ undeclared identifier 230 RETURN TRUE; 231 END; (* if h2 *) 232 END; (* with currentNode *) ***** ^ not supported yet 233 (* no match yet, try the next node in linked list, if any: *) 234 parentNode := currentNode; ***** ^ undeclared identifier ***** ^ undeclared identifier 235 currentNode := currentNode^.next; ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet 236 END; (* while currentNode *) 237 (* no match in the list. *) 238 RETURN FALSE; 239 END; (* with table *) ***** ^ not supported yet 240 END KeyFind; (* procedure *) ***** ^ not supported yet 241 242 243 PROCEDURE Insert 244 ( table : HashTable; (* in/(out) *) 245 key : ARRAY OF SYSTEM.BYTE; (* in - must be unique *) ***** ^ not supported yet 246 data : ARRAY OF SYSTEM.BYTE (* in - always same size.*) ***** ^ not supported yet 247 ); 248 (* Halts program if attempt is made to insert a duplicate key. 249 This is a partial safeguard against (extremely unlikely) false key matching. 250 First call KeyFind if you want to check for a duplicate before 251 inserting. *) 252 (* Inefficient, because computes the hash twice. ***** *) 253 VAR 254 h1 : CARDINAL; 255 nodeBytes : CARDINAL; 256 BEGIN (* procedure HashInsert *) 257 IF KeyFind( table, key) THEN ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 258 ErrorManager.CallHalt( ***** ^ not supported yet ***** ^ not supported yet 259 "Programmer error or hash algorithm failure. Duplicate hash key."); ***** ^ not supported yet 260 END; (* if KeyFind *) 261 WITH table^ DO ***** ^ not supported yet 262 IF dataSize # (HIGH(data)+1) THEN ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet 263 ErrorManager.CallHalt( ***** ^ not supported yet ***** ^ not supported yet 264 "Programmer error calling HashInsert: wrong data size."); ***** ^ not supported yet 265 END; (* if dataSize *) 266 parentNode := NIL; ***** ^ undeclared identifier 267 (* allocate amount actually needed for node. *) 268 VStorage.DosAlloc( currentNode, nodeSize); ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 269 WITH currentNode^ DO ***** ^ undeclared identifier 270 LowLevel.Move( SYSTEM.ADR(data), SYSTEM.ADR(hData), dataSize); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 271 Compute( key, h1, hash2, hash3); ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 272 END; (* with currentNode *) ***** ^ not supported yet 273 currentBinNum := h1 MOD binCount; (* redundant, because of KeyFind. *) ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ undeclared identifier 274 WITH tablePtr^[currentBinNum] DO ***** ^ undeclared identifier ***** ^ undeclared identifier 275 currentNode^.next := first; ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier 276 first := currentNode; ***** ^ undeclared identifier ***** ^ undeclared identifier 277 INC(binCount); ***** ^ undeclared identifier ***** ^ undeclared identifier 278 END; (* with tablePtr *) ***** ^ not supported yet 279 INC( tableCount); ***** ^ undeclared identifier ***** ^ undeclared identifier 280 END; (* with table *) ***** ^ not supported yet 281 END Insert; (* procedure *) ***** ^ not supported yet 282 283 284 PROCEDURE Delete( table : HashTable); 285 (* Deletes hash table entry associated with the last Insert or KeyFind. *) 286 (* Has no effect if that element was never found or was already deleted. *) 287 VAR 288 nextNode : NodePtr; ***** ^ not supported yet 289 BEGIN (* procedure HashDelete *) 290 InitCheck(table); ***** ^ not supported yet ***** ^ not supported yet 291 WITH table^ DO ***** ^ not supported yet 292 IF currentNode # NIL THEN ***** ^ undeclared identifier 293 DEC( tableCount); ***** ^ undeclared identifier ***** ^ undeclared identifier 294 nextNode := currentNode^.next; ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 295 VStorage.DosDealloc( currentNode, nodeSize); ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier 296 WITH tablePtr^[ currentBinNum] DO ***** ^ undeclared identifier ***** ^ undeclared identifier 297 DEC( binCount); ***** ^ undeclared identifier ***** ^ undeclared identifier 298 IF parentNode = NIL THEN ***** ^ undeclared identifier 299 first := nextNode; ***** ^ undeclared identifier ***** ^ not supported yet 300 ELSE 301 parentNode^.next := nextNode; ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 302 END; (* if parentNode *) 303 END; (* with tablePtr *) ***** ^ not supported yet 304 END; (* if currentNode *) 305 END; (* with table *) ***** ^ not supported yet 306 END Delete; (* procedure *) ***** ^ not supported yet 307 308 309 PROCEDURE MoveData( table : HashTable; 310 pIn, pOut : SYSTEM.ADDRESS; ***** ^ not supported yet 311 dataHigh : CARDINAL); 312 (* used in HashGetData and HashChangeData. *) 313 BEGIN (* procedure DataCheck *) 314 WITH table^ DO ***** ^ not supported yet 315 IF (currentNode = NIL) OR (dataSize # dataHigh+1) THEN ***** ^ undeclared identifier ***** ^ undeclared identifier 316 ErrorManager.CallHalt( ***** ^ not supported yet ***** ^ not supported yet 317 "Programmer error. Attempt to access hash element."); ***** ^ not supported yet 318 END; (* if currentNode *) 319 LowLevel.Move( pIn, pOut, dataSize); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier 320 END; (* with table *) ***** ^ not supported yet 321 END MoveData; (* procedure *) ***** ^ not supported yet 322 323 324 PROCEDURE GetData 325 ( table : HashTable; (* in *) 326 VAR data : ARRAY OF SYSTEM.BYTE (* out - size must match. *) ***** ^ not supported yet 327 ); 328 (* Gets the data associated with the last Insert or KeyFind. *) 329 (* Fails if no such element or size does not match. *) 330 BEGIN (* procedure HashGetData *) 331 InitCheck( table); ***** ^ not supported yet ***** ^ not supported yet 332 MoveData(table, SYSTEM.ADR(table^.currentNode^.hData), ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 333 SYSTEM.ADR(data), HIGH(data) ); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 334 END GetData; (* procedure *) ***** ^ not supported yet 335 336 337 PROCEDURE ChangeData 338 ( table : HashTable; (* in *) 339 data : ARRAY OF SYSTEM.BYTE (* in - size must match. *) ***** ^ not supported yet 340 ); 341 (* Changes the data associated with the last Insert or KeyFind. *) 342 (* Fails if no such element or size does not match. *) 343 BEGIN (* procedure HashChangeData *) 344 InitCheck( table); ***** ^ not supported yet ***** ^ not supported yet 345 MoveData(table, SYSTEM.ADR(data), ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 346 SYSTEM.ADR(table^.currentNode^.hData), HIGH(data) ); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 347 END ChangeData; (* procedure *) ***** ^ not supported yet 348 349 PROCEDURE Size( table : HashTable) : CARDINAL; 350 (* returns the number of data entries in the hash table. *) 351 BEGIN (* procedure HashSize *) 352 IF (table=NIL) OR (table^.initCode # InitCodeValue) THEN ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 353 RETURN 0; 354 END; (* if table *) 355 RETURN table^.tableCount; ***** ^ not supported yet ***** ^ not supported yet 356 END Size; (* procedure *) ***** ^ not supported yet 357 358 BEGIN 359 Initialized := FALSE; 360 Init(); ***** ^ not supported yet ***** ^ not supported yet 361 END Hash. (* implementation module *) ***** ^ not supported yet 301 errors