]> git.vpit.fr Git - perl/modules/Scalar-Vec-Util.git/blob - lib/Scalar/Vec/Util.pm
Introduce vshift()
[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.05
15
16 =cut
17
18 our $VERSION;
19 BEGIN {
20  $VERSION = '0.05';
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; # Overalapping areas DWIM.
44     if (veq $t, 10, $t, 20, 30) { ... } # Yes, they are equal now.
45
46 =head1 DESCRIPTION
47
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.
50
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>).
53
54 =head1 CONSTANTS
55
56 =head2 C<SVU_PP>
57
58 True when pure perl fallbacks are used instead of XS functions.
59
60 =head2 C<SVU_SIZE>
61
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).
65
66 =head1 FUNCTIONS
67
68 =head2 C<vfill $vec, $start, $length, $bit>
69
70 Starting at C<$start> in C<$vec>, fills C<$length> bits with C<$bit>.
71 Grows C<$vec> if necessary.
72
73 =cut
74
75 sub _alldef {
76  for (@_) { return 0 unless defined }
77  return 1;
78 }
79
80 sub vfill_pp {
81  (undef, my $s, my $l, my $x) = @_;
82  croak "Invalid argument" unless _alldef @_;
83  return unless $l;
84  $x = 1 if $x;
85  vec($_[0], $_, 1) = $x for $s .. $s + $l - 1;
86 }
87
88 =head2 C<< vcopy $from => $from_start, $to => $to_start, $length >>
89
90 Copies C<$length> bits starting at C<$from_start> in C<$from> to C<$to_start> in C<$to>.
91 If C<$from_start + $length> is too long for C<$from>, zeros are copied past C<$length>.
92 Grows C<$to> if necessary.
93 Doesn't need to allocate any extra memory.
94
95 =cut
96
97 sub vcopy_pp {
98  my ($fs, $ts, $l) = @_[1, 3, 4];
99  croak "Invalid argument" unless _alldef @_;
100  return unless $l;
101  my $step = $ts - $fs;
102  if ($step <= 0) { 
103   vec($_[2], $_ + $step, 1) = vec($_[0], $_, 1) for $fs .. $fs + $l - 1;
104  } else { # There's a risk of overwriting if $_[0] and $_[2] are the same SV.
105   vec($_[2], $_ + $step, 1) = vec($_[0], $_, 1) for reverse $fs .. $fs + $l - 1;
106  }
107 }
108
109 =head2 C<< vshift $v, $start, $length => $bits [, $insert ] >>
110
111 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.
112 If C<$insert> is defined, also fills the resulting gap with ones if C<$insert> is true and zeros if it's false.
113 Bits outside of the specified area are left untouched.
114 Doesn't need to allocate any extra memory.
115
116 =cut
117
118 sub vshift {
119  my ($start, $length, $bits, $insert) = @_[1 .. 4];
120  return unless $bits;
121  my $left = 1;
122  if ($bits < 0) {
123   $left = 0;
124   $bits = -$bits;
125  }
126  $bits    = $length if $bits > $length;
127  $length -= $bits;
128  if ($left) {
129   vcopy($_[0], $start, $_[0], $start + $bits, $length);
130   vfill($_[0], $start, $bits, $insert) if defined $insert;
131  } else {
132   vcopy($_[0], $start + $bits, $_[0], $start, $length);
133   vfill($_[0], $start + $length, $bits, $insert) if defined $insert;
134  }
135 }
136
137 =head2 C<< veq $v1 => $v1_start, $v2 => $v2_start, $length >>
138
139 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.
140 If needed, C<$length> is decreased to fit inside C<$v1> and C<$v2> boundaries.
141
142 =cut
143
144 sub veq_pp {
145  my ($s1, $s2, $l) = @_[1, 3, 4];
146  croak "Invalid argument" unless _alldef @_;
147  my $i = 0;
148  while ($i < $l) {
149   return 0 if vec($_[0], $s1 + $i, 1) != vec($_[2], $s2 + $i, 1);
150   ++$i;
151  }
152  return 1;
153 }
154
155 =head1 EXPORT
156
157 The functions L</vfill>, L</vcopy>, L</vshift> and L</veq> are only exported on request.
158 All of them are exported by the tags C<':funcs'> and C<':all'>.
159
160 The constants L</SVU_PP> and L</SVU_SIZE> are also only exported on request.
161 They are all exported by the tags C<':consts'> and C<':all'>.
162
163 =cut
164
165 use base qw/Exporter/;
166
167 our @EXPORT         = ();
168 our %EXPORT_TAGS    = (
169  'funcs'  => [ qw/vfill vcopy vshift veq/ ],
170  'consts' => [ qw/SVU_PP SVU_SIZE/ ]
171 );
172 our @EXPORT_OK      = map { @$_ } values %EXPORT_TAGS;
173 $EXPORT_TAGS{'all'} = [ @EXPORT_OK ];
174
175 =head1 BENCHMARKS
176
177 The following timings were obtained by running the C<samples/bench.pl> script.
178 The C<_pp> entries are the pure Perl versions, whereas C<_bv> are L<Bit::Vector> versions.
179
180 =over 4
181
182 =item This is for perl 5.8.8 on a Core 2 Duo 2.66GHz machine (unit is 64 bits).
183
184     Filling bits at a given position :
185                   Rate vfill_pp vfill_bv    vfill
186     vfill_pp    80.3/s       --    -100%    -100%
187     vfill_bv 1053399/s 1312401%       --     -11%
188     vfill    1180792/s 1471129%      12%       --
189
190     Copying bits from a bit vector to a different one :
191                  Rate vcopy_pp vcopy_bv    vcopy
192     vcopy_pp    112/s       --    -100%    -100%
193     vcopy_bv  62599/s   55622%       --     -89%
194     vcopy    558491/s  497036%     792%       --
195
196     Moving bits in the same bit vector from a given position to a different one :
197                  Rate vmove_pp vmove_bv    vmove
198     vmove_pp   64.8/s       --    -100%    -100%
199     vmove_bv  64742/s   99751%       --     -88%
200     vmove    547980/s  845043%     746%       --
201
202     Testing bit equality from different positions of different bit vectors :
203                Rate  veq_pp  veq_bv     veq
204     veq_pp   92.7/s      --   -100%   -100%
205     veq_bv  32777/s  35241%      --    -94%
206     veq    505828/s 545300%   1443%      --
207
208 =item This is for perl 5.10.0 on a Pentium 4 3.0GHz (unit is 32 bits).
209
210                  Rate vfill_pp vfill_bv    vfill
211     vfill_pp    185/s       --    -100%    -100%
212     vfill_bv 407979/s  220068%       --     -16%
213     vfill    486022/s  262184%      19%       --
214
215                  Rate vcopy_pp vcopy_bv    vcopy
216     vcopy_pp   61.5/s       --    -100%    -100%
217     vcopy_bv  32548/s   52853%       --     -83%
218     vcopy    187360/s  304724%     476%       --
219
220                  Rate vmove_pp vmove_bv    vmove
221     vmove_pp   63.1/s       --    -100%    -100%
222     vmove_bv  32829/s   51933%       --     -83%
223     vmove    188572/s  298787%     474%       --
224
225                Rate  veq_pp  veq_bv     veq
226     veq_pp   34.2/s      --   -100%   -100%
227     veq_bv  17518/s  51190%      --    -91%
228     veq    192181/s 562591%    997%      --
229
230 =item This is for perl 5.10.0 on an UltraSPARC-IIi (unit is 8 bits).
231
232                 Rate vfill_pp    vfill vfill_bv
233     vfill_pp  4.23/s       --    -100%    -100%
234     vfill    30039/s  709283%       --     -17%
235     vfill_bv 36022/s  850568%      20%       --
236
237                 Rate vcopy_pp vcopy_bv    vcopy
238     vcopy_pp  2.74/s       --    -100%    -100%
239     vcopy_bv  8146/s  297694%       --     -60%
240     vcopy    20266/s  740740%     149%       --
241
242                 Rate vmove_pp vmove_bv    vmove
243     vmove_pp  2.66/s       --    -100%    -100%
244     vmove_bv  8274/s  311196%       --     -59%
245     vmove    20287/s  763190%     145%       --
246
247               Rate  veq_pp  veq_bv     veq
248     veq_pp  7.33/s      --   -100%   -100%
249     veq_bv  2499/s  33978%      --    -87%
250     veq    19675/s 268193%    687%      --
251
252 =back
253
254 =head1 CAVEATS
255
256 Please report architectures where we can't use the alignment as the move unit.
257 I'll add exceptions for them.
258
259 =head1 DEPENDENCIES
260
261 L<Carp>, L<Exporter> (core modules since perl 5), L<XSLoader> (since perl 5.006).
262
263 =head1 SEE ALSO
264
265 L<Bit::Vector> gives a complete reimplementation of bit vectors.
266
267 =head1 AUTHOR
268
269 Vincent Pit, C<< <perl at profvince.com> >>, L<http://www.profvince.com>.
270
271 You can contact me by mail or on C<irc.perl.org> (vincent).
272
273 =head1 BUGS
274
275 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>.
276 I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.
277
278 =head1 SUPPORT
279
280 You can find documentation for this module with the perldoc command.
281
282     perldoc Scalar::Vec::Util
283
284 Tests code coverage report is available at L<http://www.profvince.com/perl/cover/Scalar-Vec-Util>.
285
286 =head1 COPYRIGHT & LICENSE
287
288 Copyright 2008 Vincent Pit, all rights reserved.
289
290 This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
291
292 =cut
293
294 1; # End of Scalar::Vec::Util