--- gforth/hash.fs 1997/07/06 15:55:24 1.18 +++ gforth/hash.fs 2000/09/23 15:06:00 1.25 @@ -1,6 +1,6 @@ \ 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. @@ -18,19 +18,15 @@ \ along with this program; if not, write to the Free Software \ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. -[IFUNDEF] e? : e? name 2drop false ; [THEN] - -e? ec -[IF] +[IFUNDEF] allocate : reserve-mem here swap allot ; -\ ToDo: check memory space with unused \ move to a kernel/memory.fs [ELSE] : reserve-mem allocate throw ; [THEN] [IFUNDEF] hashbits -11 value hashbits +11 Value hashbits [THEN] 1 hashbits lshift Value Hashlen @@ -52,7 +48,7 @@ Variable HashIndex \ forward declarations 0 Value hashsearch-map -Defer hash-alloc +Defer hash-alloc ( addr -- addr ) \ DelFix and NewFix are from bigFORTH 15jul94py @@ -92,7 +88,8 @@ Defer hash-alloc : inithash ( wid -- ) 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 2drop r> insRule ! ; @@ -100,7 +97,7 @@ Defer hash-alloc voclink BEGIN @ dup WHILE dup 0 wordlist-link - - dup wordlist-map @ hashsearch-map = + dup wordlist-map @ reveal-method @ ['] hash-reveal = IF inithash ELSE drop THEN REPEAT drop ; @@ -108,15 +105,24 @@ Defer hash-alloc HashTable Hashlen cells bounds DO I @ BEGIN dup WHILE - dup @ swap HashPointer DelFix - REPEAT I ! - cell +LOOP HashIndex off + dup @ swap HashPointer DelFix + REPEAT + I ! + cell +LOOP + HashIndex off voclink - BEGIN @ dup WHILE - dup 0 wordlist-link - - dup wordlist-map @ hashsearch-map = - IF 0 swap wordlist-extend ! ELSE drop THEN - REPEAT drop ; + BEGIN ( wordlist-link-addr ) + @ dup + WHILE ( wordlist-link ) + dup 0 wordlist-link - ( wordlist-link wid ) + dup wordlist-map @ hashsearch-map = + IF ( wordlist-link wid ) + 0 swap wordlist-extend ! + ELSE + drop + THEN + REPEAT + drop ; : rehashall ( wid -- ) drop revealed @ @@ -134,13 +140,13 @@ to hashsearch-map \ hash allocate and vocabulary initialization 10oct94py -:noname ( hash-alloc ) ( addr -- addr ) +:noname ( addr -- addr ) HashTable 0= IF Hashlen cells reserve-mem TO HashTable HashTable Hashlen cells erase THEN HashIndex @ over ! 1 HashIndex +! HashIndex @ Hashlen >= - [ e? ec [IF] ] + [ [IFUNDEF] allocate ] ABORT" no more space in hashtable" [ [ELSE] ] IF HashTable >r clearhash @@ -151,27 +157,27 @@ to hashsearch-map [ [THEN] ] ; is hash-alloc \ Hash-Find 01jan93py -e? cross 0= +has? cross 0= [IF] : make-hash - hashsearch-map forth-wordlist cell+ ! + hashsearch-map forth-wordlist wordlist-map ! addall ; make-hash \ Baumsuche ist installiert. [ELSE] - hashsearch-map forth-wordlist cell+ ! + hashsearch-map forth-wordlist wordlist-map ! [THEN] \ for ec version display that vocabulary goes hashed : hash-cold ( -- ) -[ e? ec [IF] ] ." Hashing..." [ [THEN] ] +[ has? ec [IF] ] ." Hashing..." [ [THEN] ] HashPointer off 0 TO HashTable HashIndex off addall \ voclink \ BEGIN @ dup WHILE \ dup 0 wordlist-link - initvoc \ REPEAT drop -[ e? ec [IF] ] ." Done" cr [ [THEN] ] ; +[ has? ec [IF] ] ." Done" cr [ [THEN] ] ; ' hash-cold INIT8 chained @@ -179,7 +185,7 @@ e? cross 0= base @ >r hex HashTable Hashlen 0 DO cr i 2 .r ." : " dup i cells + BEGIN @ dup WHILE - dup cell+ @ head>string type space REPEAT drop + dup cell+ @ name>string type space REPEAT drop LOOP drop r> base ! ; \ \ this stuff is for evaluating the hash function