FUNCTION HashValue& (a$) 'returns the hash table value of a string '[5(first)][5(second)][5(last)][5(2nd-last)][3(length AND 7)][1(first char is underscore)] l = LEN(a$) IF l = 0 THEN EXIT FUNCTION 'an (invalid) NULL string equates to 0 a = ASC(a$) IF a <> 95 THEN 'does not begin with underscore SELECT CASE l CASE 1 HashValue& = hash1char(a) + 1048576 EXIT FUNCTION CASE 2 HashValue& = hash2char(CVI(a$)) + 2097152 EXIT FUNCTION CASE 3 HashValue& = hash2char(CVI(a$)) + hash1char(ASC(a$, 3)) * 1024 + 3145728 EXIT FUNCTION CASE ELSE HashValue& = hash2char(CVI(a$)) + hash2char(ASC(a$, l) + ASC(a$, l - 1) * 256) * 1024 + (l AND 7) * 1048576 EXIT FUNCTION END SELECT ELSE 'does begin with underscore SELECT CASE l CASE 1 HashValue& = (1048576 + 8388608): EXIT FUNCTION 'note: underscore only is illegal in QB64 but supported by hash CASE 2 HashValue& = hash1char(ASC(a$, 2)) + (2097152 + 8388608) EXIT FUNCTION CASE 3 HashValue& = hash2char(ASC(a$, 2) + ASC(a$, 3) * 256) + (3145728 + 8388608) EXIT FUNCTION CASE 4 HashValue& = hash2char((CVL(a$) AND &HFFFF00) \ 256) + hash1char(ASC(a$, 4)) * 1024 + (4194304 + 8388608) EXIT FUNCTION CASE ELSE HashValue& = hash2char((CVL(a$) AND &HFFFF00) \ 256) + hash2char(ASC(a$, l) + ASC(a$, l - 1) * 256) * 1024 + (l AND 7) * 1048576 + 8388608 EXIT FUNCTION END SELECT END IF END FUNCTION SUB HashAdd (a$, flags, reference) 'find the index to use IF HashListFreeLast > 0 THEN 'take from free list i = HashListFree(HashListFreeLast) HashListFreeLast = HashListFreeLast - 1 ELSE IF HashListNext > HashListSize THEN 'double hash list size HashListSize = HashListSize * 2 REDIM _PRESERVE HashList(1 TO HashListSize) AS HashListItem REDIM _PRESERVE HashListName(1 TO HashListSize) AS STRING * 256 END IF i = HashListNext HashListNext = HashListNext + 1 END IF 'setup links to index x = HashValue(a$) i2 = HashTable(x) IF i2 THEN i3 = HashList(i2).LastItem HashList(i2).LastItem = i HashList(i3).NextItem = i HashList(i).PrevItem = i3 ELSE HashTable(x) = i HashList(i).PrevItem = 0 HashList(i).LastItem = i END IF HashList(i).NextItem = 0 'set common hashlist values HashList(i).Flags = flags HashList(i).Reference = reference HashListName(i) = UCASE$(a$) END SUB FUNCTION HashFind (a$, searchflags, resultflags, resultreference) '(0,1,2)z=hashfind[rev]("RUMI",Hashflag_label,resflag,resref) '0=doesn't exist '1=found, no more items to scan '2=found, more items still to scan i = HashTable(HashValue(a$)) IF i THEN ua$ = UCASE$(a$) + SPACE$(256 - LEN(a$)) hashfind_next: f = HashList(i).Flags IF searchflags AND f THEN 'flags in common IF HashListName(i) = ua$ THEN resultflags = f resultreference = HashList(i).Reference i2 = HashList(i).NextItem IF i2 THEN HashFind = 2 HashFind_NextListItem = i2 HashFind_Reverse = 0 HashFind_SearchFlags = searchflags HashFind_Name = ua$ HashRemove_LastFound = i EXIT FUNCTION ELSE HashFind = 1 HashRemove_LastFound = i EXIT FUNCTION END IF END IF END IF i = HashList(i).NextItem IF i THEN GOTO hashfind_next END IF END FUNCTION FUNCTION HashFindRev (a$, searchflags, resultflags, resultreference) '(0,1,2)z=hashfind[rev]("RUMI",Hashflag_label,resflag,resref) '0=doesn't exist '1=found, no more items to scan '2=found, more items still to scan i = HashTable(HashValue(a$)) IF i THEN i = HashList(i).LastItem ua$ = UCASE$(a$) + SPACE$(256 - LEN(a$)) hashfindrev_next: f = HashList(i).Flags IF searchflags AND f THEN 'flags in common IF HashListName(i) = ua$ THEN resultflags = f resultreference = HashList(i).Reference i2 = HashList(i).PrevItem IF i2 THEN HashFindRev = 2 HashFind_NextListItem = i2 HashFind_Reverse = 1 HashFind_SearchFlags = searchflags HashFind_Name = ua$ HashRemove_LastFound = i EXIT FUNCTION ELSE HashFindRev = 1 HashRemove_LastFound = i EXIT FUNCTION END IF END IF END IF i = HashList(i).PrevItem IF i THEN GOTO hashfindrev_next END IF END FUNCTION FUNCTION HashFindCont (resultflags, resultreference) '(0,1,2)z=hashfind[rev](resflag,resref) '0=no more items exist '1=found, no more items to scan '2=found, more items still to scan IF HashFind_Reverse THEN i = HashFind_NextListItem hashfindrevc_next: f = HashList(i).Flags IF HashFind_SearchFlags AND f THEN 'flags in common IF HashListName(i) = HashFind_Name THEN resultflags = f resultreference = HashList(i).Reference i2 = HashList(i).PrevItem IF i2 THEN HashFindCont = 2 HashFind_NextListItem = i2 HashRemove_LastFound = i EXIT FUNCTION ELSE HashFindCont = 1 HashRemove_LastFound = i EXIT FUNCTION END IF END IF END IF i = HashList(i).PrevItem IF i THEN GOTO hashfindrevc_next EXIT FUNCTION ELSE i = HashFind_NextListItem hashfindc_next: f = HashList(i).Flags IF HashFind_SearchFlags AND f THEN 'flags in common IF HashListName(i) = HashFind_Name THEN resultflags = f resultreference = HashList(i).Reference i2 = HashList(i).NextItem IF i2 THEN HashFindCont = 2 HashFind_NextListItem = i2 HashRemove_LastFound = i EXIT FUNCTION ELSE HashFindCont = 1 HashRemove_LastFound = i EXIT FUNCTION END IF END IF END IF i = HashList(i).NextItem IF i THEN GOTO hashfindc_next EXIT FUNCTION END IF END FUNCTION SUB HashRemove i = HashRemove_LastFound 'add to free list HashListFreeLast = HashListFreeLast + 1 IF HashListFreeLast > HashListFreeSize THEN HashListFreeSize = HashListFreeSize * 2 REDIM _PRESERVE HashListFree(1 TO HashListFreeSize) AS LONG END IF HashListFree(HashListFreeLast) = i 'unlink i1 = HashList(i).PrevItem IF i1 THEN 'not first item in list i2 = HashList(i).NextItem IF i2 THEN '(not first and) not last item HashList(i1).NextItem = i2 HashList(i2).LastItem = i1 ELSE 'last item x = HashTable(HashValue(HashListName$(i))) HashList(x).LastItem = i1 HashList(i1).NextItem = 0 END IF ELSE 'first item in list x = HashTable(HashValue(HashListName$(i))) i2 = HashList(i).NextItem IF i2 THEN '(first item but) not last item HashTable(x) = i2 HashList(i2).PrevItem = 0 HashList(i2).LastItem = HashList(i).LastItem ELSE '(first and) last item HashTable(x) = 0 END IF END IF END SUB SUB HashDump 'used for debugging purposes fh = FREEFILE OPEN "hashdump.txt" FOR OUTPUT AS #fh b$ = "12345678901234567890123456789012}" FOR x = 0 TO 16777215 IF HashTable(x) THEN PRINT #fh, "START HashTable("; x; "):" i = HashTable(x) 'validate lasti = HashList(i).LastItem IF HashList(i).LastItem = 0 OR HashList(i).PrevItem <> 0 OR HashValue(HashListName(i)) <> x THEN GOTO corrupt PRINT #fh, " HashList("; i; ").LastItem="; HashList(i).LastItem hashdumpnextitem: x$ = " [" + STR$(i) + "]" + HashListName(i) f = HashList(i).Flags x$ = x$ + ",.Flags=" + STR$(f) + "{" FOR z = 1 TO 32 ASC(b$, z) = (f AND 1) + 48 f = f \ 2 NEXT x$ = x$ + b$ x$ = x$ + ",.Reference=" + STR$(HashList(i).Reference) PRINT #fh, x$ 'validate i1 = HashList(i).PrevItem i2 = HashList(i).NextItem IF i1 THEN IF HashList(i1).NextItem <> i THEN GOTO corrupt END IF IF i2 THEN IF HashList(i2).PrevItem <> i THEN GOTO corrupt END IF IF i2 = 0 THEN IF lasti <> i THEN GOTO corrupt END IF i = HashList(i).NextItem IF i THEN GOTO hashdumpnextitem PRINT #fh, "END HashTable("; x; ")" END IF NEXT CLOSE #fh EXIT SUB corrupt: PRINT #fh, "HASH TABLE CORRUPT!" 'should never happen CLOSE #fh END SUB SUB HashClear 'clear entire hash table HashListSize = 65536 HashListNext = 1 HashListFreeSize = 1024 HashListFreeLast = 0 REDIM HashList(1 TO HashListSize) AS HashListItem REDIM HashListName(1 TO HashListSize) AS STRING * 256 REDIM HashListFree(1 TO HashListFreeSize) AS LONG REDIM HashTable(16777215) AS LONG '64MB lookup table with indexes to the hashlist HashFind_NextListItem = 0 HashFind_Reverse = 0 HashFind_SearchFlags = 0 HashFind_Name = "" HashRemove_LastFound = 0 END SUB