develooper Front page | perl.perl5.porters | Postings from November 2008

Re: [perl #969] [PATCH] Draft: shifting of bitvecs considered broken

Thread Previous | Thread Next
From:
Chip Salzenberg
Date:
November 17, 2008 03:21
Subject:
Re: [perl #969] [PATCH] Draft: shifting of bitvecs considered broken
Message ID:
20081117112129.GJ5495@tytlal.topaz.cx
On Mon, Nov 17, 2008 at 09:36:07AM +0100, Rafael Garcia-Suarez wrote:
> 2008/11/14 Chip Salzenberg via RT <perlbug-comment@perl.org>:
> > How about adding leftshift() and rightshift() as functions in a standard
> > bitvec.pm, rather than fiddling with the meaning of >> and << ?
> 
> Except the obligatory bikeshedding session on the new module name,
> (which I like, by the way), I think that's a good idea.

Well ... does it count as bikeshedding if it's your own module?  Here's a
first cut at the 'vec' module.  Please don't commit it just yet, it needs
review.  So ...  review, please?  (including the module name, I suppose)

    =item insert_low_bits STRING, COUNT

    Accept a bitvector STRING, a la L<vec>, and an integral bit COUNT.  Return a
    new bitvector that is a copy of the original STRING but with COUNT zero bits
    inserted at the low end of the vector; that is, at the front of the string.
    COUNT must be nonnegative.

    =item remove_low_bits STRING, COUNT

    Accept a bitvector STRING, a la L<vec>, and an integral bit COUNT.  Return a
    new bitvector that is a copy of the original STRING but with COUNT bits
    removed from the low end of the vector; that is, from the front of the
    string.

diff --git a/ext/vec/Makefile.PL b/ext/vec/Makefile.PL
new file mode 100644
index 0000000..ff8910a
--- /dev/null
+++ b/ext/vec/Makefile.PL
@@ -0,0 +1,7 @@
+use ExtUtils::MakeMaker;
+
+WriteMakefile(
+    VERSION_FROM    => "vec.pm",
+    NAME            => "vec",
+    OPTIMIZE        => '-g',
+);
diff --git a/ext/vec/t/vec.t b/ext/vec/t/vec.t
new file mode 100644
index 0000000..57a21b2
--- /dev/null
+++ b/ext/vec/t/vec.t
@@ -0,0 +1,30 @@
+#!./perl
+
+BEGIN {
+    unless (-d 'blib') {
+	chdir 't' if -d 't';
+	@INC = '../lib';
+    }
+}
+
+use Test::More tests => 15;
+use vec;
+
+ok(vec::->VERSION);
+
+ok(insert_low_bits("",     1) eq "\x00"    );
+ok(insert_low_bits("",     8) eq "\x00"    );
+ok(insert_low_bits("",     9) eq "\x00\x00");
+ok(insert_low_bits("\x01", 0) eq "\x01"    );
+ok(insert_low_bits("\x01", 1) eq "\x02"    );
+ok(insert_low_bits("\x01", 7) eq "\x80"    );
+ok(insert_low_bits("\x01", 8) eq "\x00\x01");
+
+ok(remove_low_bits("",          1) eq ""    );
+ok(remove_low_bits("\x01",      0) eq "\x01");
+ok(remove_low_bits("\x01",      1) eq ""    );
+ok(remove_low_bits("\x00\x01",  8) eq "\x01");
+ok(remove_low_bits("\x00\x01",  9) eq ""    );
+ok(remove_low_bits("\x80",      7) eq "\x01");
+ok(remove_low_bits("\x00\x80", 15) eq "\x01");
+
diff --git a/ext/vec/vec.pm b/ext/vec/vec.pm
new file mode 100644
index 0000000..1f6e06c
--- /dev/null
+++ b/ext/vec/vec.pm
@@ -0,0 +1,69 @@
+# vec.pm
+#
+# Copyright (c) 2008 Chip Salzenberg <chip@pobox.com>.  All rights reserved.
+# This program is free software; you can redistribute it and/or modify it
+# under the same terms as Perl itself.
+
+package vec;
+
+use strict;
+
+require Exporter;
+
+our $VERSION    = 0.01;
+our $XS_VERSION = $VERSION;
+our @ISA        = qw(Exporter);
+our @EXPORT     = qw(insert_low_bits remove_low_bits);
+our @EXPORT_OK  = @EXPORT;
+
+require XSLoader;
+XSLoader::load('vec', $XS_VERSION);
+
+1;
+
+__END__
+
+=head1 vec
+
+vec - Bit-vector functions not provided by the base language
+
+=head1 SYNOPSIS
+
+    use vec qw(insert_low_bits remove_low_bits);
+    use vec;  # same as above
+
+=head1 DESCRIPTION
+
+The C<vec> module provides some bit vector functionality that perhaps could
+have been part of the base language, but aren't, and for reasons of backward
+compatibility now cannot be.
+
+=over 4
+
+=item insert_low_bits STRING, COUNT
+
+Accept a bitvector STRING, a la L<vec>, and an integral bit COUNT.  Return a
+new bitvector that is a copy of the original STRING but with COUNT zero bits
+inserted at the low end of the vector; that is, at the front of the string.
+COUNT must be nonnegative.
+
+=item remove_low_bits STRING, COUNT
+
+Accept a bitvector STRING, a la L<vec>, and an integral bit COUNT.  Return a
+new bitvector that is a copy of the original STRING but with COUNT bits
+removed from the low end of the vector; that is, from the front of the
+string.
+
+=back
+
+=head1 SEE ALSO
+
+L<vec>
+
+=head1 COPYRIGHT
+
+Copyright (c) 2008 Chip Salzenberg <chip@pobox.com>. All rights reserved.
+This program is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
+
+=cut
diff --git a/ext/vec/vec.xs b/ext/vec/vec.xs
new file mode 100644
index 0000000..41d45e8
--- /dev/null
+++ b/ext/vec/vec.xs
@@ -0,0 +1,83 @@
+/* Copyright (c) 2008 Graham Barr <chip@pobox.com>. All rights reserved.
+ * This program is free software; you can redistribute it and/or
+ * modify it under the same terms as Perl itself.
+ */
+
+#include <EXTERN.h>
+#include <perl.h>
+#include <XSUB.h>
+
+MODULE=vec	PACKAGE=vec
+
+PROTOTYPES: DISABLE
+
+SV *
+insert_low_bits(ssv, shift)
+	SV *		ssv
+	IV		shift
+    PREINIT:
+	size_t len;
+	const char * const s = SvPV_const(ssv, len);
+	UV ibytes, ibits, iextra;
+	char *d;
+    CODE:
+	if (shift < 0)
+	    croak("invalid left shift");
+	ibytes = shift >> 3;
+	ibits  = shift & 7;
+	iextra  = ibits && (!len || ((unsigned char)s[len - 1] >> (8 - ibits)));
+	RETVAL = newSV(len + ibytes + iextra + 1);
+	d = SvPVX(RETVAL);
+	Zero(d, ibytes, char);
+	d += ibytes;
+	if (!ibits) {
+	    Copy(s, d, len, char);
+	    d += len;
+	}
+	else {
+	    size_t i;
+	    *d++ = (unsigned char)s[0] << ibits;
+	    for (i = 1; i < len + iextra; ++i)
+		*d++ = ((unsigned char)s[i  ] <<      ibits ) |
+		       ((unsigned char)s[i-1] >> (8 - ibits));
+	}
+	*d = '\0';
+	SvCUR_set(RETVAL, d - SvPVX_const(RETVAL));
+	SvPOK_on(RETVAL);
+    OUTPUT:
+	RETVAL
+
+SV *
+remove_low_bits(ssv, shift)
+	SV *		ssv
+	IV		shift
+    PREINIT:
+	size_t len;
+	const char * const s = SvPV_const(ssv, len);
+	UV rbytes, rbits, rextra;
+	char *d;
+    CODE:
+	if (shift < 0)
+	    croak("invalid left shift");
+	rbytes = shift >> 3;
+	rbits  = shift & 7;
+	rextra = rbits && len && !((unsigned char)s[len - 1] >> rbits);
+	if (len <= rbytes + rextra)
+	    XSRETURN_PVN("", 0);
+	RETVAL = newSV(len - (rbytes + rextra) + 1);
+	d = SvPVX(RETVAL);
+	if (!rbits) {
+	    Copy(s + rbytes, d, len - rbytes, char);
+	    d += len - rbytes;
+	}
+	else {
+	    size_t i;
+	    for (i = rbytes; i < len - rextra; ++i)
+		*d++ = ((unsigned char)s[i  ] >>      rbits ) |
+		       ((unsigned char)s[i+1] << (8 - rbits));
+	}
+	*d = '\0';
+	SvCUR_set(RETVAL, d - SvPVX_const(RETVAL));
+	SvPOK_on(RETVAL);
+    OUTPUT:
+	RETVAL


-- 
Chip Salzenberg <chip@pobox.com>

Thread Previous | Thread Next


nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About