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, 1000001
+ test_shift($P0, integer_modulus)
+
+ ## Test shifting a negative number.
+ set $P0, -1000001
+ 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.
+ n_shl $P2, number, $P1
+ $I1 = $P1
+ shl $I2, i_number, $I1
+ ## compare in I registers.
+ $P3 = n_mod $P2, integer_modulus
+ $I3 = $P3
+ if $I2 >= 0 goto pos_check
+ ## The register op gave a negative result, but the modulus will always be
+ ## positive. If the truncated result is correct, then the difference will
+ ## be the most negative INTVAL, which is the only number for which -x==x.
+ $I4 = $I3 - $I2
+ $I5 = - $I4
+ if $I4 == $I5 goto ok
+ goto bad
+pos_check:
+ if $I2 == $I3 goto ok
+bad:
+ print "oops; not ok: "
+ print i_number
+ print ' << '
+ print $I1
+ print ' gives I '
+ print $I2
+ print ' vs. P '
+ print $P3
+ print ".\n"
+ print $I5
+ print "\n"
+ok:
+ ## set up for the next one
+ inc $P1
+ goto loop
+done:
+ print "done.\n"
+.end
+CODE
+done.
+done.
+OUT
+
# Local Variables:
# mode: cperl
# cperl-indent-level: 4
End of diffs.
