]> git.vpit.fr Git - perl/modules/Scalar-Vec-Util.git/blob - lib/Scalar/Vec/Util.pm
Remove obsolete kwalitee workarounds
[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 *
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.006).
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 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