Merge branch 'nasm-2.09.xx'
[nasm/nasm.git] / perllib / phash.ph
blob936978a57618e087dba074e77fd5e063bb20aae2
1 # -*- perl -*-
3 # Perfect Minimal Hash Generator written in Perl, which produces
4 # C output.
7 require 'random_sv_vectors.ph';
8 require 'crc64.ph';
11 # Compute the prehash for a key
13 # prehash(key, sv, N)
15 sub prehash($$$) {
16     my($key, $n, $sv) = @_;
17     my @c = crc64($sv, $key);
19     # Create a bipartite graph...
20     $k1 = (($c[1] & ($n-1)) << 1) + 0; # low word
21     $k2 = (($c[0] & ($n-1)) << 1) + 1; # high word
23     return ($k1, $k2);
27 # Walk the assignment graph, return true on success
29 sub walk_graph($$$$) {
30     my($nodeval,$nodeneigh,$n,$v) = @_;
31     my $nx;
33     # print STDERR "Vertex $n value $v\n";
34     $$nodeval[$n] = $v;
36     foreach $nx (@{$$nodeneigh[$n]}) {
37         # $nx -> [neigh, hash]
38         my ($o, $e) = @$nx;
40         # print STDERR "Edge $n,$o value $e: ";
41         my $ov;
42         if (defined($ov = $$nodeval[$o])) {
43             if ($v+$ov != $e) {
44                 # Cyclic graph with collision
45                 # print STDERR "error, should be ", $v+$ov, "\n";
46                 return 0;
47             } else {
48                 # print STDERR "ok\n";
49             }
50         } else {
51             return 0 unless (walk_graph($nodeval, $nodeneigh, $o, $e-$v));
52         }
53     }
54     return 1;
58 # Generate the function assuming a given N.
60 # gen_hash_n(N, sv, \%data, run)
62 sub gen_hash_n($$$$) {
63     my($n, $sv, $href, $run) = @_;
64     my @keys = keys(%{$href});
65     my $i, $sv;
66     my $gr;
67     my $k, $v;
68     my $gsize = 2*$n;
69     my @nodeval;
70     my @nodeneigh;
71     my %edges;
73     for ($i = 0; $i < $gsize; $i++) {
74         $nodeneigh[$i] = [];
75     }
77     %edges = ();
78     foreach $k (@keys) {
79         my ($pf1, $pf2) = prehash($k, $n, $sv);
80         ($pf1,$pf2) = ($pf2,$pf1) if ($pf1 > $pf2); # Canonicalize order
82         my $pf = "$pf1,$pf2";
83         my $e = ${$href}{$k};
84         my $xkey;
86         if (defined($xkey = $edges{$pf})) {
87             next if ($e == ${$href}{$xkey}); # Duplicate hash, safe to ignore
88             if (defined($run)) {
89                 print STDERR "$run: Collision: $pf: $k with $xkey\n";
90             }
91             return;
92         }
94         # print STDERR "Edge $pf value $e from $k\n";
96         $edges{$pf} = $k;
97         push(@{$nodeneigh[$pf1]}, [$pf2, $e]);
98         push(@{$nodeneigh[$pf2]}, [$pf1, $e]);
99     }
101     # Now we need to assign values to each vertex, so that for each
102     # edge, the sum of the values for the two vertices give the value
103     # for the edge (which is our hash index.)  If we find an impossible
104     # sitation, the graph was cyclic.
105     @nodeval = (undef) x $gsize;
107     for ($i = 0; $i < $gsize; $i++) {
108         if (scalar(@{$nodeneigh[$i]})) {
109             # This vertex has neighbors (is used)
110             if (!defined($nodeval[$i])) {
111                 # First vertex in a cluster
112                 unless (walk_graph(\@nodeval, \@nodeneigh, $i, 0)) {
113                     if (defined($run)) {
114                         print STDERR "$run: Graph is cyclic\n";
115                     }
116                     return;
117                 }
118             }
119         }
120     }
122     # for ($i = 0; $i < $n; $i++) {
123     #   print STDERR "Vertex ", $i, ": ", $g[$i], "\n";
124     # }
126     if (defined($run)) {
127         printf STDERR "$run: Done: n = $n, sv = [0x%08x, 0x%08x]\n",
128         $$sv[0], $$sv[1];
129     }
131     return ($n, $sv, \@nodeval);
135 # Driver for generating the function
137 # gen_perfect_hash(\%data)
139 sub gen_perfect_hash($) {
140     my($href) = @_;
141     my @keys = keys(%{$href});
142     my @hashinfo;
143     my $n, $i, $j, $sv, $maxj;
144     my $run = 1;
146     # Minimal power of 2 value for N with enough wiggle room.
147     # The scaling constant must be larger than 0.5 in order for the
148     # algorithm to ever terminate.
149     my $room = scalar(@keys)*0.8;
150     $n = 1;
151     while ($n < $room) {
152         $n <<= 1;
153     }
155     # Number of times to try...
156     $maxj = scalar @random_sv_vectors;
158     for ($i = 0; $i < 4; $i++) {
159         printf STDERR "%d vectors, trying n = %d...\n",
160                 scalar @keys, $n;
161         for ($j = 0; $j < $maxj; $j++) {
162             $sv = $random_sv_vectors[$j];
163             @hashinfo = gen_hash_n($n, $sv, $href, $run++);
164             return @hashinfo if (@hashinfo);
165         }
166         $n <<= 1;
167     }
169     return;
173 # Verify that the hash table is actually correct...
175 sub verify_hash_table($$)
177     my ($href, $hashinfo) = @_;
178     my ($n, $sv, $g) = @{$hashinfo};
179     my $k;
180     my $err = 0;
182     foreach $k (keys(%$href)) {
183         my ($pf1, $pf2) = prehash($k, $n, $sv);
184         my $g1 = ${$g}[$pf1];
185         my $g2 = ${$g}[$pf2];
187         if ($g1+$g2 != ${$href}{$k}) {
188             printf STDERR "%s(%d,%d): %d+%d = %d != %d\n",
189             $k, $pf1, $pf2, $g1, $g2, $g1+$g2, ${$href}{$k};
190             $err = 1;
191         } else {
192             # printf STDERR "%s: %d+%d = %d ok\n",
193             # $k, $g1, $g2, $g1+$g2;
194         }
195     }
197     die "$0: hash validation error\n" if ($err);