perl hashtest1.pl -file bigtest -seed 0 -hash orig Hashed:110405 hits n 0 4294856890 1 91335 2 3018 3 1028 4 386 5 184 6 218 7 52 8 70 9 169 10 141 11 5 12 12 13 8 14 7 15 2 16 1 18 5 19 2 20 9 28 3 29 1 30 15 31 26 88 1 111 1 #### D:\active\misc\util>perl hashtest1.pl -file bigtest -seed 0 -hash hash2 Hashed:110405 hits n 0 4294856890 1 105501 2 1222 3 156 4 119 5 28 6 29 7 27 8 14 9 20 10 10 11 3 12 15 13 2 14 3 17 3 18 6 20 1 21 3 22 3 32 1 #### perl hashtest1.pl -file bigtest -seed 1 -hash orig Hashed:110405 hits n 0 4294856890 1 86318 2 2019 3 715 4 276 5 178 6 212 7 110 8 105 9 204 10 168 11 51 12 96 13 25 14 27 15 47 16 19 17 34 18 41 19 4 20 18 21 16 22 4 23 17 24 3 26 2 27 2 31 1 36 3 38 1 39 1 40 1 46 1 47 1 49 1 61 1 68 1 69 1 95 1 103 1 116 1 120 1 122 1 198 1 224 1 226 1 251 1 415 1 423 1 453 1 #### perl hashtest1.pl -file bigtest -seed 0 -hash hashi hits n 0 4294856890 1 110403 2 1 #### perl hashtest1.pl -file bigtest -seed 0 -hash hash3i differences:110405 hits n 0 4294856890 1 110403 2 1 #### perl hashtest1.pl -file bigtest -seed 0 -hash hash30 -h2 hashi Hashed:110405 hits n 0 4294856890 1 110403 2 1 #### perl hashtest1.pl -file bigtest -seed 0 -hash hash3a perl hashtest1.pl -file bigtest -seed 0 -hash hash3f perl hashtest1.pl -file bigtest -seed 0 -hash hash3f2 perl hashtest1.pl -file bigtest -seed 0 -hash hash3f3 perl hashtest1.pl -file bigtest -seed 0 -hash hash38 #### perl hashtest1.pl -file bigtest -seed 0 -hash fish -h2 fix differences:23 Hashed:110405 hits n 0 4294856890 1 110405 #### # testing 32 bit jenkins hashs use strict; use warnings; $|=1; use File::Find; use Getopt::Long; use Config; if ( $Config{ivsize} == 4 ) { *main::h64=*main::h32; *main::tobit=*main::tobit32; } my $debug =0; my $file =''; my $dir =''; my $hash ='orig'; my $h2 =''; my $printif =0; my $seed =0; my $listdiff=0; my $finddiff=0; my $listall =0; my $blowupfast=0; my $output =''; my $noc =0; my %optdef= ("debug=i" => \$debug ,"file=s" => \$file ,"hash=s" => \$hash ,"h2=s" => \$h2 ,"dir=s" => \$dir ,"printif=i" => \$printif ,"seed=i" => \$seed ,"listdiff" => \$listdiff ,"finddiff" => \$finddiff ,"listall" => \$listall ,"blowupfast" => \$blowupfast ,"output=s" => \$output ,"noc" => \$noc ); GetOptions ( %optdef ) or die("Error in command line arguments"); use Data::Dumper; if ($debug) {print Dumper(\%optdef);} die 'need -dir or -file' unless ($dir || $file ); unless ($noc){ # with -noc cant use -hash fish fishic fishodvs fishodvu # http://www.perlmonks.org/?node_id=151114 # http://cpansearch.perl.org/src/SHLOMIF/Digest-JHash-0.10/JHash.xs { no strict; unless (eval 'use Inline C => "./jhashic.c"; 1' ) {print "no fishic\n";} unless (eval 'use Inline C => "./jhashodvs.c";1') {print "no fishodvs\n";} unless (eval 'use Inline C => "./jhashodvu.c";1') {print "no fishodvu\n";} } # strict unless (eval 'use Digest::JHash;1') {print "no fishodvu\n";} } # noc # some early ranting # print '1N :'.unpack("H*", pack("N", 1))."\n"; # print '1L :'.unpack("H*", pack("L", 1))."\n"; # print '2g :'.unpack("H*", pack("N", 2147483647))."\n"; # print '4g :'.unpack("H*", pack("N", 4294967295))."\n"; # print 'L :'.unpack("H*", pack("L", 0x0a0b0c0d))."\n"; # print 'N :'.unpack("H*", pack("N", 0x0a0b0c0d))."\n"; # print 'H4 :'.unpack("H*", pack("Q", 0x0a0b0c0d))."\n"; # print 'H8 :'.unpack("H*", pack("Q", 0x0a0b0c0d0e0f1a1b))."\n"; #order64('0x0a0b0c0d0e0f1a1b',0x0a0b0c0d0e0f1a1b); if(0) { { use integer; use Devel::Peek; my $a = 2**31 - 1; # Largest positive integer on 32-bit machines my $a1=$a+1; print $a; print ' '.$a+1; print ' '.$a1; printf ' u+ %10u' ,$a+1; printf ' f+ %14f5',$a+1; printf ' u1 %10u' ,$a1; printf ' f1 %14f5',$a1; printf ' h+ '.h64($a+1); printf ' h1 '.h64($a1); print "\n"; Dump($a); Dump($a1); } { no integer; use Devel::Peek; my $a = 2**31 - 1; # Largest positive integer on 32-bit machines my $a1=$a+1; print $a; print ' '.$a+1; print ' '.$a1; printf ' u+ %10u' ,$a+1; printf ' f+ %14f5',$a+1; printf ' u1 %10u' ,$a1; printf ' f1 %14f5',$a1; printf ' h+ '.h64($a+1); printf ' h1 '.h64($a1); print "\n"; Dump($a); Dump($a1); } exit; } # 00000000000 my $list; unless ($blowupfast){ if ($dir) {$list=finder($dir);} if ($dir && $file) { open (my $fh,'>',$file) or die "cant open $file $!"; for my $fn (@$list) { print $fh $fn."\n"; } close ($fh) or die "cant close $file $!"; exit; } else { $list=[]; open (my $fh,'<',$file) or die "cant open $file $!"; while (my $line=<$fh>) { chomp $line; push @$list,$line; } close ($fh) or die "cant close $file $!"; } # file } else { # for testing the "problem" e9 caused a lot of problems, so did f6 # $list=['a'."\xe9",'ab'."\xe9",'abc'."\xe9",'abcd'."\xe9",'abcde'."\xe9",'abcdef'."\xe9",'abcdefg'."\xe9",'abcdefgh'."\xe9"]; # $list=['a','ab','abc','abcd','abc'."\xe9",'a'."\xe9",'ab'."\xe9",'abcd'."\xe9"]; $list=['a'."\xe9"]; } #for my $chr (@$list) { print sprintf('%3d',length($chr)).' '.$chr."\n"; } exit; my $hashs={}; $hashs->{orig} =\&hash; $hashs->{hash2} =\&hash2; $hashs->{hash20} =\&hash20; $hashs->{hash3} =\&hash3; # $hashs->{hash3exp} =\&hash3exp; $hashs->{hash3ui} =\&hash3ui; $hashs->{origi} =\&hashi; $hashs->{hashi} =\&hashi; $hashs->{hash2i} =\&hash2i; $hashs->{hash3i0} =hash3s(\&mix4x); $hashs->{hash3i} =hash3s(\&mix4); $hashs->{hash30} =hash3s(\&mix80); $hashs->{hash3a} =hash3s(\&mix8a); $hashs->{hash3f} =hash3s(\&mix80f); $hashs->{hash3f2} =hash3s(\&mix80f2); $hashs->{hash3f3} =hash3s(\&mix80f3); $hashs->{hash38} =\&hash38; $hashs->{hash38ni} =hash3s(\&mix8ni); $hashs->{hash3m0} =hash3s(\&mix); $hashs->{hash38exp}=\&hash38exp; $hashs->{fix} =\&hash38; $hashs->{fixexp} =\&hash38exp; $hashs->{fish} =\&hashfish; $hashs->{fishic} =\&hashfishic; $hashs->{fishodvs} =\&hashfishs; $hashs->{fishodvu} =\&hashfishu; $hashs->{hash34} =hash3s(\&mix4); $hashs->{hash34x} =hash3s(\&mix4x); $hashs->{hash3exp} =hash3sexp(\&mixexp ,'mixexp'); $hashs->{hash34exp} =hash3sexp(\&mix4exp,'mix4exp'); my $sub0=$hashs->{$hash}; die "bad hash name $hash" unless ($sub0); my $sub2; if ($h2) { $sub2=$hashs->{$h2}; die "bad hash name $h2" unless ($sub2); } my %space; my %names; my $hashct=scalar(@$list); my $oh; if ($output) { open ($oh,'>',$output) or die "cant open oh $output $!"; print $oh "-seed $seed -hash $hash -h2 $h2\n"; } if ($h2) { # compare mode my $diff=0; my %bad; my %bad4; for my $fn (@$list) { my $hh =&{$sub0}($fn,$seed); my $hh2=&{$sub2}($fn,$seed); if ($output) { print $oh $hh.' '.$hh2.' '.$fn."\n"; } if ($hh2 ne $hh) { $diff++; if ($listdiff) { print $hh.' '.$hh2.' '.$fn."\n"; if ($h2 eq 'fix') { my $hh2e=&{$hashs->{fixexp}}($fn,$seed); print $hh.' '.$hh2e.' '.$fn."\n"; } if ($finddiff) { for my $ii (1..length($fn)) { my $sh1=&{$sub0}(substr($fn,0,$ii),$seed); my $sh2=&{$sub2}(substr($fn,0,$ii),$seed); if ($sh1 ne $sh2) { print $hh.' '.$hh2.' '.$fn."\n"; print 'ahah:'.sprintf('%7d',$ii); print ' '.(utf8::is_utf8($fn)?'1':'0'); print ' '.nhex($fn,$ii,4); print ' '.nhex($fn,$ii,12); print ' '.substr($fn,0,$ii)."\n"; my $hbadc=unpack("H*",substr($fn,$ii-1,1)); $bad{$hbadc}++; $bad4{nhex($fn,$ii,4)}++; last; } # ne } # ii; } # finddiff else { } } # listdiff } # hh ne hh2 else { # print $hh.' '.$hh2.' **OK** '.$fn."\n" if ($listall); } $space{$hh}++; push @{$names{$hh}},$fn; } print "differences:$diff\n"; for my $kk (sort keys %bad) { print $kk.' '.$bad{$kk}."\n"; } for my $kk (sort keys %bad4) { print $kk.' '.$bad4{$kk}."\n"; } } else { # simple mode for my $fn (@$list) { my $hh=&{$sub0}($fn,$seed); if ($output) { print $oh $hh.' - '.$fn."\n"; } $space{$hh}++; push @{$names{$hh}},$fn; } } if ($output) { close $oh or die "cant close oh $output $!"; } # count collisions/hits my @col; for my $kk (sort keys %space) { $col[$space{$kk}]++;} # fill in missings; for my $n (@col){ $n=0 unless ($n);} $col[0]=4294967295-$hashct; my $ct=0; print "Hashed:$hashct\n"; print "hits n\n"; for my $n (@col){ print sprintf('%4d',$ct).' '.sprintf('%10u',$n)."\n" if ($n); $ct++; } if ($printif) { # print lines lists with more than this collisions for my $kk (sort keys %space) { my $doprint=0; if ($space{$kk} >= $printif) { print 'hash='.$kk.' hits='.sprintf('%4d',$space{$kk})."\n"; for my $fn (@{$names{$kk}}){ print ' '.$fn."\n"; } } # printf } # kk } # printif exit; sub finder { # cheap but deadly my @txts; my $dir=shift; find(sub {push @txts,$File::Find::name; }, $dir); return \@txts; } ##################### # http://www.perlmonks.org/?node_id=315881 ##################### { # no use integer # http://www.perlmonks.org/?node_id=315881 # http://burtleburtle.net/bob/c/lookup2.c use constant GOLDEN_RATIO => 0x9e3779b9; use constant A => 0; use constant B => 1; use constant C => 2; sub mix ($$$) { $_[A] -= $_[B]; $_[A] -= $_[C]; $_[A] ^= ($_[C]>>13); $_[B] -= $_[C]; $_[B] -= $_[A]; $_[B] ^= ($_[A]<< 8); $_[C] -= $_[A]; $_[C] -= $_[B]; $_[C] ^= ($_[B]>>13); $_[A] -= $_[B]; $_[A] -= $_[C]; $_[A] ^= ($_[C]>>12); $_[B] -= $_[C]; $_[B] -= $_[A]; $_[B] ^= ($_[A]<<16); $_[C] -= $_[A]; $_[C] -= $_[B]; $_[C] ^= ($_[B]>> 5); $_[A] -= $_[B]; $_[A] -= $_[C]; $_[A] ^= ($_[C]>> 3); $_[B] -= $_[C]; $_[B] -= $_[A]; $_[B] ^= ($_[A]<<10); $_[C] -= $_[A]; $_[C] -= $_[B]; $_[C] ^= ($_[B]>>15); } sub mixexp ($$$) { $_[A] -= $_[B]; ja0(' a1-b' ,$_[A]); $_[A] -= $_[C]; ja0(' a1-c' ,$_[A]); bxor(' a1-x c>13 ',$_[A],$_[C],'>>',13); { no integer; $_[A] ^= ($_[C]>>13); } ja0(' a1-x c>13',$_[A]); $_[B] -= $_[C]; jb0(' b1-c' ,$_[B]); $_[B] -= $_[A]; jb0(' b1-a' ,$_[B]); bxor(' b1-x a<8 ',$_[B],$_[A],'<<', 8); { no integer; $_[B] ^= ($_[A]<< 8); } jb0(' b1-x a< 8',$_[B]); $_[C] -= $_[A]; jc0(' c1-a' ,$_[C]); use Devel::Peek; Dump($_[C]); $_[C] -= $_[B]; jc0(' c1-b' ,$_[C]); Dump($_[C]); bxor(' c1-x b>13 ',$_[C],$_[B],'>>',13); { no integer; $_[C] ^= ($_[B]>>13); } jc0(' c1-x b>13',$_[C]); $_[A] -= $_[B]; ja0(' a2-b' ,$_[A]); $_[A] -= $_[C]; ja0(' a2-c' ,$_[A]); bxor(' a2-x c>12 ',$_[A],$_[C],'>>',12); { no integer; $_[A] ^= ($_[C]>>12); } ja0(' a2-x c>12',$_[A]); $_[B] -= $_[C]; jb0(' b2-c' ,$_[B]); $_[B] -= $_[A]; jb0(' b2-a' ,$_[B]); bxor(' b2-x a<16 ',$_[B],$_[A],'<<',16); { no integer; $_[B] ^= ($_[A]<<16); } jb0(' b2-x a<16',$_[B]); $_[C] -= $_[A]; jc0(' c2-a' ,$_[C]); $_[C] -= $_[B]; jc0(' c2-b' ,$_[C]); bxor(' c2-x b>5 ',$_[C],$_[B],'>>',5); { no integer; $_[C] ^= ($_[B]>> 5); } jc0(' c2-x b>5 ',$_[C]); $_[A] -= $_[B]; ja0(' a3-b' ,$_[A]); $_[A] -= $_[C]; ja0(' a3-c' ,$_[A]); bxor(' a3-x c>3 ',$_[A],$_[C],'>>', 3); { no integer; $_[A] ^= ($_[C]>> 3); } ja0(' a3-x c>3 ',$_[A]); $_[B] -= $_[C]; jb0(' b3-c' ,$_[B]); $_[B] -= $_[A]; jb0(' b3-a' ,$_[B]); bxor(' b3-x a<10 ',$_[B],$_[A],'<<',10); { no integer; $_[B] ^= ($_[A]<<10); } jb0(' b3-x a<10',$_[B]); $_[C] -= $_[A]; jc0(' c3-a' ,$_[C]); $_[C] -= $_[B]; jc0(' c3-b' ,$_[C]); bxor(' c3-x b>15 ',$_[C],$_[B],'>>',15); { no integer; $_[C] ^= ($_[B]>>15); } jc0(' c3-x b>15 ',$_[C]); } sub mixui ($$$) { use integer; $_[A] -= $_[B]; $_[A] -= $_[C]; { no integer; $_[A] ^= ($_[C]>>13); } $_[B] -= $_[C]; $_[B] -= $_[A]; { no integer; $_[B] ^= ($_[A]<< 8); } $_[C] -= $_[A]; $_[C] -= $_[B]; { no integer; $_[C] ^= ($_[B]>>13); } $_[A] -= $_[B]; $_[A] -= $_[C]; { no integer; $_[A] ^= ($_[C]>>12); } $_[B] -= $_[C]; $_[B] -= $_[A]; { no integer; $_[B] ^= ($_[A]<<16); } $_[C] -= $_[A]; $_[C] -= $_[B]; { no integer; $_[C] ^= ($_[B]>> 5); } $_[A] -= $_[B]; $_[A] -= $_[C]; { no integer; $_[A] ^= ($_[C]>> 3); } $_[B] -= $_[C]; $_[B] -= $_[A]; { no integer; $_[B] ^= ($_[A]<<10); } $_[C] -= $_[A]; $_[C] -= $_[B]; { no integer; $_[C] ^= ($_[B]>>15); } } use constant KEY => 0; use constant INITHASH => 1; sub hash { # orig use integer; my ($a, $b, $c) = ( GOLDEN_RATIO, GOLDEN_RATIO, $_[INITHASH] ); my ($p, $len) = (0, length $_[KEY]); do { my($x,$y,$z) = unpack 'LLL', substr($_[KEY] . (chr(0)x11), $p, 12); $z||='0'; $z<<=8; mix($a += $x, $b += $y, $c += $z); $p += 12; } while $p <= $len; my $hex = unpack("H*", pack("N", $c)); return $hex; } sub hash2 { # NNN instead of LLL, $z=0 not '0' use integer; my ($a, $b, $c) = ( GOLDEN_RATIO, GOLDEN_RATIO, $_[INITHASH] ); my ($p, $len) = (0, length $_[KEY]); do { my($x,$y,$z) = unpack 'NNN', substr($_[KEY] . (chr(0)x11), $p, 12); $z||=0; $z<<=8; mix($a += $x, $b += $y, $c += $z); $p += 12; } while $p <= $len; my $hex = unpack("H*", pack("N", $c)); return $hex; } sub hash20 { # $z=0 not '0' use integer; my ($a, $b, $c) = ( GOLDEN_RATIO, GOLDEN_RATIO, $_[INITHASH] ); my ($p, $len) = (0, length $_[KEY]); do { my($x,$y,$z) = unpack 'LLL', substr($_[KEY] . (chr(0)x11), $p, 12); $z||=0; $z<<=8; mix($a += $x, $b += $y, $c += $z); $p += 12; } while $p <= $len; my $hex = unpack("H*", pack("N", $c)); return $hex; } sub hash3 { # more faithfull to # http://burtleburtle.net/bob/c/lookup2.c use integer; my ($a, $b, $c) = ( GOLDEN_RATIO, GOLDEN_RATIO, $_[INITHASH] ); my ($p, $length) = (0, length $_[KEY]); my $len=$length; my($x,$y,$z); while ($len>=12) { ($x,$y,$z) = unpack 'LLL', substr($_[KEY], $p, 12); $a+=$x;$b+=$y;$c+=$z; mix($a, $b, $c); $p += 12; $len-=12; } ($x,$y,$z) = unpack 'LLL', substr($_[KEY] . (chr(0)x12), $p, 12); $z<<=8; # /* the first byte of c is reserved for the length */ $z+=$length; $a+=$x;$b+=$y;$c+=$z; mix($a, $b, $c); my $hex = unpack("H*", pack("N", $c)); return $hex; } sub hash3exp { # more faithfull to # http://burtleburtle.net/bob/c/lookup2.c use integer; my ($a, $b, $c) = ( GOLDEN_RATIO, GOLDEN_RATIO, $_[INITHASH] ); abc(' entry ',$a,$b,$c); my ($p, $length) = (0, length $_[KEY]); my $len=$length; my($x,$y,$z); while ($len>=12) { ($x,$y,$z) = unpack 'LLL', substr($_[KEY], $p, 12); xyz(' loop ',$x,$y,$z); $a+=$x;$b+=$y;$c+=$z; abc(' loop+ ',$a,$b,$c); mix($a, $b, $c); abc(' lout ',$a,$b,$c); $p += 12; $len-=12; } ($x,$y,$z) = unpack 'LLL', substr($_[KEY] . (chr(0)x12), $p, 12); xyz(' post1 ',$x,$y,$z); $z<<=8; # /* the first byte of c is reserved for the length */ $z+=$length; xyz(' post8 ',$x,$y,$z); $a+=$x;$b+=$y;$c+=$z; abc(' post+ ',$a,$b,$c); mix($a, $b, $c); abc(' pout ',$a,$b,$c); my $hex = unpack("H*", pack("N", $c)); return $hex; } sub hash3ui { # more faithfull to # http://burtleburtle.net/bob/c/lookup2.c use integer; my ($a, $b, $c) = ( GOLDEN_RATIO, GOLDEN_RATIO, $_[INITHASH] ); my ($p, $length) = (0, length $_[KEY]); my $len=$length; my($x,$y,$z); while ($len>=12) { ($x,$y,$z) = unpack 'LLL', substr($_[KEY], $p, 12); $a+=$x;$b+=$y;$c+=$z; mixui($a, $b, $c); $p += 12; $len-=12; } ($x,$y,$z) = unpack 'LLL', substr($_[KEY] . (chr(0)x12), $p, 12); $z<<=8; # /* the first byte of c is reserved for the length */ $z+=$length; $a+=$x;$b+=$y;$c+=$z; mixui($a, $b, $c); my $hex = unpack("H*", pack("N", $c)); return $hex; } } # no use integer ##################### # # has use integer ##################### { # has use integer/bytes use integer; use bytes; # http://www.perlmonks.org/?node_id=315881 # http://burtleburtle.net/bob/c/lookup2.c use constant GOLDEN_RATIO => 0x9e3779b9; use constant A => 0; use constant B => 1; use constant C => 2; use constant FFFFFFFF => 0xffffffff; sub mix4 ($$$) { # per http://www.perlmonks.org/?node_id=1203705 this is a revised 32bit under 'use integer'; $_[A] -= $_[B]; $_[A] -= $_[C]; { no integer; $_[A] ^= ($_[C]>>13); } $_[B] -= $_[C]; $_[B] -= $_[A]; { no integer; $_[B] ^= ($_[A]<< 8); } $_[C] -= $_[A]; $_[C] -= $_[B]; { no integer; $_[C] ^= ($_[B]>>13); } $_[A] -= $_[B]; $_[A] -= $_[C]; { no integer; $_[A] ^= ($_[C]>>12); } $_[B] -= $_[C]; $_[B] -= $_[A]; { no integer; $_[B] ^= ($_[A]<<16); } $_[C] -= $_[A]; $_[C] -= $_[B]; { no integer; $_[C] ^= ($_[B]>> 5); } $_[A] -= $_[B]; $_[A] -= $_[C]; { no integer; $_[A] ^= ($_[C]>> 3); } $_[B] -= $_[C]; $_[B] -= $_[A]; { no integer; $_[B] ^= ($_[A]<<10); } $_[C] -= $_[A]; $_[C] -= $_[B]; { no integer; $_[C] ^= ($_[B]>>15); } } sub mix4x ($$$) { # per http://www.perlmonks.org/?node_id=1203705 this is wrong $_[A] -= $_[B]; $_[A] -= $_[C]; $_[A] ^= ($_[C]>>13); $_[B] -= $_[C]; $_[B] -= $_[A]; $_[B] ^= ($_[A]<< 8); $_[C] -= $_[A]; $_[C] -= $_[B]; $_[C] ^= ($_[B]>>13); $_[A] -= $_[B]; $_[A] -= $_[C]; $_[A] ^= ($_[C]>>12); $_[B] -= $_[C]; $_[B] -= $_[A]; $_[B] ^= ($_[A]<<16); $_[C] -= $_[A]; $_[C] -= $_[B]; $_[C] ^= ($_[B]>> 5); $_[A] -= $_[B]; $_[A] -= $_[C]; $_[A] ^= ($_[C]>> 3); $_[B] -= $_[C]; $_[B] -= $_[A]; $_[B] ^= ($_[A]<<10); $_[C] -= $_[A]; $_[C] -= $_[B]; $_[C] ^= ($_[B]>>15); } sub mix4exp ($$$) { # per http://www.perlmonks.org/?node_id=1203705 this is a revised 32bit under 'use integer'; $_[A] -= $_[B]; ja0(' a1-b' ,$_[A]); $_[A] -= $_[C]; ja0(' a1-c' ,$_[A]); bxor(' a1-x c>13 ',$_[A],$_[C],'>>',13); { no integer; $_[A] ^= ($_[C]>>13); } ja0(' a1-x c>13',$_[A]); $_[B] -= $_[C]; jb0(' b1-c' ,$_[B]); $_[B] -= $_[A]; jb0(' b1-a' ,$_[B]); bxor(' b1-x a<8 ',$_[B],$_[A],'<<', 8); { no integer; $_[B] ^= ($_[A]<< 8); } jb0(' b1-x a< 8',$_[B]); $_[C] -= $_[A]; jc0(' c1-a' ,$_[C]); use Devel::Peek; Dump($_[C]); $_[C] -= $_[B]; jc0(' c1-b' ,$_[C]); Dump($_[C]); bxor(' c1-x b>13 ',$_[C],$_[B],'>>',13); { no integer; $_[C] ^= ($_[B]>>13); } jc0(' c1-x b>13',$_[C]); $_[A] -= $_[B]; ja0(' a2-b' ,$_[A]); $_[A] -= $_[C]; ja0(' a2-c' ,$_[A]); bxor(' a2-x c>12 ',$_[A],$_[C],'>>',12); { no integer; $_[A] ^= ($_[C]>>12); } ja0(' a2-x c>12',$_[A]); $_[B] -= $_[C]; jb0(' b2-c' ,$_[B]); $_[B] -= $_[A]; jb0(' b2-a' ,$_[B]); bxor(' b2-x a<16 ',$_[B],$_[A],'<<',16); { no integer; $_[B] ^= ($_[A]<<16); } jb0(' b2-x a<16',$_[B]); $_[C] -= $_[A]; jc0(' c2-a' ,$_[C]); $_[C] -= $_[B]; jc0(' c2-b' ,$_[C]); bxor(' c2-x b>5 ',$_[C],$_[B],'>>',5); { no integer; $_[C] ^= ($_[B]>> 5); } jc0(' c2-x b>5 ',$_[C]); $_[A] -= $_[B]; ja0(' a3-b' ,$_[A]); $_[A] -= $_[C]; ja0(' a3-c' ,$_[A]); bxor(' a3-x c>3 ',$_[A],$_[C],'>>', 3); { no integer; $_[A] ^= ($_[C]>> 3); } ja0(' a3-x c>3 ',$_[A]); $_[B] -= $_[C]; jb0(' b3-c' ,$_[B]); $_[B] -= $_[A]; jb0(' b3-a' ,$_[B]); bxor(' b3-x a<10 ',$_[B],$_[A],'<<',10); { no integer; $_[B] ^= ($_[A]<<10); } jb0(' b3-x a<10',$_[B]); $_[C] -= $_[A]; jc0(' c3-a' ,$_[C]); $_[C] -= $_[B]; jc0(' c3-b' ,$_[C]); bxor(' c3-x b>15 ',$_[C],$_[B],'>>',15); { no integer; $_[C] ^= ($_[B]>>15); } jc0(' c3-x b>15 ',$_[C]); } sub mix8ni ($$$) { # this shoud get the same hash on 32 and 64 bit ints # F'it, fix them all, all the time, cost is 4 extra & FFFFFFFF's $_[A] &= FFFFFFFF; $_[B] &= FFFFFFFF; $_[C] &= FFFFFFFF; $_[A] -= $_[B]; $_[A] -= $_[C]; { no integer; $_[A] = ( $_[A] ^ ($_[C]>>13) ) & FFFFFFFF; } $_[B] -= $_[C]; $_[B] -= $_[A]; { no integer; $_[B] = ( $_[B] ^ ($_[A]<< 8) ) & FFFFFFFF; } $_[C] -= $_[A]; $_[C] -= $_[B]; { no integer; $_[C] = ( $_[C] ^ ($_[B]>>13) ) & FFFFFFFF; } $_[A] -= $_[B]; $_[A] -= $_[C]; { no integer; $_[A] = ( $_[A] ^ ($_[C]>>12) ) & FFFFFFFF; } $_[B] -= $_[C]; $_[B] -= $_[A]; { no integer; $_[B] = ( $_[B] ^ ($_[A]<<16) ) & FFFFFFFF; } $_[C] -= $_[A]; $_[C] -= $_[B]; { no integer; $_[C] = ( $_[C] ^ ($_[B]>> 5) ) & FFFFFFFF; } $_[A] -= $_[B]; $_[A] -= $_[C]; { no integer; $_[A] = ( $_[A] ^ ($_[C]>> 3) ) & FFFFFFFF; } $_[B] -= $_[C]; $_[B] -= $_[A]; { no integer; $_[B] = ( $_[B] ^ ($_[A]<<10) ) & FFFFFFFF; } $_[C] -= $_[A]; $_[C] -= $_[B]; { no integer; $_[C] = ( $_[C] ^ ($_[B]>>15) ) & FFFFFFFF; } } sub mix8 ($$$) { # this shoud get the same hash on 32 and 64 bit ints # F'it, fix them all, all the time, cost is 4 extra & FFFFFFFF's $_[A] &= FFFFFFFF; $_[B] &= FFFFFFFF; $_[C] &= FFFFFFFF; $_[A] -= $_[B]; $_[A] -= $_[C]; $_[A] = ( $_[A] ^ ($_[C]>>13) ) & FFFFFFFF; $_[B] -= $_[C]; $_[B] -= $_[A]; $_[B] = ( $_[B] ^ ($_[A]<< 8) ) & FFFFFFFF; $_[C] -= $_[A]; $_[C] -= $_[B]; $_[C] = ( $_[C] ^ ($_[B]>>13) ) & FFFFFFFF; $_[A] -= $_[B]; $_[A] -= $_[C]; $_[A] = ( $_[A] ^ ($_[C]>>12) ) & FFFFFFFF; $_[B] -= $_[C]; $_[B] -= $_[A]; $_[B] = ( $_[B] ^ ($_[A]<<16) ) & FFFFFFFF; $_[C] -= $_[A]; $_[C] -= $_[B]; $_[C] = ( $_[C] ^ ($_[B]>> 5) ) & FFFFFFFF; $_[A] -= $_[B]; $_[A] -= $_[C]; $_[A] = ( $_[A] ^ ($_[C]>> 3) ) & FFFFFFFF; $_[B] -= $_[C]; $_[B] -= $_[A]; $_[B] = ( $_[B] ^ ($_[A]<<10) ) & FFFFFFFF; $_[C] -= $_[A]; $_[C] -= $_[B]; $_[C] = ( $_[C] ^ ($_[B]>>15) ) & FFFFFFFF; } sub mix8exp ($$$) { # way extra debug # this shoud get the same hash on 32 and 64 bit ints abc(' m0 ',$_[A],$_[B],$_[C]); $_[A] &= FFFFFFFF; $_[B] &= FFFFFFFF; $_[C] &= FFFFFFFF; abc(' m &ff ',$_[A],$_[B],$_[C]); # $_[A] -= $_[B]; $_[A] -= $_[C]; $_[A] = ( $_[A] ^ ($_[C] >>13) ) & FFFFFFFF; $_[A] -= $_[B]; ja0(' a1-b' ,$_[A]); $_[A] -= $_[C]; ja0(' a1-c' ,$_[A]); bxor(' a1-x c>13 ',$_[A],$_[C],'>>',13); $_[A] = ( $_[A] ^ ($_[C] >>13) ) & FFFFFFFF; ja0(' a1-x c>13',$_[A]); # $_[B] -= $_[C]; $_[B] -= $_[A]; $_[B] = ( $_[B] ^ ($_[A] << 8) ) & FFFFFFFF; $_[B] -= $_[C]; jb0(' b1-c' ,$_[B]); $_[B] -= $_[A]; jb0(' b1-a' ,$_[B]); bxor(' b1-x a< 8 ',$_[B],$_[A],'<<',8); $_[B] = ( $_[B] ^ ($_[A] << 8) ) & FFFFFFFF; jb0(' b1-x a< 8',$_[B]); # $_[C] -= $_[A]; $_[C] -= $_[B]; $_[C] = ( $_[C] ^ ($_[B] >>13) ) & FFFFFFFF; $_[C] -= $_[A]; jc0(' c1-a' ,$_[C]); $_[C] -= $_[B]; jc0(' c1-b' ,$_[C]); bxor(' c1-x b>13 ',$_[C],$_[B],'>>',13); $_[C] = ( $_[C] ^ ($_[B] >>13) ) & FFFFFFFF; jc0(' c1-x b>13',$_[C]); # $_[A] -= $_[B]; $_[A] -= $_[C]; $_[A] = ( $_[A] ^ ($_[C] >>12) ) & FFFFFFFF; $_[A] -= $_[B]; ja0(' a2-b' ,$_[A]); $_[A] -= $_[C]; ja0(' a2-c' ,$_[A]); bxor(' a2-x c>12 ',$_[A],$_[C],'>>',12); $_[A] = ( $_[A] ^ ($_[C] >>12) ) & FFFFFFFF; ja0(' a2-x c>12',$_[A]); # $_[B] -= $_[C]; $_[B] -= $_[A]; $_[B] = ( ($_[B] ^ ($_[A] <<16)) ) & FFFFFFFF; $_[B] -= $_[C]; jb0(' b2-c' ,$_[B]); $_[B] -= $_[A]; jb0(' b2-a' ,$_[B]); bxor(' b2-x a<16 ',$_[B],$_[A],'<<',16); $_[B] = ( ($_[B] ^ ($_[A] <<16)) ) & FFFFFFFF; jb0(' b2-x a<16',$_[B]); # $_[C] -= $_[A]; $_[C] -= $_[B]; $_[C] = ( ($_[C] ^ ($_[B] >> 5)) ) & FFFFFFFF; $_[C] -= $_[A]; jc0(' c2-a' ,$_[C]); $_[C] -= $_[B]; jc0(' c2-b' ,$_[C]); bxor(' c2-x b> 5 ',$_[C],$_[B],'>>',5); $_[C] = ( ($_[C] ^ ($_[B] >> 5)) ) & FFFFFFFF; jc0(' c2-x b> 5',$_[C]); # $_[A] -= $_[B]; $_[A] -= $_[C]; $_[A] = ( ($_[A] ^ ($_[C] >> 3)) ) & FFFFFFFF; $_[A] -= $_[B]; ja0(' a3-b' ,$_[A]); $_[A] -= $_[C]; ja0(' a3-c' ,$_[A]); bxor(' a3-x c> 3 ',$_[A],$_[C],'>>',3); $_[A] = ( ($_[A] ^ ($_[C] >> 3)) ) & FFFFFFFF; ja0(' a3-x c> 3',$_[A]); # $_[B] -= $_[C]; $_[B] -= $_[A]; $_[B] = ( ($_[B] ^ ($_[A] <<10)) ) & FFFFFFFF; $_[B] -= $_[C]; jb0(' b3-c' ,$_[B]); $_[B] -= $_[A]; jb0(' b3-a' ,$_[B]); bxor(' b3-x a<10 ',$_[B],$_[A],'<<',10); $_[B] = ( ($_[B] ^ ($_[A] <<10)) ) & FFFFFFFF; jb0(' b3-x a<10',$_[B]); # $_[C] -= $_[A]; $_[C] -= $_[B]; $_[C] = ( ($_[C] ^ ($_[B] >>15)) ) & FFFFFFFF; $_[C] -= $_[A]; jc0(' c3-a' ,$_[C]); $_[C] -= $_[B]; jc0(' c3-b' ,$_[C]); bxor(' c3-x b>15 ',$_[C],$_[B],'>>',15); $_[C] = ( ($_[C] ^ ($_[B] >>15)) ) & FFFFFFFF; jc0(' c3-x b>15',$_[C]); } sub mix8wide ($$$) { # same as mix8 above with extra spaces and parens to match below $_[A] &= FFFFFFFF; $_[B] &= FFFFFFFF; $_[C] &= FFFFFFFF; $_[A] -= $_[B]; $_[A] -= $_[C]; $_[A] = ( $_[A] ^ ($_[C] >>13) ) & FFFFFFFF; $_[B] -= $_[C]; $_[B] -= $_[A]; $_[B] = ( $_[B] ^ ($_[A] << 8) ) & FFFFFFFF; $_[C] -= $_[A]; $_[C] -= $_[B]; $_[C] = ( $_[C] ^ ($_[B] >>13) ) & FFFFFFFF; $_[A] -= $_[B]; $_[A] -= $_[C]; $_[A] = ( $_[A] ^ ($_[C] >>12) ) & FFFFFFFF; $_[B] -= $_[C]; $_[B] -= $_[A]; $_[B] = ( ($_[B] ^ ($_[A] <<16)) ) & FFFFFFFF; $_[C] -= $_[A]; $_[C] -= $_[B]; $_[C] = ( ($_[C] ^ ($_[B] >> 5)) ) & FFFFFFFF; $_[A] -= $_[B]; $_[A] -= $_[C]; $_[A] = ( ($_[A] ^ ($_[C] >> 3)) ) & FFFFFFFF; $_[B] -= $_[C]; $_[B] -= $_[A]; $_[B] = ( ($_[B] ^ ($_[A] <<10)) ) & FFFFFFFF; $_[C] -= $_[A]; $_[C] -= $_[B]; $_[C] = ( ($_[C] ^ ($_[B] >>15)) ) & FFFFFFFF; } sub mix80f3 ($$$) { $_[C] &= FFFFFFFF; $_[A] -= $_[B]; $_[A] -= $_[C]; $_[A] = ( $_[A] ^ ($_[C] >>13) ); # a dont need fixen cuz its always << $_[B] -= $_[C]; $_[B] -= $_[A]; $_[B] = ( $_[B] ^ ($_[A] << 8) ) & FFFFFFFF; $_[C] -= $_[A]; $_[C] -= $_[B]; $_[C] = ( $_[C] ^ ($_[B] >>13) ) & FFFFFFFF; $_[A] -= $_[B]; $_[A] -= $_[C]; $_[A] = ( $_[A] ^ ($_[C] >>12) ); $_[B] -= $_[C]; $_[B] -= $_[A]; $_[B] = ( ($_[B] ^ ($_[A] <<16)) ) & FFFFFFFF; $_[C] -= $_[A]; $_[C] -= $_[B]; $_[C] = ( ($_[C] ^ ($_[B] >> 5)) ) & FFFFFFFF; $_[A] -= $_[B]; $_[A] -= $_[C]; $_[A] = ( ($_[A] ^ ($_[C] >> 3)) ) & FFFFFFFF; # fix lst one tho , just cuz $_[B] -= $_[C]; $_[B] -= $_[A]; $_[B] = ( ($_[B] ^ ($_[A] <<10)) ) & FFFFFFFF; $_[C] -= $_[A]; $_[C] -= $_[B]; $_[C] = ( ($_[C] ^ ($_[B] >>15)) ) & FFFFFFFF; } sub mix80f2 ($$$) { # opps c could have overflowed and introduced a 1 rather than a 0 on >> 13 $_[A] -= $_[B]; $_[A] -= $_[C]; $_[A] = ( $_[A] ^ (($_[C] & FFFFFFFF ) >>13) ); $_[B] -= $_[C]; $_[B] -= $_[A]; $_[B] = ( $_[B] ^ ($_[A] << 8) ) & FFFFFFFF; $_[C] -= $_[A]; $_[C] -= $_[B]; $_[C] = ( $_[C] ^ ($_[B] >>13) ) & FFFFFFFF; $_[A] -= $_[B]; $_[A] -= $_[C]; $_[A] = ( $_[A] ^ ($_[C] >>12) ); $_[B] -= $_[C]; $_[B] -= $_[A]; $_[B] = ( ($_[B] ^ ($_[A] <<16)) ) & FFFFFFFF; $_[C] -= $_[A]; $_[C] -= $_[B]; $_[C] = ( ($_[C] ^ ($_[B] >> 5)) ) & FFFFFFFF; $_[A] -= $_[B]; $_[A] -= $_[C]; $_[A] = ( ($_[A] ^ ($_[C] >> 3)) ) & FFFFFFFF; $_[B] -= $_[C]; $_[B] -= $_[A]; $_[B] = ( ($_[B] ^ ($_[A] <<10)) ) & FFFFFFFF; $_[C] -= $_[A]; $_[C] -= $_[B]; $_[C] = ( ($_[C] ^ ($_[B] >>15)) ) & FFFFFFFF; } sub mix80f ($$$) { # opps c could have overflowed and introd doce a 1 rather than a 0 on >> 13 $_[A] -= $_[B]; $_[A] -= $_[C]; $_[A] = ( $_[A] ^ (($_[C] & FFFFFFFF ) >>13) ); $_[B] -= $_[C]; $_[B] -= $_[A]; $_[B] = ( $_[B] ^ ($_[A] << 8) ); $_[C] -= $_[A]; $_[C] -= $_[B]; $_[C] = ( $_[C] ^ (($_[B] & FFFFFFFF ) >>13) ); $_[A] -= $_[B]; $_[A] -= $_[C]; $_[A] = ( $_[A] ^ (($_[C] & FFFFFFFF ) >>12) ); $_[B] -= $_[C]; $_[B] -= $_[A]; $_[B] = ( ($_[B] ^ ($_[A] <<16)) ) & FFFFFFFF; $_[C] -= $_[A]; $_[C] -= $_[B]; $_[C] = ( ($_[C] ^ ($_[B] >> 5)) ) & FFFFFFFF; $_[A] -= $_[B]; $_[A] -= $_[C]; $_[A] = ( ($_[A] ^ ($_[C] >> 3)) ) & FFFFFFFF; $_[B] -= $_[C]; $_[B] -= $_[A]; $_[B] = ( ($_[B] ^ ($_[A] <<10)) ) & FFFFFFFF; $_[C] -= $_[A]; $_[C] -= $_[B]; $_[C] = ( ($_[C] ^ ($_[B] >>15)) ) & FFFFFFFF; } sub mix8a ($$$) { # kinda failtfull to mix2 http://burtleburtle.net/bob/c/lookup2.c but leading truncate; $_[A] &= FFFFFFFF; $_[B] &= FFFFFFFF; $_[C] &= FFFFFFFF; $_[A] -= $_[B]; $_[A] -= $_[C]; $_[A] = ( $_[A] ^ ($_[C] >>13) ); $_[B] -= $_[C]; $_[B] -= $_[A]; $_[B] = ( $_[B] ^ ($_[A] << 8) ); $_[C] -= $_[A]; $_[C] -= $_[B]; $_[C] = ( $_[C] ^ (($_[B] & FFFFFFFF ) >>13) ); $_[A] -= $_[B]; $_[A] -= $_[C]; $_[A] = ( $_[A] ^ (($_[C] & FFFFFFFF ) >>12) ); $_[B] -= $_[C]; $_[B] -= $_[A]; $_[B] = ( ($_[B] ^ ($_[A] <<16)) ) & FFFFFFFF; $_[C] -= $_[A]; $_[C] -= $_[B]; $_[C] = ( ($_[C] ^ ($_[B] >> 5)) ) & FFFFFFFF; $_[A] -= $_[B]; $_[A] -= $_[C]; $_[A] = ( ($_[A] ^ ($_[C] >> 3)) ) & FFFFFFFF; $_[B] -= $_[C]; $_[B] -= $_[A]; $_[B] = ( ($_[B] ^ ($_[A] <<10)) ) & FFFFFFFF; $_[C] -= $_[A]; $_[C] -= $_[B]; $_[C] = ( ($_[C] ^ ($_[B] >>15)) ) & FFFFFFFF; } sub mix80 ($$$) { # kinda failtfull to mix2 http://burtleburtle.net/bob/c/lookup2.c $_[A] -= $_[B]; $_[A] -= $_[C]; $_[A] = ( $_[A] ^ ($_[C] >>13) ); $_[B] -= $_[C]; $_[B] -= $_[A]; $_[B] = ( $_[B] ^ ($_[A] << 8) ); $_[C] -= $_[A]; $_[C] -= $_[B]; $_[C] = ( $_[C] ^ (($_[B] & FFFFFFFF ) >>13) ); $_[A] -= $_[B]; $_[A] -= $_[C]; $_[A] = ( $_[A] ^ (($_[C] & FFFFFFFF ) >>12) ); $_[B] -= $_[C]; $_[B] -= $_[A]; $_[B] = ( ($_[B] ^ ($_[A] <<16)) ) & FFFFFFFF; $_[C] -= $_[A]; $_[C] -= $_[B]; $_[C] = ( ($_[C] ^ ($_[B] >> 5)) ) & FFFFFFFF; $_[A] -= $_[B]; $_[A] -= $_[C]; $_[A] = ( ($_[A] ^ ($_[C] >> 3)) ) & FFFFFFFF; $_[B] -= $_[C]; $_[B] -= $_[A]; $_[B] = ( ($_[B] ^ ($_[A] <<10)) ) & FFFFFFFF; $_[C] -= $_[A]; $_[C] -= $_[B]; $_[C] = ( ($_[C] ^ ($_[B] >>15)) ) & FFFFFFFF; } # this is mix2 @ http://burtleburtle.net/bob/c/lookup2.c ##define mix2(a,b,c) \ #{ \ # a -= b; a -= c; a ^= (c>>13); \ # b -= c; b -= a; b ^= (a<< 8); \ # c -= a; c -= b; c ^= ((b&0xffffffff)>>13); \ # a -= b; a -= c; a ^= ((c&0xffffffff)>>12); \ # b -= c; b -= a; b = (b ^ (a<<16)) & 0xffffffff; \ # c -= a; c -= b; c = (c ^ (b>> 5)) & 0xffffffff; \ # a -= b; a -= c; a = (a ^ (c>> 3)) & 0xffffffff; \ # b -= c; b -= a; b = (b ^ (a<<10)) & 0xffffffff; \ # c -= a; c -= b; c = (c ^ (b>>15)) & 0xffffffff; \ #} use constant KEY => 0; use constant INITHASH => 1; sub hashi { # original BrowserUk inside use integer use integer; my ($a, $b, $c) = ( GOLDEN_RATIO, GOLDEN_RATIO, $_[INITHASH] ); my ($p, $len) = (0, length $_[KEY]); do { my($x,$y,$z) = unpack 'LLL', substr($_[KEY] . (chr(0)x11), $p, 12); $z||='0'; $z<<=8; mix4x($a += $x, $b += $y, $c += $z); $p += 12; } while $p <= $len; my $hex = unpack("H*", pack("N", $c)); return $hex; } sub hash2i { # hash2 inside use integer use integer; my ($a, $b, $c) = ( GOLDEN_RATIO, GOLDEN_RATIO, $_[INITHASH] ); my ($p, $len) = (0, length $_[KEY]); do { my($x,$y,$z) = unpack 'NNN', substr($_[KEY] . (chr(0)x11), $p, 12); $z||=0; $z<<=8; mix4x($a += $x, $b += $y, $c += $z); $p += 12; } while $p <= $len; my $hex = unpack("H*", pack("N", $c)); return $hex; } sub hash3s { # returns a "hash3" style sub reference using the "mixer" sub ref named as arg easy to make hash table entries my $mix=shift; return sub { use integer; my ($a, $b, $c) = ( GOLDEN_RATIO, GOLDEN_RATIO, $_[INITHASH] ); my ($p, $length) = (0, length $_[KEY]); my $len=$length; my($x,$y,$z); while ($len>=12) { ($x,$y,$z) = unpack 'LLL', substr($_[KEY], $p, 12); $a+=$x;$b+=$y;$c+=$z; &{$mix}($a, $b, $c); $p += 12; $len-=12; } ($x,$y,$z) = unpack 'LLL', substr($_[KEY] . (chr(0)x12), $p, 12); $z<<=8; # /* the first byte of c is reserved for the length */ $z+=$length; $a+=$x;$b+=$y;$c+=$z; &{$mix}($a, $b, $c); my $hex = unpack("H*", pack("N", $c)); return $hex; }; } # hash3s sub hash3sexp { # returns a "hash3" style sub reference using the "mixer" sub ref named as arg easy to make hash table entries my $mix=shift; my $mixname=shift; return sub { print 'name:'.$mixname."\n"; use integer; my ($a, $b, $c) = ( GOLDEN_RATIO, GOLDEN_RATIO, $_[INITHASH] ); abc(' entry ',$a,$b,$c); my ($p, $length) = (0, length $_[KEY]); my $len=$length; my($x,$y,$z); while ($len>=12) { ($x,$y,$z) = unpack 'LLL', substr($_[KEY], $p, 12); xyz(' loop ',$x,$y,$z); $a+=$x;$b+=$y;$c+=$z; abc(' loop+ ',$a,$b,$c); &{$mix}($a, $b, $c); abc(' lout ',$a,$b,$c); $p += 12; $len-=12; } ($x,$y,$z) = unpack 'LLL', substr($_[KEY] . (chr(0)x12), $p, 12); xyz(' post1 ',$x,$y,$z); $z<<=8; # /* the first byte of c is reserved for the length */ $z+=$length; xyz(' post8 ',$x,$y,$z); $a+=$x;$b+=$y;$c+=$z; abc(' post+ ',$a,$b,$c); &{$mix}($a, $b, $c); abc(' pout ',$a,$b,$c); my $hex = unpack("H*", pack("N", $c)); return $hex; }; } # hash3sexp sub hash38 { # final good pick, mix8 is faithful, and this algo is more faithful, makes it easy to follow use integer; my ($a, $b, $c) = ( GOLDEN_RATIO, GOLDEN_RATIO, $_[INITHASH] ); my ($p, $length) = (0, length $_[KEY]); my $len=$length; my($x,$y,$z); while ($len>=12) { ($x,$y,$z) = unpack 'LLL', substr($_[KEY], $p, 12); $a+=$x;$b+=$y;$c+=$z; mix8($a, $b, $c); $p += 12; $len-=12; } ($x,$y,$z) = unpack 'LLL', substr($_[KEY] . (chr(0)x12), $p, 12); $z<<=8; # /* the first byte of c is reserved for the length */ $z+=$length; $a+=$x;$b+=$y;$c+=$z; mix8($a, $b, $c); my $hex = unpack("H*", pack("N", $c)); return $hex; } # hash38 sub hash38exp { # this is the over debuged version use integer; my ($a, $b, $c) = ( GOLDEN_RATIO, GOLDEN_RATIO, $_[INITHASH] ); abc(' entry ',$a,$b,$c); my ($p, $length) = (0, length $_[KEY]); my $len=$length; my($x,$y,$z); while ($len>=12) { ($x,$y,$z) = unpack 'LLL', substr($_[KEY], $p, 12); xyz(' loop ',$x,$y,$z); $a+=$x;$b+=$y;$c+=$z; abc(' loop+ ',$a,$b,$c); mix8exp($a, $b, $c); abc(' lout ',$a,$b,$c); $p += 12; $len-=12; } ($x,$y,$z) = unpack 'LLL', substr($_[KEY] . (chr(0)x12), $p, 12); xyz(' post1 ',$x,$y,$z); $z<<=8; # /* the first byte of c is reserved for the length */ $z+=$length; xyz(' post8 ',$x,$y,$z); $a+=$x;$b+=$y;$c+=$z; abc(' post+ ',$a,$b,$c); mix8exp($a, $b, $c); abc(' pout ',$a,$b,$c); my $hex = unpack("H*", pack("N", $c)); return $hex; } # hash38 } # has use integer/bytes sub hashfish{ #http://search.cpan.org/~shlomif/Digest-JHash/lib/Digest/JHash.pm # http://www.perlmonks.org/?node_id=315984 # use Digest::JHash; my $hex = unpack("H*", pack("N",Digest::JHash::jhash($_[0]))); return $hex; } # fishhash sub hashfishic { return unpack("H*", pack("N",jhashic($_[0]))); } sub hashfishs { return unpack("H*", pack("N",jhashs ($_[0]))); } sub hashfishu { return unpack("H*", pack("N",jhashu ($_[0]))); } sub abc{ my $when=shift; abc0(sprintf('%-15s',$when).' : '.'ABC ',@_); } sub abc0{ my $when=shift; my $a=shift; my $b=shift; my $c=shift; print sprintf('%-20s',$when).': '.sprintf('%16d',$a).' '.h64($a).' - '.sprintf('%16d',$b).' '.h64($b).' - '.sprintf('%16d',$c).' '.h64($c)."\n"; } sub xyz{ my $when=shift; abc0(sprintf('%-15s',$when).' : '.'XYZ ',@_); } sub order64 { my $name=shift; my $num=shift; # print $name.': Q :'.unpack("H*", pack("Q", $num))."\n"; # print $name.': N-hi :'.unpack("H*", pack("N", $num>>32))."\n"; # print $name.': N-low: '.unpack("H*", pack("N", $num))."\n"; print $name.' : '.h64($num)."\n"; } sub h64 { my $num=shift; return unpack("H*", pack("N", $num>>32)).' '.unpack("H*", pack("N", $num)); } sub tobit32{ my $aa=shift; return ' '.unpack("B*", pack("N", $aa)).' '.h64($aa); } sub h32 { my $num=shift; return ' '.unpack("H*", pack("N", $num)); } sub ja0{ my $when=shift; my $n=shift; j00($when,' : A ',0,$n); } sub jc0{ my $when=shift; my $n=shift; j00($when,' : C',2,$n); } sub jb0{ my $when=shift; my $n=shift; j00($when,' : B ',1,$n); } sub j00{ my $when=shift; my $var=shift; my $off=shift; my $n=shift; my $pad=''; if ($off>0) {$pad.=' - ';} if ($off>1) {$pad.=' - ';} print sprintf('%-15s',$when).$var.' : '.$pad.sprintf('%16d',$n).' '.h64($n)."\n"; } sub nhex{ my $fn=shift; my $ii=shift; my $n=shift; my $pos=int(($ii-1)/$n)*$n; my $len=$ii-$pos; my $chr=substr($fn,$pos,$len); $chr=substr($chr.chr(0)x$n,0,$n); return unpack("H*", $chr); } # nhex sub bxor { my $desc=shift; my $aa=shift; my $c0=shift; my $dir=shift; my $move=shift; print $desc.': orig 1 :'.tobit($aa)."\n"; $desc=~s/./ /g; print $desc.': orig 2 :'.tobit($c0)."\n"; my $moved; my $md=sprintf('%-8s',$dir.$move); if ($dir eq '<<') {$moved=$c0<<$move;} else {$moved=$c0>>$move;} print $desc.': '.$md.':'.tobit($moved)."\n"; my $res=$aa^$moved; print $desc.': res :'.tobit($res)."\n"; } sub bxori { use integer; my $desc=shift; my $aa=shift; my $c0=shift; my $dir=shift; my $move=shift; print $desc.':iorig 1 :'.tobit($aa)."\n"; $desc=~s/./ /g; print $desc.':iorig 2 :'.tobit($c0)."\n"; my $moved; my $md=sprintf('%-8s',$dir.$move); if ($dir eq '<<') {$moved=$c0<<$move;} else {$moved=$c0>>$move;} print $desc.':i'.$md.':'.tobit($moved)."\n"; my $res=$aa^$moved; print $desc.':ires :'.tobit($res)."\n"; } sub tobit{ my $aa=shift; return unpack("B*", pack("N", $aa>>32)).' '.unpack("B*", pack("N", $aa)).' '.h64($aa); } __END__ perl hashtest1.pl -file bigtest -dir d:/ perl hashtest1.pl -file bigtest -seed 0 -hash orig Hashed:110405 hits n 0 4294856890 1 91335 2 3018 3 1028 4 386 5 184 6 218 7 52 8 70 9 169 10 141 11 5 12 12 13 8 14 7 15 2 16 1 18 5 19 2 20 9 28 3 29 1 30 15 31 26 88 1 111 1 perl hashtest1.pl -file bigtest -seed 0 -hash hash2 perl hashtest1.pl -file bigtest -seed 0 -hash orig -h2 hash20 perl hashtest1.pl -file bigtest -seed 1 -hash orig perl hashtest1.pl -file bigtest -seed 0 -hash hash3 perl hashtest1.pl -file bigtest -seed 0 -hash hashi perl hashtest1.pl -file bigtest -seed 0 -hash hash2i perl hashtest1.pl -file bigtest -seed 0 -hash hash3i perl hashtest1.pl -file bigtest -seed 0 -hash orig -h2 origi perl hashtest1.pl -file bigtest -seed 0 -hash hash2 -h2 hash2i perl hashtest1.pl -file bigtest -seed 0 -hash hash3 -h2 hash3i perl hashtest1.pl -file bigtest -seed 0 -hash hash30 perl hashtest1.pl -file bigtest -seed 0 -hash hash3a perl hashtest1.pl -file bigtest -seed 0 -hash hash3f perl hashtest1.pl -file bigtest -seed 0 -hash hash3f2 perl hashtest1.pl -file bigtest -seed 0 -hash hash3f3 perl hashtest1.pl -file bigtest -seed 0 -hash hash38 perl hashtest1.pl -file bigtest -seed 0 -hash hash3a -h2 hash38 perl hashtest1.pl -file bigtest -seed 0 -hash hash3f -h2 hash38 perl hashtest1.pl -file bigtest -seed 0 -hash hash3f2 -h2 hash38 perl hashtest1.pl -file bigtest -seed 0 -hash hash3f3 -h2 hash38 perl hashtest1.pl -file bigtest -seed 0 -hash fish perl hashtest1.pl -file bigtest -seed 0 -hash fish -h2 fix perl hashtest1.pl -file bigtest -seed 0 -hash fish -h2 fix -listdiff -finddiff perl hashtest1.pl -file d3t.txt -seed 0 -hash fish -h2 fix -listdiff -finddiff perl hashtest1.pl -file d3t.txt -seed 0 -hash fish -h2 fix -listdiff -finddiff -blowup perl hashtest1.pl -file d3t.txt -seed 0 -hash fishodvs -h2 fixexp -listdiff -finddiff -blowup perl hashtest1.pl -file d3t.txt -seed 0 -hash fishodvu -h2 fixexp -listdiff -finddiff -blowup perl hashtest1.pl -file d3t.txt -seed 0 -hash fishic -h2 fix perl hashtest1.pl -file d3t.txt -seed 0 -hash fishic -h2 fix differences:0 Hashed:564263 hits n 0 4294403032 1 564181 2 41 perl hashtest1.pl -file d3t.txt -seed 0 -hash orig Hashed:564263 hits n 0 4294403032 1 496470 2 9270 3 2065 4 1416 5 891 6 566 7 329 8 294 9 540 10 450 11 101 12 152 13 53 14 83 15 60 16 61 17 40 18 40 19 28 20 15 21 24 22 7 23 11 24 8 25 5 26 5 27 3 28 15 29 7 30 40 31 74 32 2 37 1 38 2 39 1 40 2 48 2 49 2 50 1 51 1 52 1 57 1 61 1 64 1 74 1 77 1 102 1 perl hashtest1.pl -file d3t.txt -seed 0 -hash fix Hashed:564263 hits n 0 4294403032 1 564181 2 41 on 32bit perl \\pdhuck\d\active\misc\util\hashtest1.pl -file \\pdhuck\d\active\misc\util\smalltest.txt -hash hash34 -o c:\active\hashtest\smallout32.txt -noc perl hashtest1.pl -file smalltest.txt -seed 0 -hash hash38 -h2 hash34 -o smallout64.txt hashcomp1.pl -file1 smallout64.txt -file2 \\bt\c\active\hashtest\smallout32.txt on32bit perl \\pdhuck\d\active\misc\util\hashtest1.pl -file \\pdhuck\d\active\misc\util\smalltest.txt -noc -hash hash3exp -h2 hash34exp -blowup #### #include "EXTERN.h" #include "perl.h" #include "XSUB.h" /* http://cpansearch.perl.org/src/SHLOMIF/Digest-JHash-0.10/JHash.xs */ /* overly debuged version of original with new fn name so they can coesixt */ /* Jenkins Hash http://burtleburtle.net/bob/hash/doobs.html */ typedef unsigned long int U32tf; /* unsigned 4-byte quantities */ void c_out0 ( char* str, U32tf a, U32tf b, U32tf c ) { printf( "%-20s%16u %016x - %16u %016x - %16u %016x \n", str,a,a,b,b,c,c ); } const int DEBUGODV = 1; /* Need to constrain U32 to only 32 bits on 64 bit systems * For efficiency we only use the & 0xffffffff if required */ #if BYTEORDER > 0x4321 || defined(TRUNCATE_U32) #define MIXODV(a,b,c) \ { \ c_out0(" cm064 : ABC : ",a,b,c); \ a &= 0xffffffff; b &= 0xffffffff; c &= 0xffffffff; \ c_out0(" cm &ff : ABC : ",a,b,c); \ a -= b;\ c_out0(" cm a1-b : ABC : ",a,b,c); \ a -= c; \ c_out0(" cm a1-c : ABC : ",a,b,c); \ a ^= (c>>13);\ c_out0(" cm c1-x c>13 : ABC : ",a,b,c); \ a &= 0xffffffff; \ c_out0(" cm a1 : ABC : ",a,b,c); \ \ \ b -= c; b -= a; b ^= (a<<8); b &= 0xffffffff; \ c_out0(" cm b1 : ABC : ",a,b,c); \ \ c -= a; \ c_out0(" cm c1-a : ABC : ",a,b,c); \ c -= b; \ c_out0(" cm c1-b : ABC : ",a,b,c); \ c ^= (b>>13);\ c_out0(" cm c1-x b>13 : ABC : ",a,b,c); \ c &= 0xffffffff; \ c_out0(" cm c1 : ABC : ",a,b,c); \ \ \ \ a -= b; a -= c; a ^= (c>>12); a &= 0xffffffff; \ c_out0(" cm a2 : ABC : ",a,b,c); \ b -= c; b -= a; b ^= (a<<16); b &= 0xffffffff; \ c_out0(" cm b2 : ABC : ",a,b,c); \ c -= a; c -= b; c ^= (b>>5); c &= 0xffffffff; \ c_out0(" cm c2 : ABC : ",a,b,c); \ a -= b; a -= c; a ^= (c>>3); a &= 0xffffffff; \ c_out0(" cm a3 : ABC : ",a,b,c); \ b -= c; b -= a; b ^= (a<<10); b &= 0xffffffff; \ c_out0(" cm b3 : ABC : ",a,b,c); \ c -= a; c -= b; c ^= (b>>15); c &= 0xffffffff; \ c_out0(" cm c3 : ABC : ",a,b,c); \ } #else #define MIXODV(a,b,c) \ { \ c_out0(" cm032 : ABC : ",a,b,c); \ a -= b; a -= c; a ^= (c>>13); \ b -= c; b -= a; b ^= (a<<8); \ c -= a; c -= b; c ^= (b>>13); \ a -= b; a -= c; a ^= (c>>12); \ b -= c; b -= a; b ^= (a<<16); \ c -= a; c -= b; c ^= (b>>5); \ a -= b; a -= c; a ^= (c>>3); \ b -= c; b -= a; b ^= (a<<10); \ c -= a; c -= b; c ^= (b>>15); \ } #endif U32 jhashs( SV* str ) { STRLEN rawlen; char* p; U32tf a, b, c, len, length; U32tf x, y, z; /* extract the string data and string length from the perl scalar */ p = (char*)SvPV(str, rawlen); length = len = (U32tf)rawlen; /* Test for undef or null string case and return 0 */ if ( length == 0 ) { DEBUGODV && printf( "Recieved a null or undef string!\n" ); return 0; } DEBUGODV && printf( "Received string %6i '%.*s'.\n", (int)len,(int)len, p ); a = b = 0x9e3779b9; /* golden ratio suggested by Jenkins */ c = 0; c_out0(" centry : ABC : ",a,b,c); while (len >= 12) { a += (p[0] + (((U32tf)p[1])<<8) + (((U32tf)p[2])<<16) + (((U32tf)p[3])<<24)); b += (p[4] + (((U32tf)p[5])<<8) + (((U32tf)p[6])<<16) + (((U32tf)p[7])<<24)); c += (p[8] + (((U32tf)p[9])<<8) + (((U32tf)p[10])<<16) + (((U32tf)p[11])<<24)); c_out0(" cloop+ : ABC : ",a,b,c); MIXODV(a, b, c); c_out0(" clout : ABC : ",a,b,c); p += 12; len -= 12; } x = y = z= 0; z += length; switch(len) { case 11: z+=((U32tf)p[10]<<24); case 10: z+=((U32tf)p[9]<<16); case 9: z+=((U32tf)p[8]<<8); case 8: y+=((U32tf)p[7]<<24); case 7: y+=((U32tf)p[6]<<16); case 6: y+=((U32tf)p[5]<<8); case 5: y+=((U32tf)p[4]); case 4: x+=((U32tf)p[3]<<24); case 3: x+=((U32tf)p[2]<<16); case 2: x+=((U32tf)p[1]<<8); case 1: x+=((U32tf)p[0]); } c_out0(" cpost8 : XYZ : ",x,y,z); a+=x; b+=y;c+=z; c_out0(" cpost+ : ABC : ",a,b,c); MIXODV(a, b, c); c_out0(" cpout : ABC : ",a,b,c); DEBUGODV && printf( "Hash value is %d.\n", (int)(c) ); return(c); } #### #include "EXTERN.h" #include "perl.h" #include "XSUB.h" /* http://cpansearch.perl.org/src/SHLOMIF/Digest-JHash-0.10/JHash.xs */ /* overly documented version of fix, unsigned char* p ; */ /* Jenkins Hash http://burtleburtle.net/bob/hash/doobs.html */ typedef unsigned long int U32tf; /* unsigned 4-byte quantities */ void c_out0 ( char* str, U32tf a, U32tf b, U32tf c ) { printf( "%-20s%16u %016x - %16u %016x - %16u %016x \n", str,a,a,b,b,c,c ); } const int DEBUGODV = 1; /* Need to constrain U32 to only 32 bits on 64 bit systems * For efficiency we only use the & 0xffffffff if required */ #if BYTEORDER > 0x4321 || defined(TRUNCATE_U32) #define MIXODV(a,b,c) \ { \ c_out0(" cm064 : ABC : ",a,b,c); \ a &= 0xffffffff; b &= 0xffffffff; c &= 0xffffffff; \ c_out0(" cm &ff : ABC : ",a,b,c); \ a -= b;\ c_out0(" cm a1-b : ABC : ",a,b,c); \ a -= c; \ c_out0(" cm a1-c : ABC : ",a,b,c); \ a ^= (c>>13);\ c_out0(" cm c1-x c>13 : ABC : ",a,b,c); \ a &= 0xffffffff; \ c_out0(" cm a1 : ABC : ",a,b,c); \ \ \ b -= c; b -= a; b ^= (a<<8); b &= 0xffffffff; \ c_out0(" cm b1 : ABC : ",a,b,c); \ \ c -= a; \ c_out0(" cm c1-a : ABC : ",a,b,c); \ c -= b; \ c_out0(" cm c1-b : ABC : ",a,b,c); \ c ^= (b>>13);\ c_out0(" cm c1-x b>13 : ABC : ",a,b,c); \ c &= 0xffffffff; \ c_out0(" cm c1 : ABC : ",a,b,c); \ \ \ \ a -= b; a -= c; a ^= (c>>12); a &= 0xffffffff; \ c_out0(" cm a2 : ABC : ",a,b,c); \ b -= c; b -= a; b ^= (a<<16); b &= 0xffffffff; \ c_out0(" cm b2 : ABC : ",a,b,c); \ c -= a; c -= b; c ^= (b>>5); c &= 0xffffffff; \ c_out0(" cm c2 : ABC : ",a,b,c); \ a -= b; a -= c; a ^= (c>>3); a &= 0xffffffff; \ c_out0(" cm a3 : ABC : ",a,b,c); \ b -= c; b -= a; b ^= (a<<10); b &= 0xffffffff; \ c_out0(" cm b3 : ABC : ",a,b,c); \ c -= a; c -= b; c ^= (b>>15); c &= 0xffffffff; \ c_out0(" cm c3 : ABC : ",a,b,c); \ } #else #define MIXODV(a,b,c) \ { \ c_out0(" cm032 : ABC : ",a,b,c); \ a -= b; a -= c; a ^= (c>>13); \ b -= c; b -= a; b ^= (a<<8); \ c -= a; c -= b; c ^= (b>>13); \ a -= b; a -= c; a ^= (c>>12); \ b -= c; b -= a; b ^= (a<<16); \ c -= a; c -= b; c ^= (b>>5); \ a -= b; a -= c; a ^= (c>>3); \ b -= c; b -= a; b ^= (a<<10); \ c -= a; c -= b; c ^= (b>>15); \ } #endif U32 jhashu( SV* str ) { STRLEN rawlen; unsigned char* p; U32tf a, b, c, len, length; U32tf x, y, z; /* extract the string data and string length from the perl scalar */ p = (char*)SvPV(str, rawlen); length = len = (U32tf)rawlen; /* Test for undef or null string case and return 0 */ if ( length == 0 ) { DEBUGODV && printf( "Recieved a null or undef string!\n" ); return 0; } DEBUGODV && printf( "Received string %6i '%.*s'.\n", (int)len,(int)len, p ); a = b = 0x9e3779b9; /* golden ratio suggested by Jenkins */ c = 0; c_out0(" centry : ABC : ",a,b,c); while (len >= 12) { a += (p[0] + (((U32tf)p[1])<<8) + (((U32tf)p[2])<<16) + (((U32tf)p[3])<<24)); b += (p[4] + (((U32tf)p[5])<<8) + (((U32tf)p[6])<<16) + (((U32tf)p[7])<<24)); c += (p[8] + (((U32tf)p[9])<<8) + (((U32tf)p[10])<<16) + (((U32tf)p[11])<<24)); c_out0(" cloop+ : ABC : ",a,b,c); MIXODV(a, b, c); c_out0(" clout : ABC : ",a,b,c); p += 12; len -= 12; } x = y = z= 0; z += length; switch(len) { case 11: z+=((U32tf)p[10]<<24); case 10: z+=((U32tf)p[9]<<16); case 9: z+=((U32tf)p[8]<<8); case 8: y+=((U32tf)p[7]<<24); case 7: y+=((U32tf)p[6]<<16); case 6: y+=((U32tf)p[5]<<8); case 5: y+=((U32tf)p[4]); case 4: x+=((U32tf)p[3]<<24); case 3: x+=((U32tf)p[2]<<16); case 2: x+=((U32tf)p[1]<<8); case 1: x+=((U32tf)p[0]); } c_out0(" cpost8 : XYZ : ",x,y,z); a+=x; b+=y;c+=z; c_out0(" cpost+ : ABC : ",a,b,c); MIXODV(a, b, c); c_out0(" cpout : ABC : ",a,b,c); DEBUGODV && printf( "Hash value is %d.\n", (int)(c) ); return(c); }