Annotation of qemu/roms/SLOF/slof/fs/find-hash.fs, revision 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

unix.superglobalmegacorp.com

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.