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.08
  15
  16 =cut
  17
  18 our $VERSION;
  19 BEGIN {
  20  $VERSION = '0.08';
  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 *
 259
 260 This is for perl 5.8.8 on a Core 2 Duo 2.66GHz machine (unit is 64 bits).
 261
 262     Filling bits at a given position :
 263                   Rate vfill_pp vfill_bv    vfill
 264     vfill_pp    80.3/s       --    -100%    -100%
 265     vfill_bv 1053399/s 1312401%       --     -11%
 266     vfill    1180792/s 1471129%      12%       --
 267
 268     Copying bits from a bit vector to a different one :
 269                  Rate vcopy_pp vcopy_bv    vcopy
 270     vcopy_pp    112/s       --    -100%    -100%
 271     vcopy_bv  62599/s   55622%       --     -89%
 272     vcopy    558491/s  497036%     792%       --
 273
 274     Moving bits in the same bit vector from a given position
 275     to a different one :
 276                  Rate vmove_pp vmove_bv    vmove
 277     vmove_pp   64.8/s       --    -100%    -100%
 278     vmove_bv  64742/s   99751%       --     -88%
 279     vmove    547980/s  845043%     746%       --
 280
 281     Testing bit equality from different positions of different
 282     bit vectors :
 283                Rate  veq_pp  veq_bv     veq
 284     veq_pp   92.7/s      --   -100%   -100%
 285     veq_bv  32777/s  35241%      --    -94%
 286     veq    505828/s 545300%   1443%      --
 287
 288 =item *
 289
 290 This is for perl 5.10.0 on a Pentium 4 3.0GHz (unit is 32 bits).
 291
 292                  Rate vfill_pp vfill_bv    vfill
 293     vfill_pp    185/s       --    -100%    -100%
 294     vfill_bv 407979/s  220068%       --     -16%
 295     vfill    486022/s  262184%      19%       --
 296
 297                  Rate vcopy_pp vcopy_bv    vcopy
 298     vcopy_pp   61.5/s       --    -100%    -100%
 299     vcopy_bv  32548/s   52853%       --     -83%
 300     vcopy    187360/s  304724%     476%       --
 301
 302                  Rate vmove_pp vmove_bv    vmove
 303     vmove_pp   63.1/s       --    -100%    -100%
 304     vmove_bv  32829/s   51933%       --     -83%
 305     vmove    188572/s  298787%     474%       --
 306
 307                Rate  veq_pp  veq_bv     veq
 308     veq_pp   34.2/s      --   -100%   -100%
 309     veq_bv  17518/s  51190%      --    -91%
 310     veq    192181/s 562591%    997%      --
 311
 312 =item *
 313
 314 This is for perl 5.10.0 on an UltraSPARC-IIi (unit is 8 bits).
 315
 316                 Rate vfill_pp    vfill vfill_bv
 317     vfill_pp  4.23/s       --    -100%    -100%
 318     vfill    30039/s  709283%       --     -17%
 319     vfill_bv 36022/s  850568%      20%       --
 320
 321                 Rate vcopy_pp vcopy_bv    vcopy
 322     vcopy_pp  2.74/s       --    -100%    -100%
 323     vcopy_bv  8146/s  297694%       --     -60%
 324     vcopy    20266/s  740740%     149%       --
 325
 326                 Rate vmove_pp vmove_bv    vmove
 327     vmove_pp  2.66/s       --    -100%    -100%
 328     vmove_bv  8274/s  311196%       --     -59%
 329     vmove    20287/s  763190%     145%       --
 330
 331               Rate  veq_pp  veq_bv     veq
 332     veq_pp  7.33/s      --   -100%   -100%
 333     veq_bv  2499/s  33978%      --    -87%
 334     veq    19675/s 268193%    687%      --
 335
 336 =back
 337
 338 =head1 CAVEATS
 339
 340 Please report architectures where we can't use the alignment as the move unit.
 341 I'll add exceptions for them.
 342
 343 =head1 DEPENDENCIES
 344
 345 L<perl> 5.6.
 346
 347 A C compiler.
 348 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.
 349
 350 L<Carp>, L<Exporter> (core modules since perl 5), L<XSLoader> (since perl 5.6.0).
 351
 352 =head1 SEE ALSO
 353
 354 L<Bit::Vector> gives a complete reimplementation of bit vectors.
 355
 356 =head1 AUTHOR
 357
 358 Vincent Pit, C<< <perl at profvince.com> >>, L<http://www.profvince.com>.
 359
 360 You can contact me by mail or on C<irc.perl.org> (vincent).
 361
 362 =head1 BUGS
 363
 364 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>.
 365 I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.
 366
 367 =head1 SUPPORT
 368
 369 You can find documentation for this module with the perldoc command.
 370
 371     perldoc Scalar::Vec::Util
 372
 373 Tests code coverage report is available at L<http://www.profvince.com/perl/cover/Scalar-Vec-Util>.
 374
 375 =head1 COPYRIGHT & LICENSE
 376
 377 Copyright 2008,2009,2010,2011,2012,2013 Vincent Pit, all rights reserved.
 378
 379 This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
 380
 381 =cut
 382
 383 1; # End of Scalar::Vec::Util