Re: [perl #43105] [PATCH] function mmd.c::mmd_expand_y: newly allocated memory unitialized
On 6/2/07, chromatic [EMAIL PROTECTED] wrote:
On Friday 01 June 2007 16:29:08 Mehmet Yavuz Selim Soyturk wrote:
After a suggestion of Bernhard at #parrot, I added a function named
Cmem_sys_realloc_zeroed to parrot:
void * mem__sys_realloc_zeroed(void *from, size_t size, size_t
old_size)
It zeroes the contents of Cfrom from Cold_size.
I had to cast Cfrom to a Cchar* to suppress a warning from gcc
about pointer arithmetics, but I don't know if it's a good solution:
memset((char*)ptr + old_size, 0, size - old_size);
I thought that might happen. I prefer this memset() patch, but if it
doesn't work everywhere, your patch should work.
I attached a patch that makes use of Cmem_sys_allocate_zeroed and
Cmem_sys_realloc_zeroed.
Thanks, applied as r18757.
-- c
I grepped for other files that can make use of mem_sys_*_zeroed
variants. I attached a patch that affects objects.c, vtables.c,
gc/register.c and stm/waitlist.c.
--
Mehmet
Index: src/objects.c
===
--- src/objects.c (revision 18722)
+++ src/objects.c (working copy)
@@ -1376,7 +1376,7 @@
PMC *
Parrot_find_method_with_cache(Interp *interp, PMC *_class, STRING *method_name /* NN */)
{
-UINTVAL type, bits, i;
+UINTVAL type, bits;
Caches *mc;
Meth_cache_entry *e, *old;
@@ -1396,26 +1396,20 @@
if (type = mc-mc_size) {
if (mc-idx) {
-mc-idx = (Meth_cache_entry ***)mem_sys_realloc(mc-idx,
-sizeof (Meth_cache_entry ***) * (type + 1));
+mc-idx = (Meth_cache_entry ***)mem_sys_realloc_zeroed(mc-idx,
+sizeof (Meth_cache_entry ***) * (type + 1),
+sizeof (Meth_cache_entry ***) * mc-mc_size);
}
else {
-mc-idx = (Meth_cache_entry ***)mem_sys_allocate(
+mc-idx = (Meth_cache_entry ***)mem_sys_allocate_zeroed(
sizeof (Meth_cache_entry ***) * (type + 1));
}
-
-for (i = mc-mc_size; i = type; ++i)
-mc-idx[i] = NULL;
-
mc-mc_size = type + 1;
}
if (!mc-idx[type]) {
-mc-idx[type] = (Meth_cache_entry **)mem_sys_allocate(
+mc-idx[type] = (Meth_cache_entry **)mem_sys_allocate_zeroed(
sizeof (Meth_cache_entry *) * TBL_SIZE);
-
-for (i = 0; i TBL_SIZE; ++i)
-mc-idx[type][i] = NULL;
}
e = mc-idx[type][bits];
Index: src/gc/register.c
===
--- src/gc/register.c (revision 18722)
+++ src/gc/register.c (working copy)
@@ -141,7 +141,6 @@
void
create_initial_context(Interp *interp)
{
-int i;
static INTVAL num_regs[] ={32,32,32,32};
/* Create some initial free_list slots. */
@@ -149,10 +148,8 @@
#define INITIAL_FREE_SLOTS 8
interp-ctx_mem.n_free_slots = INITIAL_FREE_SLOTS;
interp-ctx_mem.free_list=
-(void **)mem_sys_allocate(INITIAL_FREE_SLOTS * sizeof (void *));
+(void **)mem_sys_allocate_zeroed(INITIAL_FREE_SLOTS * sizeof (void *));
-for (i = 0; i INITIAL_FREE_SLOTS; ++i)
-interp-ctx_mem.free_list[i] = NULL;
/*
* For now create context with 32 regs each. Some src tests (and maybe other
* extenders) are assuming the presence of these registers
Index: src/vtables.c
===
--- src/vtables.c (revision 18722)
+++ src/vtables.c (working copy)
@@ -90,13 +90,9 @@
table and we could get bigger without blowing much memory
*/
const INTVAL new_max = interp-n_vtable_alloced + 16;
-const INTVAL new_size = new_max * sizeof (VTABLE *);
-INTVAL i;
-interp-vtables = (VTABLE **)mem_sys_realloc(interp-vtables, new_size);
-/* Should set all the empty slots to the null PMC's
- vtable pointer */
-for (i = interp-n_vtable_max; i new_max; ++i)
-interp-vtables[i] = NULL;
+const INTVAL new_size = new_max * sizeof (VTABLE *);
+const INTVAL old_size = interp-n_vtable_max * sizeof (VTABLE *);
+interp-vtables = (VTABLE **)mem_sys_realloc_zeroed(interp-vtables, new_size, old_size);
interp-n_vtable_alloced = new_max;
}
Index: src/stm/waitlist.c
===
--- src/stm/waitlist.c (revision 18722)
+++ src/stm/waitlist.c (working copy)
@@ -41,12 +41,9 @@
}
if (thr-used_entries = thr-entry_count) {
-size_t i;
-thr-entries = mem_sys_realloc(thr-entries,
-sizeof (*thr-entries) * thr-entry_count * 2);
-for (i = thr-entry_count; i thr-entry_count * 2; ++i) {
-thr-entries[i] = NULL;
-}
+thr-entries = mem_sys_realloc_zeroed(thr-entries,
+sizeof (*thr-entries) * thr-entry_count * 2,
+sizeof (*thr-entries) * thr-entry_count);
thr-entry_count *= 2;
}
Re: [svn:parrot] r18724 - in trunk/config: auto init/hints
Nicholas Clark wrote: Works for me! :-) A note: as possibly the stumbler-upon-this-issue; chromatic's patch made things work here, right through make smoke. Thanks. a -- Andy Bach, Sys. Mangler Internet: [EMAIL PROTECTED] VOICE: (608) 261-5738 FAX 264-5932 Capital is only the fruit of labor. Labor is the superior of capital and deserves much the higher consideration. Abraham Lincoln, first annual address to Congress 1861
[perl #43107] t/tools/pmc2cutils/05-gen_c: Warnings being thrown in testing of Parrot::Pmc2c::Pmc2cMain
On Fri Jun 01 19:46:40 2007, rgrjr wrote:
This is from the Small tweak to Pmc2c.pm I posted on 19-May and
committed as r18646 on 26-May. Note that lib/Parrot/Pmc2c.pm is not
actually doing anything different now, it's just telling you that none
of the code for these methods is being used in the generated C file.
So
they are certainly not being tested now, and possibly haven't been for
a
while.
When the expected behavior of a block of code is to throw warnings, then tests
should be
written to make sure those warnings are, in fact, being thrown. We can do this
in our Perl 5-
based tests by using Parrot::IO::Capture::Mini to capture the warnings, then
using
Test::More::like() to determine if we got the warnings we expected. In r18763
I took this
approach and applied the following patch to t/tools/pmc2cutils/05-gen_c.t.
Should lib/Parrot/Pmc2c.pm be revised to eliminate those warnings, then the
tests I just
wrote will fail and will have to be revised. But that will be a good thing,
because the
warnings will have been cleared up.
Index: t/tools/pmc2cutils/05-gen_c.t
===
--- t/tools/pmc2cutils/05-gen_c.t (revision 18762)
+++ t/tools/pmc2cutils/05-gen_c.t (working copy)
@@ -19,12 +19,14 @@
}
unshift @INC, qq{$topdir/lib};
}
-use Test::More tests = 68;
+use Test::More tests = 74;
+use Carp;
use File::Basename;
use File::Copy;
use FindBin;
use Data::Dumper;
use_ok('Parrot::Pmc2c::Pmc2cMain');
+use_ok('Parrot::IO::Capture::Mini');
use_ok('Cwd');
use_ok( 'File::Temp', qw| tempdir | );
@@ -35,6 +37,9 @@
my $cwd = cwd();
my @include_orig = ( qq{$main::topdir}, qq{$main::topdir/src/pmc}, );
+my ( $tie, $msg, @lines );
+my $warnpattern =
+
qr/get_bool_keyed_int.*elements_keyed_int.*set_bool_keyed_int.*is_equal_str/s;
# basic test: @args holds default.pmc
{
@@ -71,9 +76,21 @@
ok( $self-dump_pmc(), dump_pmc succeeded );
ok( -f qq{$temppmcdir/default.dump}, default.dump created as expected );
-$rv = $self-gen_c();
-ok( $rv, gen_c completed successfully; args: default.pmc );
+{
+$tie = tie *STDERR, Parrot::IO::Capture::Mini
+or croak Unable to tie;
+$rv = $self-gen_c();
+@lines = $tie-READLINE;
+untie *STDERR or croak Unable to untie;
+ok( $rv, gen_c completed successfully; args: default.pmc );
+$msg = join(\n, @lines);
+like( $msg,
+$warnpattern,
+Warnings from Parrot::Pmc2c re 4 unknown methods have been
captured
+);
+}
+
ok( chdir $cwd, changed back to original directory );
}
@@ -113,8 +130,19 @@
ok( -f qq{$temppmcdir/default.dump}, default.dump created as expected );
ok( -f qq{$temppmcdir/array.dump}, array.dump created as expected );
-$rv = $self-gen_c();
-ok( $rv, gen_c completed successfully; args: default.pmc and array.pmc
);
+{
+$tie = tie *STDERR, Parrot::IO::Capture::Mini
+or croak Unable to tie;
+$rv = $self-gen_c();
+@lines = $tie-READLINE;
+untie *STDERR or croak Unable to untie;
+ok( $rv, gen_c completed successfully; args: default.pmc and
array.pmc );
+$msg = join(\n, @lines);
+like( $msg,
+$warnpattern,
+Warnings from Parrot::Pmc2c re 4 unknown methods have been
captured
+);
+}
ok( chdir $cwd, changed back to original directory );
}
@@ -155,15 +183,26 @@
ok( $self-dump_pmc(), dump_pmc succeeded );
ok( -f qq{$temppmcdir/default.dump}, default.dump created as expected );
-my ( $fh, $msg, $rv );
{
-my $currfh = select($fh);
-open( $fh, '', \$msg ) or die Unable to open handle: $!;
-$rv = $self-gen_c();
-select($currfh);
+$tie = tie *STDERR, Parrot::IO::Capture::Mini
+or croak Unable to tie;
+my ( $fh, $dmsg, $rv );
+{
+my $currfh = select($fh);
+open( $fh, '', \$dmsg ) or die Unable to open handle: $!;
+$rv = $self-gen_c();
+select($currfh);
+}
+@lines = $tie-READLINE;
+untie *STDERR or croak Unable to untie;
+ok( $rv, gen_c completed successfully; args: default.pmc );
+like( $dmsg, qr{src/pmc/default\.pmc}, debug option worked );
+$msg = join(\n, @lines);
+like( $msg,
+$warnpattern,
+Warnings from Parrot::Pmc2c re 4 unknown methods have been
captured
+);
}
-ok( $rv, gen_c completed successfully; args: default.pmc );
-like( $msg, qr{src/pmc/default\.pmc}, debug option worked );
ok( chdir $cwd, changed back to original directory );
}
@@ -199,33 +238,44 @@
);
isa_ok( $self, q{Parrot::Pmc2c::Pmc2cMain} );
-my ( $fh, $msg, $rv );
+my ( $fh, $dmsg, $rv );
{
my $currfh = select($fh);
-open( $fh, '', \$msg ) or die
[perl #43107] t/tools/pmc2cutils/05-gen_c: Warnings being thrown in testing of Parrot::Pmc2c::Pmc2cMain
Test now passes on Darwin and Linux. Resolving ticket.
Re: Use const proactively
On 6/2/07, Andy Lester [EMAIL PROTECTED] wrote:
From my wiki at http://xoa.petdance.com/Use_const_proactively
Const your local variables
The following is adapted from C++ Coding Standards by Herb Sutter and
Andrei Alexandrescu (with some C++-specific stuff removed):
const is your friend: Immutable values are easier to understand,
track, and reason about, so prefer consted variables wherever it is
sensible and make const your default choice when you define a value.
It's safe, and it's checked at compile time. Don't cast away const
except to call a const-incorrect function. Constants simplify code
because you only have to look at where the constant is defined to
know its value everywhere. Consider this code:
void Fun( const char * p ) {
const size_t len = strlen(p);
/* ... 30 more lines ... */
if (len 1)
...
}
When seeing len's definition above, you gain instance confidence
about len's semantics throughout its scope. It's a snapshot of p's
length at a specific point. Just by looking up one line, you know
len's semantics over its whole scope. Without the const, len might be
later modified. Best of all, the compiler will help you ensure that
this truth remains true.
Yes, const is viral -- add it in one place, and it wants to
propagate throughout your code as you call other functions who
signatures aren't yet const-correct. This is a feature, and this
quality greatly increases const's power.
Const-correctness is worthwhile, proven, effective, and highly
recommended. Understanding how and where a program's state changes is
vital, and const documents that directly in code where the compiler
can help to enforce it.
== Const your function parameters
Consting function parameters also lets the compiler know the behavior
of your function. Consider this snippet of code:
char buffer[20];
c = buffer[0];
The compiler or lint can now warn you that you're using buffer even
though it hasn't been initialized. But what about this:
void foo(char *p);
char buffer[20];
foo(buffer);
c = buffer[0];
Is foo() initializing what is sent into it? The compiler can't tell.
But if you define it like so:
void foo(const char *p);
now the compiler knows that buffer can't be getting initialized.
Think of consting your function parameters as a very basic contract
with the caller.
== What am I consting?
In an declaration such as
char *p;
there are two places const can be placed - with different effects.
const char* p;
The bytes p points at are considered const when accessed via p,
but the pointer p itself is not const
char* const p;
The pointer p is considered const, but the bytes it points at
are not
They can be combined:
const char* const p;
Both constant pointer and constant data
The rule is that const affects the thing immediately following it.
FWIW, a short note about the place where to put const:
a simple and easy rule is to read right to left:
char const *p; // means p is a pointer to constant characters
char * const p; // means that p is a constant pointer (*) to characters
char const * const p; // means that p is a constant pointer to constant
characters.
regards,
kjs
xoxo,
Andy
--
Andy Lester = [EMAIL PROTECTED] = www.petdance.com = AIM:petdance
Re: Relocation of the pod_todo.t test
On Thursday 31 May 2007 13:48:04 Paul Cochrane wrote: I recently added a test for TODO items in the pod source, but added it to the t/doc/ test suite. It is more of a coding standards test anyway, and I was wondering if it would be ok if I moved it from the doc tests into the coding standards tests. This would also allow me to un-skip the test, removing the extra output skipping the test generates in 'make test' output, and allowing people to run the test manually as opposed to part of the main test suite. Is this ok? If noone complains I'll make the change in the next couple of days. The plan makes sense to me. -- c
[perl #43107] t/tools/pmc2cutils/05-gen_c: Warnings being thrown in testing of Parrot::Pmc2c::Pmc2cMain
From: James Keenan via RT [EMAIL PROTECTED] Date: Sat, 02 Jun 2007 05:12:41 -0700 On Fri Jun 01 19:46:40 2007, rgrjr wrote: This is from the Small tweak to Pmc2c.pm I posted on 19-May and committed as r18646 on 26-May. Note that lib/Parrot/Pmc2c.pm is not actually doing anything different now, it's just telling you that none of the code for these methods is being used in the generated C file. So they are certainly not being tested now, and possibly haven't been for a while. When the expected behavior of a block of code is to throw warnings, then tests should be written to make sure those warnings are, in fact, being thrown. We can do this in our Perl 5- based tests by using Parrot::IO::Capture::Mini to capture the warnings, then using Test::More::like() to determine if we got the warnings we expected. In r18763 I took this approach and applied the following patch to t/tools/pmc2cutils/05-gen_c.t . . . This seems like a lot of trouble just to keep dead code in the codebase. Is there some reason not to yank the useless methods? -- Bob
BigInt bitwise_and, anyone?
I started hacking this because I thought I needed it, but that turned
out not to be true. Should I finish it (it still needs tests), or is
there some reason to hold off?
-- Bob Rogers
http://rgrjr.dyndns.org/
* src/pmc/bigint.pmc:
+ (bigint_bitwise_and_bigint_bigint, bigint_bitwise_and_bigint_int):
Bigint support for bitwise_and methods.
+ (bitwise_and, bitwise_and_int, i_bitwise_and, i_bitwise_and_int):
Methods that extend the Cband op to bigints.
Diffs between last version checked in and current workfile(s):
Index: src/pmc/bigint.pmc
===
--- src/pmc/bigint.pmc (revision 18749)
+++ src/pmc/bigint.pmc (working copy)
@@ -285,7 +285,31 @@
else
mpz_mul_2exp(BN(dest), BN(self), -value);
}
+static void
+bigint_bitwise_and_bigint_bigint(Interp *interp, PMC* self,
+ PMC* value, PMC *dest)
+{
+mpz_and(BN(dest), BN(self), BN(value));
+}
+static void
+bigint_bitwise_and_bigint_int(Interp *interp, PMC* self,
+ INTVAL value, PMC *dest)
+/* This is is trickier than the BigInt/BigInt case, since we need to (a)
produce
+ * a BigInt version of value, and (b) morph the result back to Integer.
+ */
+{
+mpz_t value_bn, result;
+long iresult;
+mpz_init(value_bn);
+mpz_set_si(value_bn, value);
+mpz_init(result);
+mpz_and(result, BN(self), value_bn);
+iresult = mpz_get_si(result);
+VTABLE_morph(interp, dest, enum_class_Integer);
+VTABLE_set_integer_native(interp, dest, iresult);
+}
+
#else /* ifdef PARROT_HAS_GMP */
static void
@@ -488,6 +512,21 @@
real_exception(interp, NULL, E_LibraryNotLoadedError,
no bigint lib loaded);
}
+static void
+bigint_bitwise_and_bigint_bigint(Interp *interp, PMC* self,
+ PMC* value, PMC *dest)
+{
+real_exception(interp, NULL, E_LibraryNotLoadedError,
+ no bigint lib loaded);
+}
+static void
+bigint_bitwise_and_bigint_int(Interp *interp, PMC* self,
+ INTVAL value, PMC *dest)
+
+{
+real_exception(interp, NULL, E_LibraryNotLoadedError,
+ no bigint lib loaded);
+}
#endif /* ifdef PARROT_HAS_GMP */
pmclass BigInt {
@@ -1309,6 +1348,68 @@
bigint_bitwise_shr_bigint_int(INTERP, SELF, value, SELF);
}
+/*
+
+=item CPMC* bitwise_and(PMC *value, PMC *dest)
+
+=item CPMC* bitwise_and_int(INTVAL value, PMC *dest)
+
+Returns in C*dest the bitwise AND of the BigInt by C*value.
+
+=item Cvoid i_bitwise_and(PMC *value)
+
+=item Cvoid i_bitwise_and_int(INTVAL value)
+
+Inplace bitwise AND.
+
+=cut
+
+*/
+
+PMC* bitwise_and(PMC* value, PMC* dest) {
+MMD_BigInt: {
+if (dest)
+VTABLE_morph(interp, dest, SELF-vtable-base_type);
+else
+dest = pmc_new(INTERP, SELF-vtable-base_type);
+bigint_bitwise_and_bigint_bigint(INTERP, SELF, value, dest);
+return dest;
+}
+MMD_Integer: {
+if (! dest)
+dest = pmc_new(INTERP, SELF-vtable-base_type);
+bigint_bitwise_and_bigint_int(INTERP, SELF, PMC_int_val(value),
dest);
+return dest;
+ }
+MMD_DEFAULT: {
+real_exception(INTERP, NULL, E_NotImplementedError, unimp band);
+return dest;
+ }
+}
+
+PMC* bitwise_and_int(INTVAL value, PMC* dest) {
+if (! dest)
+dest = pmc_new(INTERP, SELF-vtable-base_type);
+bigint_bitwise_and_bigint_int(INTERP, SELF, value, dest);
+return dest;
+}
+
+void i_bitwise_and(PMC* value) {
+MMD_BigInt: {
+bigint_bitwise_and_bigint_bigint(INTERP, SELF, value, SELF);
+}
+MMD_Integer: {
+bigint_bitwise_and_bigint_int(INTERP, SELF, PMC_int_val(value),
SELF);
+}
+MMD_DEFAULT: {
+real_exception(INTERP, NULL, E_NotImplementedError, unimp band);
+}
+}
+
+void i_bitwise_and_int(INTVAL value) {
+bigint_bitwise_and_bigint_int(INTERP, SELF, value, SELF);
+}
+
}
/*
End of diffs.
Re: [svn:parrot] r18767 - in trunk: config/gen/makefiles include/parrot src tools/build
On Saturday 02 June 2007 13:44:25 [EMAIL PROTECTED] wrote: First version of the headerizer works successfully on include/parrot/string_funcs.h This checkin broke at least one test. I know accidents happen, but you've had at least three checkins that have broken the compile or the tests in the past twelve hours. (There may be more; I'm still debugging the others.) Please amend your check-in process to alleviate this. -- c
Making I-reg shifts consistent with PMC shifts
The attached patch amends the I-reg shift operators so that they
produce results that are consistent with PMC shifts, which produce the
exact value [1]. Shifting left or right by at least the word size
always produces zero, and negative shift values are taken to mean shift
in the other direction, both of which I think are improvements over the
C shift operators, which seem to take the shift value modulo word size,
But I don't know how to describe the general case succinctly, which
could be a sign that it's the wrong thing. It's not the same result
modulo word size because the I-reg result could change sign, and mod
never returns a negative number. I think the result $r would be
$r = $x % 2**$w;
$r -= 2**$w
if $r = 2**($w-1);
if expressed in Perl, given the exact result in $x and the word size in
$w. Is there a better way to describe this sign-bashing modulus
operator? Or is this not the right implementation?
TIA,
-- Bob Rogers
http://rgrjr.dyndns.org/
[1] At least for left shifts, and if BigInt promotion is not disabled.
* src/ops/bit.ops:
+ (shl, shr): Make these produce results that are consistent with
the PMC versions.
* t/op/bitwise.t:
+ Test integer shift consistency.
Diffs between last version checked in and current workfile(s):
Index: src/ops/bit.ops
===
--- src/ops/bit.ops (revision 18767)
+++ src/ops/bit.ops (working copy)
@@ -2,6 +2,21 @@
** bit.ops
*/
+ /* Signed shift operator that is compatible with PMC shifts. This is
+ * guaranteed to produce the same result as bitwise_left_shift_internal modulo
+ * word size, ignoring the fact that Parrot integers are always signed. This
+ * usually gives the same answer regardless whether you shift PMC operands and
+ * then assign to an I-reg, or move the operands to I-regs and do the shift
+ * there -- except when the true result is between 2^{w-1} and 2^w (where w is
+ * the word size), in which case the high order bit is taken as the sign,
+ * giving a truncated result that is 2^w lower.
+ */
+#define bit_shift_left(number, bits) \
+((bits) = 8*INTVAL_SIZE ? 0\
+ : (bits) = 0 ? (number) (bits) \
+ : (bits) -8*INTVAL_SIZE ? (number) -(bits) \
+ : 0)
+
VERSION = PARROT_VERSION;
=head1 NAME
@@ -209,12 +224,12 @@
=cut
inline op shl(inout INT, in INT) :base_core {
- $1 = $2;
+ $1 = bit_shift_left($1, $2);
goto NEXT();
}
inline op shl(out INT, in INT, in INT) :base_core {
- $1 = $2 $3;
+ $1 = bit_shift_left($2, $3);
goto NEXT();
}
@@ -231,12 +246,14 @@
=cut
inline op shr(inout INT, in INT) :base_core {
- $1 = $2;
+ INTVAL signed_shift = -$2;
+ $1 = bit_shift_left($1, signed_shift);
goto NEXT();
}
inline op shr(out INT, in INT, in INT) :base_core {
- $1 = $2 $3;
+ INTVAL signed_shift = -$3;
+ $1 = bit_shift_left($2, signed_shift);
goto NEXT();
}
Index: t/op/bitwise.t
===
--- t/op/bitwise.t (revision 18767)
+++ t/op/bitwise.t (working copy)
@@ -6,7 +6,7 @@
use warnings;
use lib qw( . lib ../lib ../../lib );
use Test::More;
-use Parrot::Test tests = 26;
+use Parrot::Test tests = 27;
use Parrot::Config;
=head1 NAME
@@ -502,6 +502,88 @@
6
OUTPUT
+pir_output_is( 'CODE', 'OUT', I-reg shl and PMC shl are consistent);
+## The PMC shl op will promote Integer to Bigint when needed. We can't stuff a
+## BigInt in an I register, but we can produce the same result modulo wordsize.
+## [Only we cheat by using the word size minus one, so that we don't have to
+## deal with negative numbers. -- rgr, 2-Jun-07.]
+.sub main :main
+## Figure out the wordsize. We need integer_modulus because assigning a
+## too-big BigInt throws an error otherwise.
+.include 'sysinfo.pasm'
+.local int i_bytes_per_word, i_bits_per_word_minus_one
+.local pmc bits_per_word_minus_one, integer_modulus
+i_bytes_per_word = sysinfo .SYSINFO_PARROT_INTSIZE
+i_bits_per_word_minus_one = 8 * i_bytes_per_word
+dec i_bits_per_word_minus_one
+bits_per_word_minus_one = new .Integer
+bits_per_word_minus_one = i_bits_per_word_minus_one
+integer_modulus = new .BigInt
+integer_modulus = 1
+integer_modulus = bits_per_word_minus_one
+
+## Test shifting a positive number.
+new $P0, .Integer
+set $P0, 101
+test_shift($P0, integer_modulus)
+
+## Test shifting a negative number.
+set $P0, -101
+test_shift($P0, integer_modulus)
+.end
+
+.sub test_shift
+.param pmc number
+.param pmc integer_modulus
+new $P1, .Integer
+set $P1, 1
+.local int i_number
+i_number = number
+
+## Start the loop.
+loop:
+if $P1 100 goto done
+## shift number and i_number into $P2 and $I2.
+
