From 6ee086a492c804afbb1a285451e2acdcd84e61d6 Mon Sep 17 00:00:00 2001 From: Brad Gilbert Date: Sun, 12 Apr 2009 17:05:57 -0500 Subject: [PATCH] Minor fix --- perl/lib/phash.pm | 229 ++++++++++++++++++++++++++++++++++++++++++ perl/lib/random_sv_vectors.pm | 75 ++++++++++++++ perl/t/version/dump.t | 2 +- perl/t/version/h.t | 2 +- perl/t/version/input.pm | 4 +- perl/t/version/mac.t | 2 +- perl/t/version/make.t | 2 +- perl/t/version/nsis.t | 2 +- perl/t/version/sed.t | 2 +- perl/version.pl | 2 +- version.pl | 27 ++++- 11 files changed, 337 insertions(+), 12 deletions(-) create mode 100644 perl/lib/phash.pm create mode 100644 perl/lib/random_sv_vectors.pm diff --git a/perl/lib/phash.pm b/perl/lib/phash.pm new file mode 100644 index 00000000..f054c1d5 --- /dev/null +++ b/perl/lib/phash.pm @@ -0,0 +1,229 @@ +# -*- perl -*- +# +# Perfect Minimal Hash Generator written in Perl, which produces +# C output. +# +# Requires the CPAN Graph module (tested against 0.81, 0.83, 0.84) +# +use strict; +use warnings; + +use random_sv_vectors; +use nasm::crc64; + +# +# Compute the prehash for a key +# +# prehash(key, N, sv) +# +sub prehash($$\@) { + my($key, $n, $sv) = @_; + my @c = crc64(@$sv, $key); + + # Create a bipartite graph... + my $low_word = (($c[1] & ($n-1)) << 1) + 0; # low word + my $high_word = (($c[0] & ($n-1)) << 1) + 1; # high word + + return ($low_word, $high_word); +} + +# +# Walk the assignment graph, return true on success +# +sub walk_graph(\@\@$$); +sub walk_graph(\@\@$$) { + my($node_val,$node_neighbor,$n,$v) = @_; + + # print STDERR "Vertex $n value $v\n"; + $node_val->[$n] = $v; + + for my $nx ( @{$node_neighbor->[$n]} ){ + # $nx -> [neigh, hash] + my ($o, $e) = @$nx; + + # print STDERR "Edge $n,$o value $e: "; + my $ov = $node_val->[$o]; + if( defined($ov) ){ + if ($v+$ov != $e) { + # Cyclic graph with collision + # print STDERR "error, should be ", $v+$ov, "\n"; + return 0; + } else { + # print STDERR "ok\n"; + } + }elsif( not walk_graph( @$node_val, @$node_neighbor, $o, $e-$v )){ + return 0; + } + } + return 1; +} + +# +# Generate the function assuming a given N. +# +# gen_hash_n(N, sv, \%data, run) +# +sub gen_hash_n($\@\%$) { + my($n, $sv, $href, $run) = @_; + my @keys = keys(%{$href}); + my $i; + my $gr; + my $gsize = 2*$n; + my @node_val; + my @node_neighbor; + my %edges; + + for ($i = 0; $i < $gsize; $i++) { + $node_neighbor[$i] = []; + } + + %edges = (); + for my $key( @keys ){ + my ($pf1, $pf2) = prehash($key, $n, @$sv); + ($pf1,$pf2) = ($pf2,$pf1) if ($pf1 > $pf2); # Canonicalize order + + my $pf = "$pf1,$pf2"; + my $e = $href->{$key}; + my $xkey; + + if (defined($xkey = $edges{$pf})) { + next if ($e == $href->{$xkey}); # Duplicate hash, safe to ignore + if (defined($run)) { + print STDERR "$run: Collision: $pf: $key with $xkey\n"; + } + return; + } + + # print STDERR "Edge $pf value $e from $k\n"; + + $edges{$pf} = $key; + push(@{$node_neighbor[$pf1]}, [$pf2, $e]); + push(@{$node_neighbor[$pf2]}, [$pf1, $e]); + } + + # Now we need to assign values to each vertex, so that for each + # edge, the sum of the values for the two vertices give the value + # for the edge (which is our hash index.) If we find an impossible + # sitation, the graph was cyclic. + @node_val = (undef) x $gsize; + + for ($i = 0; $i < $gsize; $i++) { + if (scalar(@{$node_neighbor[$i]})) { + # This vertex has neighbors (is used) + if (!defined($node_val[$i])) { + # First vertex in a cluster + unless (walk_graph( @node_val, @node_neighbor, $i, 0)) { + if (defined($run)) { + print STDERR "$run: Graph is cyclic\n"; + } + return; + } + } + } + } + + # for ($i = 0; $i < $n; $i++) { + # print STDERR "Vertex ", $i, ": ", $g[$i], "\n"; + # } + + if (defined($run)) { + printf STDERR "$run: Done: n = $n, sv = [0x%08x, 0x%08x]\n", + $$sv[0], $$sv[1]; + } + + return ($n, $sv, \@node_val); +} + +# +# Driver for generating the function +# +# gen_perfect_hash(\%data) +# +sub gen_perfect_hash(\%) { + my($href) = @_; + my @keys = keys(%{$href}); + my @hashinfo; + my( $n, $i, $j, $sv, $maxj ); + my $run = 1; + + # Minimal power of 2 value for N with enough wiggle room. + # The scaling constant must be larger than 0.5 in order for the + # algorithm to ever terminate. + my $room = scalar(@keys)*0.8; + $n = 1; + while ($n < $room) { + $n <<= 1; + } + + # Number of times to try... + $maxj = scalar @random_sv_vectors; + + for ($i = 0; $i < 4; $i++) { + printf STDERR "%d vectors, trying n = %d...\n", + scalar @keys, $n; + for ($j = 0; $j < $maxj; $j++) { + $sv = $random_sv_vectors[$j]; + @hashinfo = gen_hash_n($n, @$sv, %$href, $run++); + return @hashinfo if (@hashinfo); + } + $n <<= 1; + } + + return; +} + +# +# Read input file +# +sub read_input() { + my( $key,$val); + my %out; + my $x = 0; + + while ( my $l = ) { + chomp $l; + $l =~ s/\s*(\#.*|)$//; + + next if ($l eq ''); + + if ($l =~ /^([^=]+)\=([^=]+)$/) { + $out{$1} = $2; + $x = $2; + } else { + $out{$l} = $x; + } + $x++; + } + + return %out; +} + +# +# Verify that the hash table is actually correct... +# +sub verify_hash_table($$) +{ + my ($href, $hashinfo) = @_; + my ($n, $sv, $g) = @{$hashinfo}; + my $k; + my $err = 0; + + foreach $k (keys(%$href)) { + my ($pf1, $pf2) = prehash($k, $n, @$sv); + my $g1 = ${$g}[$pf1]; + my $g2 = ${$g}[$pf2]; + + if ($g1+$g2 != ${$href}{$k}) { + printf STDERR "%s(%d,%d): %d+%d = %d != %d\n", + $k, $pf1, $pf2, $g1, $g2, $g1+$g2, ${$href}{$k}; + $err = 1; + } else { + # printf STDERR "%s: %d+%d = %d ok\n", + # $k, $g1, $g2, $g1+$g2; + } + } + + die "$0: hash validation error\n" if ($err); +} + +1; diff --git a/perl/lib/random_sv_vectors.pm b/perl/lib/random_sv_vectors.pm new file mode 100644 index 00000000..d61aec67 --- /dev/null +++ b/perl/lib/random_sv_vectors.pm @@ -0,0 +1,75 @@ +package random_sv_vectors; +use warnings; +use strict; + +require Exporter; +our @ISA = qw(Exporter); +our @EXPORT = qw(@random_sv_vectors); + +our @random_sv_vectors = ( + [0x076259c3, 0xe291c26c], [0xaee7ac5c, 0xcabdec91], + [0x5d3862fb, 0x2e8a3060], [0x6fb3635c, 0x4783593a], + [0x13f0eafb, 0x407e486a], [0x7436afdd, 0xd04c4829], + [0xace2d0e4, 0x80575791], [0x2dd9a392, 0xdc1e869e], + [0x199c3e38, 0x026a9d67], [0x9f911c85, 0x3a489c87], + [0x9ac31028, 0x0b6e14b2], [0x2ccfbcf9, 0x3f9f2308], + [0x2e0210fb, 0x392f380f], [0x14ab403a, 0x81a11065], + [0xd496f63c, 0x53196b13], [0x48a34d7f, 0x2ffc6036], + [0x34ea8e9d, 0xcd1ed098], [0x2da1a3f2, 0x3d6c23f2], + [0xca7374da, 0x06054f89], [0xc909a0bb, 0x31d6c0d2], + [0x87454496, 0x15b360d7], [0x9eebbd12, 0x89532131], + [0x1119c65b, 0xd9e49705], [0x60c3be0b, 0xd6cc7c8a], + [0x117723cd, 0x40af090f], [0xfc284f51, 0x3dcf4c06], + [0xb41fcda4, 0xec03644c], [0xd99e1ea7, 0x84eaf76d], + [0x534b956a, 0x06d3fb8d], [0x2da4bb09, 0x078092eb], + [0x6a5be463, 0xbfa51a88], [0xc4e8be95, 0xe7eec27c], + [0x15a1fbb9, 0xfadc08cd], [0x0bcfab08, 0xbccade0f], + [0x629f1f6c, 0x90ccede7], [0x5c2b26aa, 0x1f0b1fce], + [0xdfe0e3fd, 0xbd7c3cfb], [0xa1628ca9, 0x90a05686], + [0xbf0267f2, 0xd2964139], [0x8009a9b9, 0xd2195918], + [0xfcc7b5f8, 0xc108c643], [0xf447d4b0, 0x71953863], + [0x95d091ed, 0xdbe01948], [0x81dec325, 0x2bfecda2], + [0x2ed2acaa, 0x7eeaa0d0], [0xb7b0a20e, 0x8bf5c01b], + [0x75eb3917, 0xfd2f758f], [0xb33a5b49, 0x8a8cedf6], + [0x3aaf2757, 0x69b319a9], [0x32cfa41b, 0xeba36f19], + [0xf54209dd, 0x941f3a08], [0x232703bb, 0x786a6f84], + [0x4937b242, 0xc9f07398], [0x74dc5d39, 0x550a58e8], + [0x6c9aebdc, 0x8fda5069], [0x5ae6d62a, 0x05cd24a3], + [0x8111e50a, 0xc1c6d19b], [0xb980a92b, 0x448b4d1f], + [0x568cf58a, 0x8bcb93ca], [0xfe96002f, 0x410cd2f1], + [0xaf511e45, 0x99e4872f], [0x822c20bc, 0x3db49ddd], + [0x184fec4e, 0xbb82ec52], [0x30ca5326, 0xf3180297], + [0x97962aa4, 0x7d4bc6d4], [0x9199a315, 0x8e9f18c6], + [0xead69a7e, 0x3262a683], [0xe261ec00, 0x81edc47a], + [0x06080c0e, 0x6d18fa9f], [0x1771ec43, 0x6747ed66], + [0xe71fe587, 0xe81ad0f3], [0xf083e80c, 0x0898bcd8], + [0x30328c5a, 0x2efb4ee7], [0xd04fa5d7, 0xec9c9f18], + [0x87820480, 0x48932224], [0xb1f18815, 0x1b27e3e3], + [0x79aa440c, 0xdf17a8fc], [0x8a83d404, 0x10fdec8c], + [0x7d4dfe60, 0x573561ee], [0x60315c7d, 0xa0692af6], + [0xb3ca4d52, 0x89ca832f], [0x9ebc5c79, 0xa84a28fc], + [0xdfa76008, 0x7772cf7c], [0xb0e3a15f, 0xbdc35aee], + [0x6e252b03, 0x32b2107d], [0x20dcc2a3, 0x21987229], + [0x848e3ad8, 0xe692a0c6], [0xdd07fa50, 0x0b64e1ae], + [0xc4072bc2, 0x2f120bba], [0xdb3af26e, 0xacab0c48], + [0xd7d4b59a, 0xcf72a7a7], [0x4628de45, 0x4dfb2750], + [0x7519211f, 0x4798b536], [0x19984af3, 0xffd2aa19], + [0x1372d9c0, 0x7512153a], [0x295d19da, 0x497416e5], + [0x70932c73, 0x8a9bf591], [0xa0960860, 0xfaa7dc61], + [0xd425f548, 0x43aeda4d], [0xaa2573c7, 0x01a2553d], + [0x988e71d7, 0xd3c004a4], [0x3da87545, 0x2197af10], + [0x2f89e592, 0xa686e2fc], [0x7b88018a, 0xae66d575], + [0x93215591, 0xed69e6ea], [0x4fcacc4a, 0x4d2aba97], + [0xbedb923b, 0x500b2f1a], [0x0b6d8aa0, 0x232511b0], + [0x282fb3ee, 0x23695de0], [0x0c455dfe, 0x820cca3f], + [0xe893868c, 0x87f698f6], [0xb6428730, 0x56e576ce], + [0xf3843ee7, 0xba79bc28], [0xa1c9ca45, 0x30c479c1], + [0xbfc244c2, 0xa9af65f0], [0x6eeb88eb, 0x62b4479c], + [0xcc328fe5, 0x60f5c9bf], [0x31aa2c21, 0xc55575fb], + [0x9429492d, 0x8e80612a], [0xb12fe59e, 0xf0e1e97b], + [0xc2501dad, 0x4a9f4bbf], [0x65ae8366, 0x3e8b0983], + [0xd5fc062a, 0xba74f808], [0x7398cc0a, 0x39a6a269], + [0x5581dd60, 0xff79d28c], [0xea5e52b3, 0x9be66c71], + [0x8f6e02a4, 0xe27318b5], [0xe8bceb99, 0xa48a7f2c], +); +1; diff --git a/perl/t/version/dump.t b/perl/t/version/dump.t index f6f5e6da..e40bfccb 100644 --- a/perl/t/version/dump.t +++ b/perl/t/version/dump.t @@ -2,7 +2,7 @@ use strict; use warnings; -use lib qw't ..'; +use lib qw't perl/t ..'; use version::input; our %test = load( diff --git a/perl/t/version/h.t b/perl/t/version/h.t index 49d3c3b7..ed06416a 100644 --- a/perl/t/version/h.t +++ b/perl/t/version/h.t @@ -2,7 +2,7 @@ # .[.][pl]] use strict; use warnings; -use lib qw't'; +use lib qw't perl/t ..'; use version::input; our %test = version::input::load( diff --git a/perl/t/version/input.pm b/perl/t/version/input.pm index 6eeb6e32..32d6d0b3 100644 --- a/perl/t/version/input.pm +++ b/perl/t/version/input.pm @@ -209,7 +209,7 @@ __DATA__ rc: 0 2.06-2009: major: 2 - mangled: 2.06.00.00.2009 + mangled: 2.06.00.0.2009 minor: 6 xid: 0x02060000 id: 33947648 @@ -238,7 +238,7 @@ __DATA__ rc: 0 2.06.09pl5rc8: major: 2 - mangled: 2.06.09.05rc8 + mangled: 2.06.09.5rc8 minor: 6 xid: 0x02060905 id: 33949957 diff --git a/perl/t/version/mac.t b/perl/t/version/mac.t index 3459813b..30039656 100644 --- a/perl/t/version/mac.t +++ b/perl/t/version/mac.t @@ -1,7 +1,7 @@ #!/usr/bin/env perl use strict; use warnings; -use lib qw't ..'; +use lib qw't perl/t ..'; use version::input; our %test = version::input::load( diff --git a/perl/t/version/make.t b/perl/t/version/make.t index 1a984f82..d1fb1cb6 100644 --- a/perl/t/version/make.t +++ b/perl/t/version/make.t @@ -2,7 +2,7 @@ # .[.][pl]] use strict; use warnings; -use lib qw't ..'; +use lib qw't perl/t ..'; use version::input; our %test = version::input::load( diff --git a/perl/t/version/nsis.t b/perl/t/version/nsis.t index 12cac3ba..761c8a7b 100644 --- a/perl/t/version/nsis.t +++ b/perl/t/version/nsis.t @@ -2,7 +2,7 @@ # .[.][pl]] use strict; use warnings; -use lib qw't ..'; +use lib qw't perl/t ..'; use version::input; our %test = version::input::load( diff --git a/perl/t/version/sed.t b/perl/t/version/sed.t index 14d6089b..7615866e 100644 --- a/perl/t/version/sed.t +++ b/perl/t/version/sed.t @@ -2,7 +2,7 @@ # .[.][pl]] use strict; use warnings; -use lib qw't ..'; +use lib qw't perl/t ..'; use version::input; our %test = version::input::load( diff --git a/perl/version.pl b/perl/version.pl index 8d8f4360..e9d630c4 100755 --- a/perl/version.pl +++ b/perl/version.pl @@ -136,7 +136,7 @@ sub Load{ $version{patchlevel} or $version{snapshot} ){ - $mangled .= sprintf(".%02d",$version{patchlevel}) + $mangled .= sprintf(".%01d",$version{patchlevel}) } } diff --git a/version.pl b/version.pl index d9e97330..bb4da93a 100755 --- a/version.pl +++ b/version.pl @@ -52,7 +52,7 @@ if ( $line =~ /^([0-9]+)\.([0-9]+)(.*)$/ ) { $plvl = $2; $tail = $3; } elsif ( $tail =~ /^rc([0-9]+)(.*)$/ ) { - $is_rc = 1; + $is_rc = $1 || ' '; $plvl = $1; $tail = $2; } @@ -137,7 +137,7 @@ if ( $what eq 'h' ) { printf "NASM_PATCHLEVEL_VER=%d\n", $nplvl; } elsif ( $what eq 'nsis' ) { printf "!define VERSION \"%s\"\n", $line; - printf "!define MAJOR_VER %d\n", $nmin; + printf "!define MAJOR_VER %d\n", $nmaj; printf "!define MINOR_VER %d\n", $nmin; printf "!define SUBMINOR_VER %d\n", $nsmin; printf "!define PATCHLEVEL_VER %d\n", $nplvl; @@ -145,7 +145,28 @@ if ( $what eq 'h' ) { print $nasm_id, "\n"; # Print ID in decimal } elsif ( $what eq 'xid' ) { printf "0x%08x\n", $nasm_id; # Print ID in hexadecimal -} else { +} elsif ( $what eq 'dump' ){ + require Data::Dumper; + no warnings 'once'; + $Data::Dumper::Terse = 1; + my $xid = sprintf('0x%08x',$nasm_id); + print "{ + 'major' => '$nmaj', + 'minor' => '$nmin', + 'subminor' => '$nsmin', + 'id' => '$nasm_id', + 'xid' => '$xid', + 'patchlevel' => '$nplvl', + 'mangled' => '$mangled_ver', + 'rc' => '$is_rc', +"; + print "\t'snapshot' => '$snapshot',\n" if $snapshot; + $tail =~ s/^-\d+$//; + print "\t'tail' => '$tail',\n" if $tail; + print " +}"; + print "\n"; +}else { die "$0: Unknown output: $what\n"; } -- 2.11.4.GIT