1 package Scalar::Vec::Util;
10 Scalar::Vec::Util - Utility routines for vec strings.
23 XSLoader::load(__PACKAGE__, $VERSION);
26 *SVU_PP = sub () { 1 };
27 *SVU_SIZE = sub () { 1 };
36 use Scalar::Vec::Util qw/vfill vcopy veq/;
39 vfill $s, 0, 100, 1; # Fill with 100 bits 1 starting at 0.
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.
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.
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>).
58 True when pure perl fallbacks are used instead of XS functions.
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).
68 =head2 C<vfill $vec, $start, $length, $bit>
70 Starting at C<$start> in C<$vec>, fills C<$length> bits with C<$bit>.
71 Grows C<$vec> if necessary.
76 my ($s, $l, $x) = @_[1 .. 3];
78 croak 'Invalid negative offset' if $s < 0;
79 croak 'Invalid negative length' if $l < 0;
82 my $t = int($s / $SIZE) + 1;
83 my $u = int(($s + $l) / $SIZE);
84 if ($SIZE * $t < $s + $l) { # implies $t <= $u
85 vec($_[0], $_, 1) = $x for $s .. $SIZE * $t - 1;
86 vec($_[0], $_, $SIZE) = $x for $t .. $u - 1;
87 vec($_[0], $_, 1) = $x for $SIZE * $u .. $s + $l - 1;
89 vec($_[0], $_, 1) = $x for $s .. $s + $l - 1;
93 =head2 C<< vcopy $from => $from_start, $to => $to_start, $length >>
95 Copies C<$length> bits starting at C<$from_start> in C<$from> to C<$to_start> in C<$to>.
96 If C<$from_start + $length> is too long for C<$from>, zeros are copied past C<$length>.
97 Grows C<$to> if necessary.
98 Doesn't need to allocate any extra memory.
102 sub vcopy_pp ($$$$$) {
103 my ($fs, $ts, $l) = @_[1, 3, 4];
105 croak 'Invalid negative offset' if $fs < 0 or $ts < 0;
106 croak 'Invalid negative length' if $l < 0;
107 my $step = $ts - $fs;
109 vec($_[2], $_ + $step, 1) = vec($_[0], $_, 1) for $fs .. $fs + $l - 1;
110 } else { # There's a risk of overwriting if $_[0] and $_[2] are the same SV.
111 vec($_[2], $_ + $step, 1) = vec($_[0], $_, 1) for reverse $fs .. $fs + $l - 1;
115 =head2 C<< vshift $v, $start, $length => $bits [, $insert ] >>
117 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.
118 If C<$insert> is defined, also fills the resulting gap with ones if C<$insert> is true and zeros if it's false.
119 Bits outside of the specified area are left untouched.
120 Doesn't need to allocate any extra memory.
124 sub vshift ($$$$;$) {
125 my ($start, $length, $bits, $insert) = @_[1 .. 4];
126 return unless $length and $bits;
127 croak 'Invalid negative offset' if $start < 0;
128 croak 'Invalid negative length' if $length < 0;
134 if ($bits < $length) {
137 vcopy($_[0], $start, $_[0], $start + $bits, $length);
138 vfill($_[0], $start, $bits, $insert) if defined $insert;
140 vcopy($_[0], $start + $bits, $_[0], $start, $length);
141 vfill($_[0], $start + $length, $bits, $insert) if defined $insert;
144 vfill($_[0], $start, $length, $insert) if defined $insert;
148 =head2 C<< vrot $v, $start, $length, $bits >>
150 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.
151 Bits outside of the specified area are left untouched.
152 Currently allocates an extra buffer of size C<O($bits)>.
157 my ($start, $length, $bits) = @_[1 .. 3];
158 return unless $length and $bits;
159 croak 'Invalid negative offset' if $start < 0;
160 croak 'Invalid negative length' if $length < 0;
171 vcopy($_[0], $start + $length, $buf, 0, $bits);
172 vcopy($_[0], $start, $_[0], $start + $bits, $length);
173 vcopy($buf, 0, $_[0], $start, $bits);
175 vcopy($_[0], $start, $buf, 0, $bits);
176 vcopy($_[0], $start + $bits, $_[0], $start, $length);
177 vcopy($buf, 0, $_[0], $start + $length, $bits);
181 =head2 C<< veq $v1 => $v1_start, $v2 => $v2_start, $length >>
183 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.
184 If needed, C<$length> is decreased to fit inside C<$v1> and C<$v2> boundaries.
189 my ($s1, $s2, $l) = @_[1, 3, 4];
190 croak 'Invalid negative offset' if $s1 < 0 or $s2 < 0;
191 croak 'Invalid negative length' if $l < 0;
194 return 0 if vec($_[0], $s1 + $i, 1) != vec($_[2], $s2 + $i, 1);
202 The functions L</vfill>, L</vcopy>, L</vshift>, L</vrot> and L</veq> are only exported on request.
203 All of them are exported by the tags C<':funcs'> and C<':all'>.
205 The constants L</SVU_PP> and L</SVU_SIZE> are also only exported on request.
206 They are all exported by the tags C<':consts'> and C<':all'>.
210 use base qw/Exporter/;
214 'funcs' => [ qw/vfill vcopy vshift vrot veq/ ],
215 'consts' => [ qw/SVU_PP SVU_SIZE/ ]
217 our @EXPORT_OK = map { @$_ } values %EXPORT_TAGS;
218 $EXPORT_TAGS{'all'} = [ @EXPORT_OK ];
222 The following timings were obtained by running the C<samples/bench.pl> script.
223 The C<_pp> entries are the pure Perl versions, whereas C<_bv> are L<Bit::Vector> versions.
227 =item This is for perl 5.8.8 on a Core 2 Duo 2.66GHz machine (unit is 64 bits).
229 Filling bits at a given position :
230 Rate vfill_pp vfill_bv vfill
231 vfill_pp 80.3/s -- -100% -100%
232 vfill_bv 1053399/s 1312401% -- -11%
233 vfill 1180792/s 1471129% 12% --
235 Copying bits from a bit vector to a different one :
236 Rate vcopy_pp vcopy_bv vcopy
237 vcopy_pp 112/s -- -100% -100%
238 vcopy_bv 62599/s 55622% -- -89%
239 vcopy 558491/s 497036% 792% --
241 Moving bits in the same bit vector from a given position to a different one :
242 Rate vmove_pp vmove_bv vmove
243 vmove_pp 64.8/s -- -100% -100%
244 vmove_bv 64742/s 99751% -- -88%
245 vmove 547980/s 845043% 746% --
247 Testing bit equality from different positions of different bit vectors :
248 Rate veq_pp veq_bv veq
249 veq_pp 92.7/s -- -100% -100%
250 veq_bv 32777/s 35241% -- -94%
251 veq 505828/s 545300% 1443% --
253 =item This is for perl 5.10.0 on a Pentium 4 3.0GHz (unit is 32 bits).
255 Rate vfill_pp vfill_bv vfill
256 vfill_pp 185/s -- -100% -100%
257 vfill_bv 407979/s 220068% -- -16%
258 vfill 486022/s 262184% 19% --
260 Rate vcopy_pp vcopy_bv vcopy
261 vcopy_pp 61.5/s -- -100% -100%
262 vcopy_bv 32548/s 52853% -- -83%
263 vcopy 187360/s 304724% 476% --
265 Rate vmove_pp vmove_bv vmove
266 vmove_pp 63.1/s -- -100% -100%
267 vmove_bv 32829/s 51933% -- -83%
268 vmove 188572/s 298787% 474% --
270 Rate veq_pp veq_bv veq
271 veq_pp 34.2/s -- -100% -100%
272 veq_bv 17518/s 51190% -- -91%
273 veq 192181/s 562591% 997% --
275 =item This is for perl 5.10.0 on an UltraSPARC-IIi (unit is 8 bits).
277 Rate vfill_pp vfill vfill_bv
278 vfill_pp 4.23/s -- -100% -100%
279 vfill 30039/s 709283% -- -17%
280 vfill_bv 36022/s 850568% 20% --
282 Rate vcopy_pp vcopy_bv vcopy
283 vcopy_pp 2.74/s -- -100% -100%
284 vcopy_bv 8146/s 297694% -- -60%
285 vcopy 20266/s 740740% 149% --
287 Rate vmove_pp vmove_bv vmove
288 vmove_pp 2.66/s -- -100% -100%
289 vmove_bv 8274/s 311196% -- -59%
290 vmove 20287/s 763190% 145% --
292 Rate veq_pp veq_bv veq
293 veq_pp 7.33/s -- -100% -100%
294 veq_bv 2499/s 33978% -- -87%
295 veq 19675/s 268193% 687% --
301 Please report architectures where we can't use the alignment as the move unit.
302 I'll add exceptions for them.
306 L<Carp>, L<Exporter> (core modules since perl 5), L<XSLoader> (since perl 5.006).
310 L<Bit::Vector> gives a complete reimplementation of bit vectors.
314 Vincent Pit, C<< <perl at profvince.com> >>, L<http://www.profvince.com>.
316 You can contact me by mail or on C<irc.perl.org> (vincent).
320 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>.
321 I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.
325 You can find documentation for this module with the perldoc command.
327 perldoc Scalar::Vec::Util
329 Tests code coverage report is available at L<http://www.profvince.com/perl/cover/Scalar-Vec-Util>.
331 =head1 COPYRIGHT & LICENSE
333 Copyright 2008-2009 Vincent Pit, all rights reserved.
335 This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
339 1; # End of Scalar::Vec::Util