qemu/roms/SLOF/slof/fs/find-hash.fs

   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