File Coverage

File:blib/lib/Scalar/Vec/Util.pm
Coverage:100.0%

linestmtbranpathcondsubtimecode
1package Scalar::Vec::Util;
2
3
17
17
17
17
148
71
242
use strict;
4
17
17
17
17
170
70
167
use warnings;
5
6
17
17
17
17
180
68
292
use Carp qw/croak/;
7
8 - 16
=head1 NAME

Scalar::Vec::Util - Utility routines for vec strings.

=head1 VERSION

Version 0.06

=cut
17
18our $VERSION;
19BEGIN {
20
17
17
157
 $VERSION = '0.06';
21 eval {
22
17
168
  require XSLoader;
23
17
125
  XSLoader::load(__PACKAGE__, $VERSION);
24
16
2126
  1;
25
17
100
80
 } or do {
26
1
5
  *SVU_PP = sub () { 1 };
27
1
5
  *SVU_SIZE = sub () { 1 };
28
1
4
  *vfill = *vfill_pp;
29
1
3
  *vcopy = *vcopy_pp;
30
1
8
  *veq = *veq_pp;
31 }
32}
33
34 - 73
=head1 SYNOPSIS

    use Scalar::Vec::Util qw/vfill vcopy veq/;

    my $s;
    vfill $s, 0, 100, 1; # Fill with 100 bits 1 starting at 0.
    my $t;
    vcopy $s, 20, $t, 10, 30; # Copy 30 bits from $s, starting at 20,
                              #                to $t, starting at 10.
    vcopy $t, 10, $t, 20, 30; # Overalapping areas DWIM.
    if (veq $t, 10, $t, 20, 30) { ... } # Yes, they are equal now.

=head1 DESCRIPTION

A set of utilities to manipulate bits in vec strings.
Highly optimized XS routines are used when available, but straightforward pure perl replacements are also provided for platforms without a C compiler.

This module doesn't reimplement bit vectors.
It can be used on the very same scalars that C<vec> builds, or actually on any Perl string (C<SVt_PV>).

=head1 CONSTANTS

=head2 C<SVU_PP>

True when pure perl fallbacks are used instead of XS functions.

=head2 C<SVU_SIZE>

Size in bits of the unit used for moves.
The higher this value is, the faster the XS functions are.
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).

=head1 FUNCTIONS

=head2 C<vfill $vec, $start, $length, $bit>

Starting at C<$start> in C<$vec>, fills C<$length> bits with C<$bit>.
Grows C<$vec> if necessary.

=cut
74
75sub vfill_pp ($$$$) {
76
89147
89147
24209810
 my ($s, $l, $x) = @_[1 .. 3];
77
89147
100
460645
 return unless $l;
78
84722
100
370759
 croak 'Invalid negative offset' if $s < 0;
79
84721
100
348895
 croak 'Invalid negative length' if $l < 0;
80
84720
100
349680
 $x = ~0 if $x;
81
84720
252830
 my $SIZE = 32;
82
84720
370537
 my $t = int($s / $SIZE) + 1;
83
84720
324876
 my $u = int(($s + $l) / $SIZE);
84
84720
100
381863
 if ($SIZE * $t < $s + $l) { # implies $t <= $u
85
43085
43085
116342
1128139
  vec($_[0], $_, 1) = $x for $s .. $SIZE * $t - 1;
86
43085
43085
147615
367057
  vec($_[0], $_, $SIZE) = $x for $t .. $u - 1;
87
43085
43085
123794
567115
  vec($_[0], $_, 1) = $x for $SIZE * $u .. $s + $l - 1;
88 } else {
89
41635
41635
119347
933566
  vec($_[0], $_, 1) = $x for $s .. $s + $l - 1;
90 }
91}
92
93 - 100
=head2 C<< vcopy $from => $from_start, $to => $to_start, $length >>

Copies C<$length> bits starting at C<$from_start> in C<$from> to C<$to_start> in C<$to>.
If C<$from_start + $length> is too long for C<$from>, zeros are copied past C<$length>.
Grows C<$to> if necessary.
Doesn't need to allocate any extra memory.

=cut
101
102sub vcopy_pp ($$$$$) {
103
584
584
12707
 my ($fs, $ts, $l) = @_[1, 3, 4];
104
584
100
3441
 return unless $l;
105
575
100
100
6339
 croak 'Invalid negative offset' if $fs < 0 or $ts < 0;
106
573
100
2541
 croak 'Invalid negative length' if $l < 0;
107
572
2284
 my $step = $ts - $fs;
108
572
100
2606
 if ($step <= 0) {
109
382
382
1074
17698
  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
190
190
609
10150
  vec($_[2], $_ + $step, 1) = vec($_[0], $_, 1) for reverse $fs .. $fs + $l - 1;
112 }
113}
114
115 - 122
=head2 C<< vshift $v, $start, $length => $bits [, $insert ] >>

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.
If C<$insert> is defined, also fills the resulting gap with ones if C<$insert> is true and zeros if it's false.
Bits outside of the specified area are left untouched.
Doesn't need to allocate any extra memory.

