|
|
1.1 ! root 1: \ ***************************************************************************** ! 2: \ * Copyright (c) 2004, 2008 IBM Corporation ! 3: \ * All rights reserved. ! 4: \ * This program and the accompanying materials ! 5: \ * are made available under the terms of the BSD License ! 6: \ * which accompanies this distribution, and is available at ! 7: \ * http://www.opensource.org/licenses/bsd-license.php ! 8: \ * ! 9: \ * Contributors: ! 10: \ * IBM Corporation - initial implementation ! 11: \ ****************************************************************************/ ! 12: ! 13: #ifdef HASH_DEBUG ! 14: 0 value from-hash ! 15: 0 value not-from-hash ! 16: 0 value hash-collisions ! 17: #endif ! 18: ! 19: clean-hash ! 20: ! 21: : hash-find ( str len head -- 0 | link ) ! 22: >r 2dup 2dup hash ( str len str len hash R: head ) ! 23: dup >r @ dup ( str len str len *hash *hash R: head hash ) ! 24: IF ( str len str len *hash R: head hash ) ! 25: link>name name>string string=ci ( str len true|false R: head hash ) ! 26: dup 0= ! 27: IF ! 28: #ifdef HASH_DEBUG ! 29: hash-collisions 1+ ! 30: to hash-collisions ! 31: #endif ! 32: THEN ! 33: ELSE ! 34: nip nip ( str len 0 R: head hash ) ! 35: THEN ! 36: IF \ hash found ! 37: 2drop r> @ r> drop ( *hash R: ) ! 38: #ifdef HASH_DEBUG ! 39: from-hash 1+ to from-hash ! 40: #endif ! 41: exit ! 42: THEN \ hash not found ! 43: r> r> swap >r ((find)) ( str len head R: hash=0 ) ! 44: dup ! 45: IF ! 46: #ifdef HASH_DEBUG ! 47: not-from-hash 1+ ! 48: to not-from-hash ! 49: #endif ! 50: dup r> ! ( link R: ) ! 51: ELSE ! 52: r> drop ( 0 R: ) ! 53: THEN ! 54: ; ! 55: ! 56: : hash-reveal hash off ; ! 57: ! 58: ' hash-reveal to (reveal) ! 59: ' hash-find to (find) ! 60: ! 61: #ifdef HASH_DEBUG ! 62: \ print out all entries in the hash table ! 63: : dump-hash-table ( -- ) ! 64: cr ! 65: hash-table hash-size 0 DO ! 66: dup @ dup 0<> IF ! 67: over . s" : " type link>name name>string type cr ! 68: ELSE ! 69: drop ! 70: THEN ! 71: cell+ ! 72: LOOP drop ! 73: s" hash-collisions: " type hash-collisions . cr ! 74: s" from-hash: " type from-hash . cr ! 75: s" not-from-hash: " type not-from-hash . cr ! 76: ; ! 77: #endif
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.