mirror of
https://github.com/QB64-Phoenix-Edition/QB64pe.git
synced 2024-09-09 14:00:17 +00:00
334 lines
10 KiB
QBasic
334 lines
10 KiB
QBasic
|
|
||
|
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
|
||
|
|