=cut
123
124sub vshift ($$$$;$) {
125
5822
5822
112654
 my ($start, $length, $bits, $insert) = @_[1 .. 4];
126
5822
100
100
72326
 return unless $length and $bits;
127
3812
100
21802
 croak 'Invalid negative offset' if $start < 0;
128
3811
100
21284
 croak 'Invalid negative length' if $length < 0;
129
3810
15218
 my $left = 1;
130
3810
100
21228
 if ($bits < 0) {
131
1905
7298
  $left = 0;
132
1905
9715
  $bits = -$bits;
133 }
134
3810
100
17586
 if ($bits < $length) {
135
1890
7087
  $length -= $bits;
136
1890
100
9424
  if ($left) {
137
945
9103
   vcopy($_[0], $start, $_[0], $start + $bits, $length);
138
945
100
8408
   vfill($_[0], $start, $bits, $insert) if defined $insert;
139  } else {
140
945
9140
   vcopy($_[0], $start + $bits, $_[0], $start, $length);
141
945
100
9346
   vfill($_[0], $start + $length, $bits, $insert) if defined $insert;
142  }
143 } else {
144
1920
100
18150
  vfill($_[0], $start, $length, $insert) if defined $insert;
145 }
146}
147
148 - 154
=head2 C<< vrot $v, $start, $length, $bits >>

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.
Bits outside of the specified area are left untouched.
Currently allocates an extra buffer of size C<O($bits)>.

=cut
155
156sub vrot ($$$$) {
157
6172
6172
131934
 my ($start, $length, $bits) = @_[1 .. 3];
158
6172
100
100
74841
 return unless $length and $bits;
159
5452
100
28830
 croak 'Invalid negative offset' if $start < 0;
160
5451
100
28781
 croak 'Invalid negative length' if $length < 0;
161
5450
21914
 my $left = 1;
162
5450
100
31481
 if ($bits < 0) {
163
2725
10872
  $left = 0;
164
2725
12223
  $bits = -$bits;
165 }
166
5450
22895
 $bits %= $length;
167
5450
100
24997
 return unless $bits;
168
5300
20916
 $length -= $bits;
169
5300
23512
 my $buf = '';
170
5300
100
24213
 if ($left) {
171
2650
22571
  vcopy($_[0], $start + $length, $buf, 0, $bits);
172
2650
16872
  vcopy($_[0], $start, $_[0], $start + $bits, $length);
173
2650
17415
  vcopy($buf, 0, $_[0], $start, $bits);
174 } else {
175
2650
24101
  vcopy($_[0], $start, $buf, 0, $bits);
176
2650
19706
  vcopy($_[0], $start + $bits, $_[0], $start, $length);
177
2650
19282
  vcopy($buf, 0, $_[0], $start + $length, $bits);
178 }
179}
180
181 - 186
=head2 C<< veq $v1 => $v1_start, $v2 => $v2_start, $length >>

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.
If needed, C<$length> is decreased to fit inside C<$v1> and C<$v2> boundaries.

=cut
187
188sub veq_pp ($$$$$) {
189
17400
17400
311592
 my ($s1, $s2, $l) = @_[1, 3, 4];
190
17400
100
100
167110
 croak 'Invalid negative offset' if $s1 < 0 or $s2 < 0;
191
17398
100
76416
 croak 'Invalid negative length' if $l < 0;
192
17397
61329
 my $i = 0;
193
17397
82062
 while ($i < $l) {
194
2017595
100
8595330
  return 0 if vec($_[0], $s1 + $i, 1) != vec($_[2], $s2 + $i, 1);
195
2017315
7374495
  ++$i;
196 }
197
17117
224895
 return 1;
198}
199
200 - 208
=head1 EXPORT

The functions L</vfill>, L</vcopy>, L</vshift>, L</vrot> and L</veq> are only exported on request.
All of them are exported by the tags C<':funcs'> and C<':all'>.

The constants L</SVU_PP> and L</SVU_SIZE> are also only exported on request.
They are all exported by the tags C<':consts'> and C<':all'>.

