level1/34_str_hash_more.f

   1 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   2 ;; UrForth level 1: self-hosting 32-bit Forth compiler
   3 ;; Copyright (C) 2020 Ketmar Dark // Invisible Vector
   4 ;; GPLv3 ONLY
   5 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   6
   7 code: STR-HASH-ELF  ( addr count -- u32hash )
   8   pop   edi
   9   xor   eax,eax
  10   jecxz .done
  11 .hashloop:
  12   ;; hash <<= 4
  13   shl   eax,4
  14   ;; hash += *key
  15   movzx edx,byte [edi]
  16   add   eax,edx
  17   ;; high = hash&0xF0000000
  18   ld    edx,eax
  19   and   edx,0xf0000000
  20   ld    ebx,edx
  21   inc   edi
  22   ;; hash ^= high>>24
  23   rol   edx,8
  24   xor   eax,edx
  25   ;; hash &= ~high
  26   not   ebx
  27   and   eax,ebx
  28   dec   ecx
  29   jr    nz,.hashloop
  30   ;;loop  .hashloop
  31 .done:
  32   ld    TOS,eax
  33   urnext
  34 endcode
  35
  36
  37 code: STR-HASH-JOAAT  ( addr count -- u32hash )
  38   pop   edi
  39   xor   eax,eax
  40   jecxz .done
  41 .hashloop:
  42   ;; hash += *key
  43   movzx edx,byte [edi]
  44   add   eax,edx
  45   ;; hash += hash<<10
  46   ld    edx,eax
  47   shl   eax,10
  48   add   eax,edx
  49   inc   edi
  50   ;; hash ^= hash>>6
  51   ld    edx,eax
  52   shr   eax,6
  53   xor   eax,edx
  54   dec   ecx
  55   jr    nz,.hashloop
  56   ;;loop  .hashloop
  57   ;; final permutation
  58   ;; hash += hash<<3
  59   ld    edx,eax
  60   shl   eax,3
  61   add   eax,edx
  62   ;; hash ^= hash>>11
  63   ld    edx,eax
  64   shr   eax,11
  65   xor   eax,edx
  66   ;; hash += hash<<15
  67   ld    edx,eax
  68   shl   eax,15
  69   add   eax,edx
  70 .done:
  71   ld    TOS,eax
  72   urnext
  73 endcode
  74
  75
  76 code: STR-HASH-ROT  ( addr count -- u32hash )
  77   pop   edi
  78   xor   eax,eax
  79   jecxz .done
  80 .hashloop:
  81   ;; hash = lrot(hash, 4)
  82   rol   eax,4
  83   ;; hash += *key
  84   movzx edx,byte [edi]
  85   inc   edi
  86   ;; upcase it (this also distorts other chars, but who cares)
  87   and   dl,0xdf
  88   xor   eax,edx
  89   dec   ecx
  90   jr    nz,.hashloop
  91   ;; this mixing allows using power-of-two tables with masking
  92   ;; hash ^= (hash>>10)^(hash>>20)
  93   ld    ecx,eax
  94   shr   ecx,10
  95   ld    edx,eax
  96   shr   edx,20
  97   xor   eax,ecx
  98   xor   eax,edx
  99 .done:
 100   ld    TOS,eax
 101   urnext
 102 endcode
 103
 104
 105 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 106 ;; tests
 107 ;; ;; 0 [IF]
 108 ;; ;; \ ' STR-HASH-DSFORTH disasm-word
 109 ;; ;; .( testing hashing functions...\n)
 110 ;; ;;
 111 ;; ;; : (str-hash-nassert) ( v0 v1 -- )
 112 ;; ;;   2dup - if
 113 ;; ;;     ." assertion failed!\n"
 114 ;; ;;     ." EXPECTED: $" .hex8 cr
 115 ;; ;;     ."      GOT: $" .hex8 cr
 116 ;; ;;     1 bye
 117 ;; ;;   endif
 118 ;; ;;   2drop
 119 ;; ;; ;
 120 ;; ;;
 121 ;; ;; s" a" str-hash-dsforth  $00000061 (str-hash-nassert)
 122 ;; ;; s" ab" str-hash-dsforth $00000024 (str-hash-nassert)
 123 ;; ;; s" The quick brown fox jumps over the lazy dog" str-hash-dsforth  $00000063 (str-hash-nassert)
 124 ;; ;;
 125 ;; ;; s" a" str-hash-elf  $00000061 (str-hash-nassert)
 126 ;; ;; s" ab" str-hash-elf $00000672 (str-hash-nassert)
 127 ;; ;; s" The quick brown fox jumps over the lazy dog" str-hash-elf  $04280C57 (str-hash-nassert)
 128 ;; ;;
 129 ;; ;; s" a" str-hash-joaat  0xca2e9442 (str-hash-nassert)
 130 ;; ;; s" ab" str-hash-joaat $45E61E58 (str-hash-nassert)
 131 ;; ;; s" The quick brown fox jumps over the lazy dog" str-hash-joaat  0x519e91f5 (str-hash-nassert)
 132 ;; ;;
 133 ;; ;; .( done testing hashing functions...\n)
 134 ;; ;; [ENDIF]