]> git.vpit.fr Git - perl/modules/Scalar-Vec-Util.git/blob - lib/Scalar/Vec/Util.pm
a370396bf09651ce46df8b2a2be94b4b331b6005
[perl/modules/Scalar-Vec-Util.git] / 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