diff options
Diffstat (limited to 'contrib/idn/idnkit-1.0-src/util/SparseMap.pm')
| -rw-r--r-- | contrib/idn/idnkit-1.0-src/util/SparseMap.pm | 575 |
1 files changed, 575 insertions, 0 deletions
diff --git a/contrib/idn/idnkit-1.0-src/util/SparseMap.pm b/contrib/idn/idnkit-1.0-src/util/SparseMap.pm new file mode 100644 index 0000000..834c795 --- /dev/null +++ b/contrib/idn/idnkit-1.0-src/util/SparseMap.pm @@ -0,0 +1,575 @@ +# $Id: SparseMap.pm,v 1.1.1.1 2003/06/04 00:27:53 marka Exp $ +# +# Copyright (c) 2001 Japan Network Information Center. All rights reserved. +# +# By using this file, you agree to the terms and conditions set forth bellow. +# +# LICENSE TERMS AND CONDITIONS +# +# The following License Terms and Conditions apply, unless a different +# license is obtained from Japan Network Information Center ("JPNIC"), +# a Japanese association, Kokusai-Kougyou-Kanda Bldg 6F, 2-3-4 Uchi-Kanda, +# Chiyoda-ku, Tokyo 101-0047, Japan. +# +# 1. Use, Modification and Redistribution (including distribution of any +# modified or derived work) in source and/or binary forms is permitted +# under this License Terms and Conditions. +# +# 2. Redistribution of source code must retain the copyright notices as they +# appear in each source code file, this License Terms and Conditions. +# +# 3. Redistribution in binary form must reproduce the Copyright Notice, +# this License Terms and Conditions, in the documentation and/or other +# materials provided with the distribution. For the purposes of binary +# distribution the "Copyright Notice" refers to the following language: +# "Copyright (c) 2000-2002 Japan Network Information Center. All rights reserved." +# +# 4. The name of JPNIC may not be used to endorse or promote products +# derived from this Software without specific prior written approval of +# JPNIC. +# +# 5. Disclaimer/Limitation of Liability: THIS SOFTWARE IS PROVIDED BY JPNIC +# "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +# LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A +# PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL JPNIC BE LIABLE +# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +# CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +# SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR +# BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, +# WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR +# OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF +# ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. +# + +package SparseMap; + +use strict; +use Carp; + +my $debug = 0; + +sub new { + # common options are: + # BITS => [8, 7, 6], # 3-level map, 2nd level bits=7, 3rd = 6. + # MAX => 0x110000 # actually, max + 1. + my $class = shift; + my $self = {@_}; + + croak "BITS unspecified" unless exists $self->{BITS}; + croak "BITS is not an array reference" + unless ref($self->{BITS}) eq 'ARRAY'; + croak "MAX unspecified" unless exists $self->{MAX}; + + $self->{MAXLV} = @{$self->{BITS}} - 1; + $self->{FIXED} = 0; + + my $lv0size = (indices($self, $self->{MAX} - 1))[0] + 1; + + my @map = (undef) x $lv0size; + $self->{MAP} = \@map; + + bless $self, $class; +} + +sub add1 { + my ($self, $n, $val) = @_; + + croak "Already fixed" if $self->{FIXED}; + carp("data ($n) out of range"), return if $n >= $self->{MAX}; + + my @index = $self->indices($n); + my $r = $self->{MAP}; + my $maxlv = $self->{MAXLV}; + my $idx; + my $lv; + + for ($lv = 0; $lv < $maxlv - 1; $lv++) { + $idx = $index[$lv]; + $r->[$idx] = $self->create_imap($lv + 1, undef) + unless defined $r->[$idx]; + $r = $r->[$idx]; + } + $idx = $index[$lv]; + $r->[$idx] = $self->create_dmap() unless defined $r->[$idx]; + $self->add_to_dmap($r->[$idx], $index[$maxlv], $val); +} + +sub fix { + my $self = shift; + my $map = $self->{MAP}; + my $maxlv = $self->{MAXLV}; + my @tmp; + my @zero; + + carp "Already fixed" if $self->{FIXED}; + $self->collapse_tree(); + $self->fill_default(); + $self->{FIXED} = 1; +} + +sub indices { + my $self = shift; + my $v = shift; + my @bits = @{$self->{BITS}}; + my @idx; + + print "indices($v,", join(',', @bits), ") = " if $debug; + for (my $i = @bits - 1; $i >= 0; $i--) { + my $bit = $bits[$i]; + unshift @idx, $v & ((1 << $bit) - 1); + $v = $v >> $bit; + } + print "(", join(',', @idx), ")\n" if $debug; + @idx; +} + +sub get { + my $self = shift; + my $v = shift; + my $map = $self->{MAP}; + my @index = $self->indices($v); + + croak "Not yet fixed" unless $self->{FIXED}; + + my $lastidx = pop @index; + foreach my $idx (@index) { + return $map->{DEFAULT} unless defined $map->[$idx]; + $map = $map->[$idx]; + } + $map->[$lastidx]; +} + +sub indirectmap { + my $self = shift; + + croak "Not yet fixed" unless $self->{FIXED}; + + my @maps = $self->collect_maps(); + my $maxlv = $self->{MAXLV}; + my @bits = @{$self->{BITS}}; + + my @indirect = (); + for (my $lv = 0; $lv < $maxlv; $lv++) { + my $offset; + my $chunksz; + my $mapsz = @{$maps[$lv]->[0]}; + if ($lv < $maxlv - 1) { + # indirect map + $offset = @indirect + @{$maps[$lv]} * @{$maps[$lv]->[0]}; + $chunksz = (1 << $bits[$lv + 1]); + } else { + # direct map + $offset = 0; + $chunksz = 1; + } + my $nextmaps = $maps[$lv + 1]; + foreach my $mapref (@{$maps[$lv]}) { + croak "mapsize inconsistent ", scalar(@$mapref), + " should be ", $mapsz, " (lv $lv)\n" if @$mapref != $mapsz; + foreach my $m (@$mapref) { + my $idx; + for ($idx = 0; $idx < @$nextmaps; $idx++) { + last if $nextmaps->[$idx] == $m; + } + croak "internal error: map corrupted" if $idx >= @$nextmaps; + push @indirect, $offset + $chunksz * $idx; + } + } + } + @indirect; +} + +sub cprog_imap { + my $self = shift; + my %opt = @_; + my $name = $opt{NAME} || 'map'; + my @indirect = $self->indirectmap(); + my $prog; + my $i; + my ($idtype, $idcol, $idwid); + + my $max = 0; + $max < $_ and $max = $_ foreach @indirect; + + if ($max < 256) { + $idtype = 'char'; + $idcol = 8; + $idwid = 3; + } elsif ($max < 65536) { + $idtype = 'short'; + $idcol = 8; + $idwid = 5; + } else { + $idtype = 'long'; + $idcol = 4; + $idwid = 10; + } + $prog = "static const unsigned $idtype ${name}_imap[] = {\n"; + $i = 0; + foreach my $v (@indirect) { + if ($i % $idcol == 0) { + $prog .= "\n" if $i != 0; + $prog .= "\t"; + } + $prog .= sprintf "%${idwid}d, ", $v; + $i++; + } + $prog .= "\n};\n"; + $prog; +} + +sub cprog { + my $self = shift; + $self->cprog_imap(@_) . "\n" . $self->cprog_dmap(@_); +} + +sub stat { + my $self = shift; + my @maps = $self->collect_maps(); + my $elsize = $self->{ELSIZE}; + my $i; + my $total = 0; + my @lines; + + for ($i = 0; $i < $self->{MAXLV}; $i++) { + my $nmaps = @{$maps[$i]}; + my $mapsz = @{$maps[$i]->[0]}; + push @lines, "level $i: $nmaps maps (size $mapsz) "; + push @lines, "[", $nmaps * $mapsz * $elsize, "]" if $elsize; + push @lines, "\n"; + } + my $ndmaps = @{$maps[$i]}; + push @lines, "level $i: $ndmaps dmaps"; + my $r = $maps[$i]->[0]; + if (ref($r) eq 'ARRAY') { + push @lines, " (size ", scalar(@$r), ")"; + } + push @lines, "\n"; + join '', @lines; +} + +sub collapse_tree { + my $self = shift; + my @tmp; + + $self->_collapse_tree_rec($self->{MAP}, 0, \@tmp); +} + +sub _collapse_tree_rec { + my ($self, $r, $lv, $refs) = @_; + my $ref = $refs->[$lv]; + my $maxlv = $self->{MAXLV}; + my $found; + + return $r unless defined $r; + + $ref = $refs->[$lv] = [] unless defined $ref; + + if ($lv == $maxlv) { + $found = $self->find_dmap($ref, $r); + } else { + for (my $i = 0; $i < @$r; $i++) { + $r->[$i] = $self->_collapse_tree_rec($r->[$i], $lv + 1, $refs); + } + $found = $self->find_imap($ref, $r); + } + unless ($found) { + $found = $r; + push @$ref, $found; + } + return $found; +} + +sub fill_default { + my $self = shift; + my $maxlv = $self->{MAXLV}; + my $bits = $self->{BITS}; + my @zeros; + + $zeros[$maxlv] = $self->create_dmap(); + for (my $lv = $maxlv - 1; $lv >= 0; $lv--) { + my $r = $zeros[$lv + 1]; + $zeros[$lv] = $self->create_imap($lv, $r); + } + _fill_default_rec($self->{MAP}, 0, $maxlv, \@zeros); +} + +sub _fill_default_rec { + my ($r, $lv, $maxlv, $zeros) = @_; + + return if $lv == $maxlv; + for (my $i = 0; $i < @$r; $i++) { + if (defined($r->[$i])) { + _fill_default_rec($r->[$i], $lv + 1, $maxlv, $zeros); + } else { + $r->[$i] = $zeros->[$lv + 1]; + } + } +} + +sub create_imap { + my ($self, $lv, $v) = @_; + my @map; + @map = ($v) x (1 << $self->{BITS}->[$lv]); + \@map; +} + +sub find_imap { + my ($self, $maps, $map) = @_; + my $i; + + foreach my $el (@$maps) { + next unless @$el == @$map; + for ($i = 0; $i < @$el; $i++) { + last unless ($el->[$i] || 0) == ($map->[$i] || 0); + } + return $el if $i >= @$el; + } + undef; +} + +sub collect_maps { + my $self = shift; + my @maps; + _collect_maps_rec($self->{MAP}, 0, $self->{MAXLV}, \@maps); + @maps; +} + +sub _collect_maps_rec { + my ($r, $lv, $maxlv, $maps) = @_; + my $mapref = $maps->[$lv]; + + return unless defined $r; + foreach my $ref (@{$mapref}) { + return if $ref == $r; + } + push @{$maps->[$lv]}, $r; + if ($lv < $maxlv) { + _collect_maps_rec($_, $lv + 1, $maxlv, $maps) foreach @{$r}; + } +} + +sub add {confess "Subclass responsibility";} +sub create_dmap {confess "Subclass responsibility";} +sub add_to_dmap {confess "Subclass responsibility";} +sub find_dmap {confess "Subclass responsibility";} +sub cprog_dmap {confess "Subclass responsibility";} + +1; + +package SparseMap::Bit; + +use strict; +use vars qw(@ISA); +use Carp; +#use SparseMap; + +@ISA = qw(SparseMap); + +sub new { + my $class = shift; + my $self = $class->SUPER::new(@_); + $self->{DEFAULT} = 0; + bless $self, $class; +} + +sub add { + my $self = shift; + + $self->add1($_, undef) foreach @_; +} + +sub create_dmap { + my $self = shift; + my $bmbits = $self->{BITS}->[-1]; + + my $s = "\0" x (1 << ($bmbits - 3)); + \$s; +} + +sub add_to_dmap { + my ($self, $map, $idx, $val) = @_; + vec($$map, $idx, 1) = 1; +} + +sub find_dmap { + my ($self, $ref, $r) = @_; + foreach my $map (@$ref) { + return $map if $$map eq $$r; + } + return undef; +} + +sub cprog_dmap { + my $self = shift; + my %opt = @_; + my $name = $opt{NAME} || 'map'; + my @maps = $self->collect_maps(); + my @bitmap = @{$maps[-1]}; + my $prog; + my $bmsize = 1 << ($self->{BITS}->[-1] - 3); + + $prog = <<"END"; +static const struct { + unsigned char bm[$bmsize]; +} ${name}_bitmap[] = { +END + + foreach my $bm (@bitmap) { + my $i = 0; + $prog .= "\t{{\n"; + foreach my $v (unpack 'C*', $$bm) { + if ($i % 16 == 0) { + $prog .= "\n" if $i != 0; + $prog .= "\t"; + } + $prog .= sprintf "%3d,", $v; + $i++; + } + $prog .= "\n\t}},\n"; + } + $prog .= "};\n"; + $prog; +} + +1; + +package SparseMap::Int; + +use strict; +use vars qw(@ISA); +use Carp; +#use SparseMap; + +@ISA = qw(SparseMap); + +sub new { + my $class = shift; + my $self = $class->SUPER::new(@_); + $self->{DEFAULT} = 0 unless exists $self->{DEFAULT}; + bless $self, $class; +} + +sub add { + my $self = shift; + while (@_ > 0) { + my $n = shift; + my $val = shift; + $self->add1($n, $val); + } +} + +sub create_dmap { + my $self = shift; + my $tblbits = $self->{BITS}->[-1]; + my $default = $self->{DEFAULT}; + + my @tbl = ($default) x (1 << $tblbits); + \@tbl; +} + +sub add_to_dmap { + my ($self, $map, $idx, $val) = @_; + $map->[$idx] = $val; +} + +sub find_dmap { + my ($self, $ref, $r) = @_; + foreach my $map (@$ref) { + if (@$map == @$r) { + my $i; + for ($i = 0; $i < @$map; $i++) { + last if $map->[$i] != $r->[$i]; + } + return $map if $i == @$map; + } + } + return undef; +} + +sub cprog_dmap { + my $self = shift; + my %opt = @_; + my $name = $opt{NAME} || 'map'; + my @maps = $self->collect_maps(); + my @table = @{$maps[-1]}; + my $prog; + my $i; + my ($idtype, $idcol, $idwid); + my $tblsize = 1 << $self->{BITS}->[-1]; + + my ($min, $max); + foreach my $a (@table) { + foreach my $v (@$a) { + $min = $v if !defined($min) or $min > $v; + $max = $v if !defined($max) or $max < $v; + } + } + if (exists $opt{MAPTYPE}) { + $idtype = $opt{MAPTYPE}; + } else { + my $u = $min < 0 ? '' : 'unsigned '; + my $absmax = abs($max); + $absmax = abs($min) if abs($min) > $absmax; + + if ($absmax < 256) { + $idtype = "${u}char"; + } elsif ($absmax < 65536) { + $idtype = "${u}short"; + } else { + $idtype = "${u}long"; + } + } + + $idwid = decimalwidth($max); + $idwid = decimalwidth($min) if decimalwidth($min) > $idwid; + + $prog = <<"END"; +static const struct { + $idtype tbl[$tblsize]; +} ${name}_table[] = { +END + + foreach my $a (@table) { + my $i = 0; + my $col = 0; + $prog .= "\t{{\n\t"; + foreach my $v (@$a) { + my $s = sprintf "%${idwid}d, ", $v; + $col += length($s); + if ($col > 70) { + $prog .= "\n\t"; + $col = length($s); + } + $prog .= $s; + } + $prog .= "\n\t}},\n"; + } + $prog .= "};\n"; + $prog; +} + +sub decimalwidth { + my $n = shift; + my $neg = 0; + my $w; + + if ($n < 0) { + $neg = 1; + $n = -$n; + } + if ($n < 100) { + $w = 2; + } elsif ($n < 10000) { + $w = 4; + } elsif ($n < 1000000) { + $w = 6; + } elsif ($n < 100000000) { + $w = 8; + } else { + $w = 10; + } + $w + $neg; +} + +1; |