| \ Hashed dictionaries 15jul94py |
\ Hashed dictionaries 15jul94py |
| |
|
| \ Copyright (C) 1995 Free Software Foundation, Inc. |
\ Copyright (C) 1995,1998,2000 Free Software Foundation, Inc. |
| |
|
| \ This file is part of Gforth. |
\ This file is part of Gforth. |
| |
|
| |
|
| \ forward declarations |
\ forward declarations |
| 0 Value hashsearch-map |
0 Value hashsearch-map |
| Defer hash-alloc |
Defer hash-alloc ( addr -- addr ) |
| |
|
| \ DelFix and NewFix are from bigFORTH 15jul94py |
\ DelFix and NewFix are from bigFORTH 15jul94py |
| |
|
| |
|
| : inithash ( wid -- ) |
: inithash ( wid -- ) |
| wordlist-extend |
wordlist-extend |
| insRule @ >r insRule off hash-alloc 3 cells - dup |
insRule @ >r insRule off hash-alloc 3 cells - |
| |
dup wordlist-id |
| BEGIN @ dup WHILE 2dup swap (reveal REPEAT |
BEGIN @ dup WHILE 2dup swap (reveal REPEAT |
| 2drop r> insRule ! ; |
2drop r> insRule ! ; |
| |
|
| voclink |
voclink |
| BEGIN @ dup WHILE |
BEGIN @ dup WHILE |
| dup 0 wordlist-link - |
dup 0 wordlist-link - |
| dup wordlist-map @ hashsearch-map = |
dup wordlist-map @ reveal-method @ ['] hash-reveal = |
| IF inithash ELSE drop THEN |
IF inithash ELSE drop THEN |
| REPEAT drop ; |
REPEAT drop ; |
| |
|
| DO I @ |
DO I @ |
| BEGIN dup WHILE |
BEGIN dup WHILE |
| dup @ swap HashPointer DelFix |
dup @ swap HashPointer DelFix |
| REPEAT I ! |
REPEAT |
| cell +LOOP HashIndex off |
I ! |
| |
cell +LOOP |
| |
HashIndex off |
| voclink |
voclink |
| BEGIN @ dup WHILE |
BEGIN ( wordlist-link-addr ) |
| dup 0 wordlist-link - |
@ dup |
| |
WHILE ( wordlist-link ) |
| |
dup 0 wordlist-link - ( wordlist-link wid ) |
| dup wordlist-map @ hashsearch-map = |
dup wordlist-map @ hashsearch-map = |
| IF 0 swap wordlist-extend ! ELSE drop THEN |
IF ( wordlist-link wid ) |
| REPEAT drop ; |
0 swap wordlist-extend ! |
| |
ELSE |
| |
drop |
| |
THEN |
| |
REPEAT |
| |
drop ; |
| |
|
| : rehashall ( wid -- ) |
: rehashall ( wid -- ) |
| drop revealed @ |
drop revealed @ |
| |
|
| \ hash allocate and vocabulary initialization 10oct94py |
\ hash allocate and vocabulary initialization 10oct94py |
| |
|
| :noname ( hash-alloc ) ( addr -- addr ) |
:noname ( addr -- addr ) |
| HashTable 0= |
HashTable 0= |
| IF Hashlen cells reserve-mem TO HashTable |
IF Hashlen cells reserve-mem TO HashTable |
| HashTable Hashlen cells erase THEN |
HashTable Hashlen cells erase THEN |
| has? cross 0= |
has? cross 0= |
| [IF] |
[IF] |
| : make-hash |
: make-hash |
| hashsearch-map forth-wordlist cell+ ! |
hashsearch-map forth-wordlist wordlist-map ! |
| addall ; |
addall ; |
| make-hash \ Baumsuche ist installiert. |
make-hash \ Baumsuche ist installiert. |
| [ELSE] |
[ELSE] |
| hashsearch-map forth-wordlist cell+ ! |
hashsearch-map forth-wordlist wordlist-map ! |
| [THEN] |
[THEN] |
| |
|
| \ for ec version display that vocabulary goes hashed |
\ for ec version display that vocabulary goes hashed |
| base @ >r hex HashTable Hashlen 0 |
base @ >r hex HashTable Hashlen 0 |
| DO cr i 2 .r ." : " dup i cells + |
DO cr i 2 .r ." : " dup i cells + |
| BEGIN @ dup WHILE |
BEGIN @ dup WHILE |
| dup cell+ @ head>string type space REPEAT drop |
dup cell+ @ name>string type space REPEAT drop |
| LOOP drop r> base ! ; |
LOOP drop r> base ! ; |
| |
|
| \ \ this stuff is for evaluating the hash function |
\ \ this stuff is for evaluating the hash function |