lib/Scalar/Vec/Util.pm

   1 package Scalar::Vec::Util;
   2
   3 use strict;
   4 use warnings;
   5
   6 use Carp qw/croak/;
   7
   8 =head1 NAME
   9
  10 Scalar::Vec::Util - Utility routines for vec strings.
  11
  12 =head1 VERSION
  13
  14 Version 0.05
  15
  16 =cut
  17
  18 our $VERSION;
  19 BEGIN {
  20  $VERSION = '0.05';
  21  eval {
  22   require XSLoader;
  23   XSLoader::load(__PACKAGE__, $VERSION);
  24   1;
  25  } or do {
  26   *SVU_PP   = sub () { 1 };
  27   *SVU_SIZE = sub () { 1 };
  28   *vfill    = *vfill_pp;
  29   *vcopy    = *vcopy_pp;
  30   *veq      = *veq_pp;
  31  }
  32 }
  33
  34 =head1 SYNOPSIS
  35
  36     use Scalar::Vec::Util qw/vfill vcopy veq/;
  37
  38     my $s;
  39     vfill $s, 0, 100, 1; # Fill with 100 bits 1 starting at 0.
  40     my $t;
  41     vcopy $s, 20, $t, 10, 30; # Copy 30 bits from $s, starting at 20,
  42                               #                to $t, starting at 10.
  43     vcopy $t, 10, $t, 20, 30; # Overalapping areas DWIM.
  44     if (veq $t, 10, $t, 20, 30) { ... } # Yes, they are equal now.
  45
  46 =head1 DESCRIPTION
  47
  48 A set of utilities to manipulate bits in vec strings.
  49 Highly optimized XS routines are used when available, but straightforward pure perl replacements are also provided for platforms without a C compiler.
  50
  51 This module doesn't reimplement bit vectors.
  52 It can be used on the very same scalars that C<vec> builds, or actually on any Perl string (C<SVt_PV>).
  53
  54 =head1 CONSTANTS
  55
  56 =head2 C<SVU_PP>
  57
  58 True when pure perl fallbacks are used instead of XS functions.
  59
  60 =head2 C<SVU_SIZE>
  61
  62 Size in bits of the unit used for moves.
  63 The higher this value is, the faster the XS functions are.
  64 It's usually C<CHAR_BIT * $Config{alignbytes}>, except on non-little-endian architectures where it currently falls back to C<CHAR_BIT> (e.g. SPARC).
  65
  66 =head1 FUNCTIONS
  67
  68 =head2 C<vfill $vec, $start, $length, $bit>
  69
  70 Starting at C<$start> in C<$vec>, fills C<$length> bits with C<$bit>.
  71 Grows C<$vec> if necessary.
  72
  73 =cut
  74
  75 sub _alldef {
  76  for (@_) { return 0 unless defined }
  77  return 1;
  78 }
  79
  80 sub vfill_pp ($$$$) {
  81  (undef, my $s, my $l, my $x) = @_;
  82  croak "Invalid argument" unless _alldef @_;
  83  return unless $l;
  84  $x = ~0 if $x;
  85  my $SIZE = 32;
  86  my $t = int($s / $SIZE) + 1;
  87  my $u = int(($s + $l) / $SIZE);
  88  if ($SIZE * $t < $s + $l and $t <= $u) {
  89   vec($_[0], $_, 1)     = $x for $s .. $SIZE * $t - 1;
  90   vec($_[0], $_, $SIZE) = $x for $t .. $u - 1;
  91   vec($_[0], $_, 1)     = $x for $SIZE * $u .. $s + $l - 1;
  92  } else {
  93   vec($_[0], $_, 1) = $x for $s .. $s + $l - 1;
  94  }
  95 }
  96
  97 =head2 C<< vcopy $from => $from_start, $to => $to_start, $length >>
  98
  99 Copies C<$length> bits starting at C<$from_start> in C<$from> to C<$to_start> in C<$to>.
 100 If C<$from_start + $length> is too long for C<$from>, zeros are copied past C<$length>.
 101 Grows C<$to> if necessary.
 102 Doesn't need to allocate any extra memory.
 103
 104 =cut
 105
 106 sub vcopy_pp ($$$$$) {
 107  my ($fs, $ts, $l) = @_[1, 3, 4];
 108  croak "Invalid argument" unless _alldef @_;
 109  return unless $l;
 110  my $step = $ts - $fs;
 111  if ($step <= 0) {
 112   vec($_[2], $_ + $step, 1) = vec($_[0], $_, 1) for $fs .. $fs + $l - 1;
 113  } else { # There's a risk of overwriting if $_[0] and $_[2] are the same SV.
 114   vec($_[2], $_ + $step, 1) = vec($_[0], $_, 1) for reverse $fs .. $fs + $l - 1;
 115  }
 116 }
 117
 118 =head2 C<< vshift $v, $start, $length => $bits [, $insert ] >>
 119
 120 In the area starting at C<$start> and of length C<$length> in C<$v>, shift bits C<abs $bits> positions left if C<< $bits > 0 >> and right otherwise.
 121 If C<$insert> is defined, also fills the resulting gap with ones if C<$insert> is true and zeros if it's false.
 122 Bits outside of the specified area are left untouched.
 123 Doesn't need to allocate any extra memory.
 124
 125 =cut
 126
 127 sub vshift ($$$$;$) {
 128  my ($start, $length, $bits, $insert) = @_[1 .. 4];
 129  return unless $bits;
 130  my $left = 1;
 131  if ($bits < 0) {
 132   $left = 0;
 133   $bits = -$bits;
 134  }
 135  if ($bits < $length) {
 136   $length -= $bits;
 137   if ($left) {
 138    vcopy($_[0], $start, $_[0], $start + $bits, $length);
 139    vfill($_[0], $start, $bits, $insert) if defined $insert;
 140   } else {
 141    vcopy($_[0], $start + $bits, $_[0], $start, $length);
 142    vfill($_[0], $start + $length, $bits, $insert) if defined $insert;
 143   }
 144  } else {
 145   vfill($_[0], $start, $length, $insert) if defined $insert;
 146  }
 147 }
 148
 149 =head2 C<< vrot $v, $start, $length, $bits >>
 150
 151 In the area starting at C<$start> and of length C<$length> in C<$v>, rotates bits C<abs $bits> positions left if C<< $bits > 0 >> and right otherwise.
 152 Bits outside of the specified area are left untouched.
 153 Currently allocates an extra buffer of size C<O($bits)>.
 154
 155 =cut
 156
 157 sub vrot ($$$$) {
 158  my ($start, $length, $bits) = @_[1 .. 3];
 159  return unless $length and $bits;
 160  my $left = 1;
 161  if ($bits < 0) {
 162   $left = 0;
 163   $bits = -$bits;
 164  }
 165  $bits %= $length;
 166  return unless $bits;
 167  $length -= $bits;
 168  my $buf = '';
 169  if ($left) {
 170   vcopy($_[0], $start + $length, $buf,  0,              $bits);
 171   vcopy($_[0], $start,           $_[0], $start + $bits, $length);
 172   vcopy($buf,  0,                $_[0], $start,         $bits);
 173  } else {
 174   vcopy($_[0], $start,           $buf,  0,                $bits);
 175   vcopy($_[0], $start + $bits,   $_[0], $start,           $length);
 176   vcopy($buf,  0,                $_[0], $start + $length, $bits);
 177  }
 178 }
 179
 180 =head2 C<< veq $v1 => $v1_start, $v2 => $v2_start, $length >>
 181
 182 Returns true if the C<$length> bits starting at C<$v1_start> in C<$v1> and C<$v2_start> in C<$v2> are equal, and false otherwise.
 183 If needed, C<$length> is decreased to fit inside C<$v1> and C<$v2> boundaries.
 184
 185 =cut
 186
 187 sub veq_pp ($$$$$) {
 188  my ($s1, $s2, $l) = @_[1, 3, 4];
 189  croak "Invalid argument" unless _alldef @_;
 190  my $i = 0;
 191  while ($i < $l) {
 192   return 0 if vec($_[0], $s1 + $i, 1) != vec($_[2], $s2 + $i, 1);
 193   ++$i;
 194  }
 195  return 1;
 196 }
 197
 198 =head1 EXPORT
 199
 200 The functions L</vfill>, L</vcopy>, L</vshift>, L</vrot> and L</veq> are only exported on request.
 201 All of them are exported by the tags C<':funcs'> and C<':all'>.
 202
 203 The constants L</SVU_PP> and L</SVU_SIZE> are also only exported on request.
 204 They are all exported by the tags C<':consts'> and C<':all'>.
 205
 206 =cut
 207
 208 use base qw/Exporter/;
 209
 210 our @EXPORT         = ();
 211 our %EXPORT_TAGS    = (
 212  'funcs'  => [ qw/vfill vcopy vshift vrot veq/ ],
 213  'consts' => [ qw/SVU_PP SVU_SIZE/ ]
 214 );
 215 our @EXPORT_OK      = map { @$_ } values %EXPORT_TAGS;
 216 $EXPORT_TAGS{'all'} = [ @EXPORT_OK ];
 217
 218 =head1 BENCHMARKS
 219
 220 The following timings were obtained by running the C<samples/bench.pl> script.
 221 The C<_pp> entries are the pure Perl versions, whereas C<_bv> are L<Bit::Vector> versions.
 222
 223 =over 4
 224
 225 =item This is for perl 5.8.8 on a Core 2 Duo 2.66GHz machine (unit is 64 bits).
 226
 227     Filling bits at a given position :
 228                   Rate vfill_pp vfill_bv    vfill
 229     vfill_pp    80.3/s       --    -100%    -100%
 230     vfill_bv 1053399/s 1312401%       --     -11%
 231     vfill    1180792/s 1471129%      12%       --
 232
 233     Copying bits from a bit vector to a different one :
 234                  Rate vcopy_pp vcopy_bv    vcopy
 235     vcopy_pp    112/s       --    -100%    -100%
 236     vcopy_bv  62599/s   55622%       --     -89%
 237     vcopy    558491/s  497036%     792%       --
 238
 239     Moving bits in the same bit vector from a given position to a different one :
 240                  Rate vmove_pp vmove_bv    vmove
 241     vmove_pp   64.8/s       --    -100%    -100%
 242     vmove_bv  64742/s   99751%       --     -88%
 243     vmove    547980/s  845043%     746%       --
 244
 245     Testing bit equality from different positions of different bit vectors :
 246                Rate  veq_pp  veq_bv     veq
 247     veq_pp   92.7/s      --   -100%   -100%
 248     veq_bv  32777/s  35241%      --    -94%
 249     veq    505828/s 545300%   1443%      --
 250
 251 =item This is for perl 5.10.0 on a Pentium 4 3.0GHz (unit is 32 bits).
 252
 253                  Rate vfill_pp vfill_bv    vfill
 254     vfill_pp    185/s       --    -100%    -100%
 255     vfill_bv 407979/s  220068%       --     -16%
 256     vfill    486022/s  262184%      19%       --
 257
 258                  Rate vcopy_pp vcopy_bv    vcopy
 259     vcopy_pp   61.5/s       --    -100%    -100%
 260     vcopy_bv  32548/s   52853%       --     -83%
 261     vcopy    187360/s  304724%     476%       --
 262
 263                  Rate vmove_pp vmove_bv    vmove
 264     vmove_pp   63.1/s       --    -100%    -100%
 265     vmove_bv  32829/s   51933%       --     -83%
 266     vmove    188572/s  298787%     474%       --
 267
 268                Rate  veq_pp  veq_bv     veq
 269     veq_pp   34.2/s      --   -100%   -100%
 270     veq_bv  17518/s  51190%      --    -91%
 271     veq    192181/s 562591%    997%      --
 272
 273 =item This is for perl 5.10.0 on an UltraSPARC-IIi (unit is 8 bits).
 274
 275                 Rate vfill_pp    vfill vfill_bv
 276     vfill_pp  4.23/s       --    -100%    -100%
 277     vfill    30039/s  709283%       --     -17%
 278     vfill_bv 36022/s  850568%      20%       --
 279
 280                 Rate vcopy_pp vcopy_bv    vcopy
 281     vcopy_pp  2.74/s       --    -100%    -100%
 282     vcopy_bv  8146/s  297694%       --     -60%
 283     vcopy    20266/s  740740%     149%       --
 284
 285                 Rate vmove_pp vmove_bv    vmove
 286     vmove_pp  2.66/s       --    -100%    -100%
 287     vmove_bv  8274/s  311196%       --     -59%
 288     vmove    20287/s  763190%     145%       --
 289
 290               Rate  veq_pp  veq_bv     veq
 291     veq_pp  7.33/s      --   -100%   -100%
 292     veq_bv  2499/s  33978%      --    -87%
 293     veq    19675/s 268193%    687%      --
 294
 295 =back
 296
 297 =head1 CAVEATS
 298
 299 Please report architectures where we can't use the alignment as the move unit.
 300 I'll add exceptions for them.
 301
 302 =head1 DEPENDENCIES
 303
 304 L<Carp>, L<Exporter> (core modules since perl 5), L<XSLoader> (since perl 5.006).
 305
 306 =head1 SEE ALSO
 307
 308 L<Bit::Vector> gives a complete reimplementation of bit vectors.
 309
 310 =head1 AUTHOR
 311
 312 Vincent Pit, C<< <perl at profvince.com> >>, L<http://www.profvince.com>.
 313
 314 You can contact me by mail or on C<irc.perl.org> (vincent).
 315
 316 =head1 BUGS
 317
 318 Please report any bugs or feature requests to C<bug-scalar-vec-util at rt.cpan.org>, or through the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Scalar-Vec-Util>.
 319 I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.
 320
 321 =head1 SUPPORT
 322
 323 You can find documentation for this module with the perldoc command.
 324
 325     perldoc Scalar::Vec::Util
 326
 327 Tests code coverage report is available at L<http://www.profvince.com/perl/cover/Scalar-Vec-Util>.
 328
 329 =head1 COPYRIGHT & LICENSE
 330
 331 Copyright 2008 Vincent Pit, all rights reserved.
 332
 333 This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
 334
 335 =cut
 336
 337 1; # End of Scalar::Vec::Util