Return to hash.fs CVS log | Up to [gforth] / gforth |
hash.fs uses single (but large) hash table (like LMI) time&date bug fixed ORDER reversed (let's see the reactions) time printout in sieve.fs fixed startup.fs modified due to history.fs and doskey.fs (see comment of these files)
1: \ Hashed dictionaries 15jul94py 2: 3: 9 value hashbits 4: 1 hashbits lshift Value Hashlen 5: 6: Variable insRule insRule on 7: Variable revealed 8: 9: \ Memory handling 10oct94py 10: 11: Variable HashPointer 12: Variable HashTable 13: Variable HashIndex 14: 15: \ DelFix and NewFix are from bigFORTH 15jul94py 16: 17: : DelFix ( addr root -- ) dup @ 2 pick ! ! ; 18: : NewFix ( root len # -- addr ) 19: BEGIN 2 pick @ ?dup 0= WHILE 2dup * allocate throw 20: over 0 ?DO dup 4 pick DelFix 2 pick + LOOP drop 21: REPEAT >r drop r@ @ rot ! r@ swap erase r> ; 22: 23: \ compute hash key 15jul94py 24: 25: : hash ( addr len -- key ) 26: hashbits (hashkey1) ; 27: \ (hashkey) 28: \ Hashlen 1- and ; 29: 30: 31: : hash-find ( addr len wordlist -- nfa / false ) 32: $C + @ >r 33: 2dup hash r> xor cells HashTable @ + @ (hashfind) ; 34: 35: \ hash vocabularies 16jul94py 36: 37: : lastlink! ( addr link -- ) 38: BEGIN dup @ dup WHILE nip REPEAT drop ! ; 39: 40: : (reveal ( addr voc -- ) $C + dup @ 0< IF 2drop EXIT THEN 41: @ over cell+ count $1F and Hash xor cells >r 42: HashPointer 8 $400 NewFix 43: tuck cell+ ! r> HashTable @ + insRule @ 44: IF dup @ 2 pick ! ! ELSE lastlink! THEN revealed on ; 45: 46: : hash-reveal ( -- ) (reveal) last? IF 47: current @ (reveal THEN ; 48: 49: : addall ( -- ) 50: voclink 51: BEGIN @ dup @ WHILE dup 'initvoc REPEAT drop ; 52: 53: : clearhash ( -- ) 54: HashTable @ Hashlen cells bounds 55: DO I @ 56: BEGIN dup WHILE 57: dup @ swap HashPointer DelFix 58: REPEAT I ! 59: cell +LOOP HashIndex off ; 60: 61: : rehash clearhash addall ; 62: : (rehash) ( addr -- ) 63: drop revealed @ IF rehash revealed off THEN ; 64: 65: Create hashsearch ' hash-find A, ' hash-reveal A, ' (rehash) A, 66: 67: \ hash allocate and vocabulary initialization 10oct94py 68: 69: : hash-alloc ( addr -- addr ) HashTable @ 0= IF 70: Hashlen cells allocate throw HashTable ! 71: HashTable @ Hashlen cells erase THEN 72: HashIndex @ over ! 1 HashIndex +! 73: HashIndex @ Hashlen >= 74: IF clearhash 75: 1 hashbits 1+ dup to hashbits lshift to hashlen 76: HashTable @ free 77: addall 78: THEN ; 79: 80: : (initvoc) ( addr -- ) 81: cell+ dup @ 0< IF drop EXIT THEN 82: insRule @ >r insRule off hash-alloc 83: 3 cells - hashsearch over cell+ ! dup 84: BEGIN @ dup WHILE 2dup swap (reveal REPEAT 85: 2drop r> insRule ! ; 86: 87: ' (initvoc) IS 'initvoc 88: 89: \ Hash-Find 01jan93py 90: 91: addall \ Baum aufbauen 92: \ Baumsuche ist installiert. 93: 94: : .words ( -- ) 95: base @ >r hex HashTable @ Hashlen 0 96: DO cr i 2 .r ." : " dup i cells + 97: BEGIN @ dup WHILE 98: dup cell+ @ .name REPEAT drop 99: LOOP drop r> base ! ; 100: 101: \ \ this stuff is for evaluating the hash function 102: \ : square dup * ; 103: 104: \ : countwl ( -- sum sumsq ) 105: \ \ gives the number of words in the current wordlist 106: \ \ and the sum of squares for the sublist lengths 107: \ 0 0 108: \ hashtable @ Hashlen cells bounds DO 109: \ 0 i BEGIN 110: \ @ dup WHILE 111: \ swap 1+ swap 112: \ REPEAT 113: \ drop 114: \ swap over square + 115: \ >r + r> 116: \ 1 cells 117: \ +LOOP ; 118: 119: \ : chisq ( -- n ) 120: \ \ n should have about the same size as Hashlen 121: \ countwl Hashlen 2 pick */ swap - ;