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.07
  15
  16 =cut
  17
  18 our $VERSION;
  19 BEGIN {
  20  $VERSION = '0.07';
  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; # Overlapping areas DWIM.
  44     if (veq $t, 10, $t, 20, 30) { ... } # Yes, they are equal now.
  45
  46 =head1 DESCRIPTION
  47
  48 This module provides a set of utility routines that efficiently manipulate bits in vec strings.
  49 Highly optimized XS functions are used whenever possible, but straightforward pure Perl replacements are also available for platforms without a C compiler.
  50
  51 Note that this module does not aim at reimplementing bit vectors : all its functions can be used on any Perl string, just like L<perlfunc/vec>.
  52
  53 =head1 CONSTANTS
  54
  55 =head2 C<SVU_PP>
  56
  57 True when pure Perl fallbacks are used instead of XS functions.
  58
  59 =head2 C<SVU_SIZE>
  60
  61 The size (in bits) of the unit used for bit operations.
  62 The higher this value is, the faster the XS functions are.
  63 It is usually C<CHAR_BIT * $Config{alignbytes}>, except on non-little-endian architectures where it currently falls back to C<CHAR_BIT> (e.g. SPARC).
  64
  65 =head1 FUNCTIONS
  66
  67 =head2 C<vfill>
  68
  69     vfill $vec, $start, $length, $bit;
  70
  71 Starting at C<$start> in C<$vec>, fills C<$length> bits with ones if C<$bit> is true and with zeros if C<$bit> is false.
  72
  73 C<$vec> is upgraded to a string and extended if necessary.
  74 Bits that are outside of the specified area are left untouched.
  75
  76 =cut
  77
  78 sub vfill_pp ($$$$) {
  79  my ($s, $l, $x) = @_[1 .. 3];
  80  return unless $l;
  81  croak 'Invalid negative offset' if $s < 0;
  82  croak 'Invalid negative length' if $l < 0;
  83  $x = ~0 if $x;
  84  my $SIZE = 32;
  85  my $t = int($s / $SIZE) + 1;
  86  my $u = int(($s + $l) / $SIZE);
  87  if ($SIZE * $t < $s + $l) { # implies $t <= $u
  88   vec($_[0], $_, 1)     = $x for $s .. $SIZE * $t - 1;
  89   vec($_[0], $_, $SIZE) = $x for $t .. $u - 1;
  90   vec($_[0], $_, 1)     = $x for $SIZE * $u .. $s + $l - 1;
  91  } else {
  92   vec($_[0], $_, 1) = $x for $s .. $s + $l - 1;
  93  }
  94 }
  95
  96 =head2 C<vcopy>
  97
  98     vcopy $from => $from_start, $to => $to_start, $length;
  99
 100 Copies C<$length> bits starting at C<$from_start> in C<$from> to C<$to_start> in C<$to>.
 101
 102 C<$from> and C<$to> are allowed to be the same scalar, and the given areas can rightfully overlap.
 103
 104 C<$from> is upgraded to a string if it isn't one already.
 105 If C<$from_start + $length> goes out of the bounds of C<$from>, then the extra bits are treated as zeros.
 106 C<$to> is upgraded to a string and extended if necessary.
 107 The content of C<$from> is not modified, except when it is equal to C<$to>.
 108 Bits that are outside of the specified area are left untouched.
 109
 110 This function does not need to allocate any extra memory.
 111
 112 =cut
 113
 114 sub vcopy_pp ($$$$$) {
 115  my ($fs, $ts, $l) = @_[1, 3, 4];
 116  return unless $l;
 117  croak 'Invalid negative offset' if $fs < 0 or $ts < 0;
 118  croak 'Invalid negative length' if $l  < 0;
 119  my $step = $ts - $fs;
 120  if ($step <= 0) {
 121   vec($_[2], $_ + $step, 1) = vec($_[0], $_, 1) for $fs .. $fs + $l - 1;
 122  } else { # There's a risk of overwriting if $_[0] and $_[2] are the same SV.
 123   vec($_[2], $_ + $step, 1) = vec($_[0], $_, 1) for reverse $fs .. $fs + $l - 1;
 124  }
 125 }
 126
 127 =head2 C<vshift>
 128
 129     vshift $v, $start, $length => $bits, $insert;
 130
 131 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.
 132
 133 When C<$insert> is defined, the resulting gap is also filled with ones if C<$insert> is true and with zeros if C<$insert> is false.
 134
 135 C<$v> is upgraded to a string if it isn't one already.
 136 If C<$start + $length> goes out of the bounds of C<$v>, then the extra bits are treated as zeros.
 137 Bits that are outside of the specified area are left untouched.
 138
 139 This function does not need to allocate any extra memory.
 140
 141 =cut
 142
 143 sub vshift ($$$$;$) {
 144  my ($start, $length, $bits, $insert) = @_[1 .. 4];
 145  return unless $length and $bits;
 146  croak 'Invalid negative offset' if $start  < 0;
 147  croak 'Invalid negative length' if $length < 0;
 148  my $left = 1;
 149  if ($bits < 0) {
 150   $left = 0;
 151   $bits = -$bits;
 152  }
 153  if ($bits < $length) {
 154   $length -= $bits;
 155   if ($left) {
 156    vcopy($_[0], $start, $_[0], $start + $bits, $length);
 157    vfill($_[0], $start, $bits, $insert) if defined $insert;
 158   } else {
 159    vcopy($_[0], $start + $bits, $_[0], $start, $length);
 160    vfill($_[0], $start + $length, $bits, $insert) if defined $insert;
 161   }
 162  } else {
 163   vfill($_[0], $start, $length, $insert) if defined $insert;
 164  }
 165 }
 166
 167 =head2 C<vrot>
 168
 169     vrot $v, $start, $length, $bits;
 170
 171 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.
 172
 173 C<$v> is upgraded to a string if it isn't one already.
 174 If C<$start + $length> goes out of the bounds of C<$v>, then the extra bits are treated as zeros.
 175 Bits that are outside of the specified area are left untouched.
 176
 177 This function currently allocates an extra buffer of size C<O($bits)>.
 178
 179 =cut
 180
 181 sub vrot ($$$$) {
 182  my ($start, $length, $bits) = @_[1 .. 3];
 183  return unless $length and $bits;
 184  croak 'Invalid negative offset' if $start  < 0;
 185  croak 'Invalid negative length' if $length < 0;
 186  my $left = 1;
 187  if ($bits < 0) {
 188   $left = 0;
 189   $bits = -$bits;
 190  }
 191  $bits %= $length;
 192  return unless $bits;
 193  $length -= $bits;
 194  my $buf = '';
 195  if ($left) {
 196   vcopy($_[0], $start + $length, $buf,  0,              $bits);
 197   vcopy($_[0], $start,           $_[0], $start + $bits, $length);
 198   vcopy($buf,  0,                $_[0], $start,         $bits);
 199  } else {
 200   vcopy($_[0], $start,           $buf,  0,                $bits);
 201   vcopy($_[0], $start + $bits,   $_[0], $start,           $length);
 202   vcopy($buf,  0,                $_[0], $start + $length, $bits);
 203  }
 204 }
 205
 206 =head2 C<veq>
 207
 208     veq $v1 => $v1_start, $v2 => $v2_start, $length;
 209
 210 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.
 211
 212 C<$v1> and C<$v2> are upgraded to strings if they aren't already, but their contents are never modified.
 213 If C<$v1_start + $length> (respectively C<$v2_start + $length>) goes out of the bounds of C<$v1> (respectively C<$v2>), then the extra bits are treated as zeros.
 214
 215 This function does not need to allocate any extra memory.
 216
 217 =cut
 218
 219 sub veq_pp ($$$$$) {
 220  my ($s1, $s2, $l) = @_[1, 3, 4];
 221  croak 'Invalid negative offset' if $s1 < 0 or $s2 < 0;
 222  croak 'Invalid negative length' if $l  < 0;
 223  my $i = 0;
 224  while ($i < $l) {
 225   return 0 if vec($_[0], $s1 + $i, 1) != vec($_[2], $s2 + $i, 1);
 226   ++$i;
 227  }
 228  return 1;
 229 }
 230
 231 =head1 EXPORT
 232
 233 The functions L</vfill>, L</vcopy>, L</vshift>, L</vrot> and L</veq> are only exported on request.
 234 All of them are exported by the tags C<':funcs'> and C<':all'>.
 235
 236 The constants L</SVU_PP> and L</SVU_SIZE> are also only exported on request.
 237 They are all exported by the tags C<':consts'> and C<':all'>.
 238
 239 =cut
 240
 241 use base qw<Exporter>;
 242
 243 our @EXPORT         = ();
 244 our %EXPORT_TAGS    = (
 245  'funcs'  => [ qw<vfill vcopy vshift vrot veq> ],
 246  'consts' => [ qw<SVU_PP SVU_SIZE> ]
 247 );
 248 our @EXPORT_OK      = map { @$_ } values %EXPORT_TAGS;
 249 $EXPORT_TAGS{'all'} = [ @EXPORT_OK ];
 250
 251 =head1 BENCHMARKS
 252
 253 The following timings were obtained by running the C<samples/bench.pl> script.
 254 The C<_pp> entries are the pure Perl versions, whereas C<_bv> are L<Bit::Vector> versions.
 255
 256 =over 4
 257
 258 =item This is for perl 5.8.8 on a Core 2 Duo 2.66GHz machine (unit is 64 bits).
 259
 260     Filling bits at a given position :
 261                   Rate vfill_pp vfill_bv    vfill
 262     vfill_pp    80.3/s       --    -100%    -100%
 263     vfill_bv 1053399/s 1312401%       --     -11%
 264     vfill    1180792/s 1471129%      12%       --
 265
 266     Copying bits from a bit vector to a different one :
 267                  Rate vcopy_pp vcopy_bv    vcopy
 268     vcopy_pp    112/s       --    -100%    -100%
 269     vcopy_bv  62599/s   55622%       --     -89%
 270     vcopy    558491/s  497036%     792%       --
 271
 272     Moving bits in the same bit vector from a given position to a different one :
 273                  Rate vmove_pp vmove_bv    vmove
 274     vmove_pp   64.8/s       --    -100%    -100%
 275     vmove_bv  64742/s   99751%       --     -88%
 276     vmove    547980/s  845043%     746%       --
 277
 278     Testing bit equality from different positions of different bit vectors :
 279                Rate  veq_pp  veq_bv     veq
 280     veq_pp   92.7/s      --   -100%   -100%
 281     veq_bv  32777/s  35241%      --    -94%
 282     veq    505828/s 545300%   1443%      --
 283
 284 =item This is for perl 5.10.0 on a Pentium 4 3.0GHz (unit is 32 bits).
 285
 286                  Rate vfill_pp vfill_bv    vfill
 287     vfill_pp    185/s       --    -100%    -100%
 288     vfill_bv 407979/s  220068%       --     -16%
 289     vfill    486022/s  262184%      19%       --
 290
 291                  Rate vcopy_pp vcopy_bv    vcopy
 292     vcopy_pp   61.5/s       --    -100%    -100%
 293     vcopy_bv  32548/s   52853%       --     -83%
 294     vcopy    187360/s  304724%     476%       --
 295
 296                  Rate vmove_pp vmove_bv    vmove
 297     vmove_pp   63.1/s       --    -100%    -100%
 298     vmove_bv  32829/s   51933%       --     -83%
 299     vmove    188572/s  298787%     474%       --
 300
 301                Rate  veq_pp  veq_bv     veq
 302     veq_pp   34.2/s      --   -100%   -100%
 303     veq_bv  17518/s  51190%      --    -91%
 304     veq    192181/s 562591%    997%      --
 305
 306 =item This is for perl 5.10.0 on an UltraSPARC-IIi (unit is 8 bits).
 307
 308                 Rate vfill_pp    vfill vfill_bv
 309     vfill_pp  4.23/s       --    -100%    -100%
 310     vfill    30039/s  709283%       --     -17%
 311     vfill_bv 36022/s  850568%      20%       --
 312
 313                 Rate vcopy_pp vcopy_bv    vcopy
 314     vcopy_pp  2.74/s       --    -100%    -100%
 315     vcopy_bv  8146/s  297694%       --     -60%
 316     vcopy    20266/s  740740%     149%       --
 317
 318                 Rate vmove_pp vmove_bv    vmove
 319     vmove_pp  2.66/s       --    -100%    -100%
 320     vmove_bv  8274/s  311196%       --     -59%
 321     vmove    20287/s  763190%     145%       --
 322
 323               Rate  veq_pp  veq_bv     veq
 324     veq_pp  7.33/s      --   -100%   -100%
 325     veq_bv  2499/s  33978%      --    -87%
 326     veq    19675/s 268193%    687%      --
 327
 328 =back
 329
 330 =head1 CAVEATS
 331
 332 Please report architectures where we can't use the alignment as the move unit.
 333 I'll add exceptions for them.
 334
 335 =head1 DEPENDENCIES
 336
 337 L<perl> 5.6.
 338
 339 A C compiler.
 340 This module may happen to build with a C++ compiler as well, but don't rely on it, as no guarantee is made in this regard.
 341
 342 L<Carp>, L<Exporter> (core modules since perl 5), L<XSLoader> (since perl 5.006).
 343
 344 =head1 SEE ALSO
 345
 346 L<Bit::Vector> gives a complete reimplementation of bit vectors.
 347
 348 =head1 AUTHOR
 349
 350 Vincent Pit, C<< <perl at profvince.com> >>, L<http://www.profvince.com>.
 351
 352 You can contact me by mail or on C<irc.perl.org> (vincent).
 353
 354 =head1 BUGS
 355
 356 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>.
 357 I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.
 358
 359 =head1 SUPPORT
 360
 361 You can find documentation for this module with the perldoc command.
 362
 363     perldoc Scalar::Vec::Util
 364
 365 Tests code coverage report is available at L<http://www.profvince.com/perl/cover/Scalar-Vec-Util>.
 366
 367 =head1 COPYRIGHT & LICENSE
 368
 369 Copyright 2008,2009,2010,2011,2012 Vincent Pit, all rights reserved.
 370
 371 This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
 372
 373 =cut
 374
 375 1; # End of Scalar::Vec::Util