=cut
209
210
17
17
17
17
345
151
258
use base qw/Exporter/;
211
212our @EXPORT = ();
213our %EXPORT_TAGS = (
214 'funcs' => [ qw/vfill vcopy vshift vrot veq/ ],
215 'consts' => [ qw/SVU_PP SVU_SIZE/ ]
216);
217our @EXPORT_OK = map { @$_ } values %EXPORT_TAGS;
218$EXPORT_TAGS{'all'} = [ @EXPORT_OK ];
219
220 - 337
=head1 BENCHMARKS

The following timings were obtained by running the C<samples/bench.pl> script.
The C<_pp> entries are the pure Perl versions, whereas C<_bv> are L<Bit::Vector> versions.

=over 4

=item This is for perl 5.8.8 on a Core 2 Duo 2.66GHz machine (unit is 64 bits).

    Filling bits at a given position :
                  Rate vfill_pp vfill_bv    vfill
    vfill_pp    80.3/s       --    -100%    -100%
    vfill_bv 1053399/s 1312401%       --     -11%
    vfill    1180792/s 1471129%      12%       --

    Copying bits from a bit vector to a different one :
                 Rate vcopy_pp vcopy_bv    vcopy
    vcopy_pp    112/s       --    -100%    -100%
    vcopy_bv  62599/s   55622%       --     -89%
    vcopy    558491/s  497036%     792%       --

    Moving bits in the same bit vector from a given position to a different one :
                 Rate vmove_pp vmove_bv    vmove
    vmove_pp   64.8/s       --    -100%    -100%
    vmove_bv  64742/s   99751%       --     -88%
    vmove    547980/s  845043%     746%       --

    Testing bit equality from different positions of different bit vectors :
               Rate  veq_pp  veq_bv     veq
    veq_pp   92.7/s      --   -100%   -100%
    veq_bv  32777/s  35241%      --    -94%
    veq    505828/s 545300%   1443%      --

=item This is for perl 5.10.0 on a Pentium 4 3.0GHz (unit is 32 bits).

                 Rate vfill_pp vfill_bv    vfill
    vfill_pp    185/s       --    -100%    -100%
    vfill_bv 407979/s  220068%       --     -16%
    vfill    486022/s  262184%      19%       --

                 Rate vcopy_pp vcopy_bv    vcopy
    vcopy_pp   61.5/s       --    -100%    -100%
    vcopy_bv  32548/s   52853%       --     -83%
    vcopy    187360/s  304724%     476%       --

                 Rate vmove_pp vmove_bv    vmove
    vmove_pp   63.1/s       --    -100%    -100%
    vmove_bv  32829/s   51933%       --     -83%
    vmove    188572/s  298787%     474%       --

               Rate  veq_pp  veq_bv     veq
    veq_pp   34.2/s      --   -100%   -100%
    veq_bv  17518/s  51190%      --    -91%
    veq    192181/s 562591%    997%      --

=item This is for perl 5.10.0 on an UltraSPARC-IIi (unit is 8 bits).

                Rate vfill_pp    vfill vfill_bv
    vfill_pp  4.23/s       --    -100%    -100%
    vfill    30039/s  709283%       --     -17%
    vfill_bv 36022/s  850568%      20%       --

                Rate vcopy_pp vcopy_bv    vcopy
    vcopy_pp  2.74/s       --    -100%    -100%
    vcopy_bv  8146/s  297694%       --     -60%
    vcopy    20266/s  740740%     149%       --

                Rate vmove_pp vmove_bv    vmove
    vmove_pp  2.66/s       --    -100%    -100%
    vmove_bv  8274/s  311196%       --     -59%
    vmove    20287/s  763190%     145%       --

              Rate  veq_pp  veq_bv     veq
    veq_pp  7.33/s      --   -100%   -100%
    veq_bv  2499/s  33978%      --    -87%
    veq    19675/s 268193%    687%      --

=back

=head1 CAVEATS

Please report architectures where we can't use the alignment as the move unit.
I'll add exceptions for them.

=head1 DEPENDENCIES

L<Carp>, L<Exporter> (core modules since perl 5), L<XSLoader> (since perl 5.006).

=head1 SEE ALSO

L<Bit::Vector> gives a complete reimplementation of bit vectors.

=head1 AUTHOR

Vincent Pit, C<< <perl at profvince.com> >>, L<http://www.profvince.com>.

You can contact me by mail or on C<irc.perl.org> (vincent).

=head1 BUGS

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>.
I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.

=head1 SUPPORT

You can find documentation for this module with the perldoc command.

    perldoc Scalar::Vec::Util

Tests code coverage report is available at L<http://www.profvince.com/perl/cover/Scalar-Vec-Util>.

=head1 COPYRIGHT & LICENSE

Copyright 2008-2009 Vincent Pit, all rights reserved.

This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.

=cut
338
3391; # End of Scalar::Vec::Util