Return to find-hash.fs CVS log

Up to [Qemu by Fabrice Bellard] / qemu / roms / SLOF / slof / fs

Annotation of qemu/roms/SLOF/slof/fs/find-hash.fs, revision 1.1.1.1

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.