The attached change to src/pmc/bigint.pmc fixes a bug in shl/shr when
given a negative shift: The shift amount argument to the underlying GMP
operations is unsigned, so GMP tries consumes a huge amount of memory.
The patch also adds four tests for negative shifts.
The src/pmc/scalar.pmc changes promote the result to BigInt on
overflow for shl (but not shr yet). Comments would be greatly
appreciated. I have two questions in particular: (1) Is there a
cleaner way to do the code-sharing? and (2) Should the code throw an
error if attempting to morph a non-numeric type (and if so, what's the
best way of detecting that)? TIA.
If there are no objections, I will commit the negative shift fix
first, then work on finishing BigInt promotion by adding overflow
signalling (see PARROT_ERRORS_OVERFLOW_FLAG) and making shr behave
symmetrically.
-- Bob Rogers
http://rgrjr.dyndns.org/
* src/pmc/bigint.pmc:
+ (bigint_bitwise_shl_bigint_int, bigint_bitwise_shr_bigint_int):
Handle negative shift values by shifting in the opposite
direction. This fixes a bug where GMP would run out of memory; the
shift amount is unsigned.
* src/pmc/scalar.pmc:
+ (bitwise_shl_int, i_bitwise_shl_int): Promote to BigInt on
overflow. [Arguably, this should throw an error rather than morph
SELF from a non-numeric type.]
+ (bitwise_shl): Use bitwise_shl_int.
+ (i_bitwise_shl): Use i_bitwise_shl_int.
* t/pmc/bigint.t:
+ Four new tests for negative bignum shifts, and one new shl overflow
test. [Still need to tackle shr overflow.]
Diffs between last version checked in and current workfile(s):
Index: src/pmc/bigint.pmc
===================================================================
--- src/pmc/bigint.pmc (revision 18426)
+++ src/pmc/bigint.pmc (working copy)
@@ -267,13 +267,19 @@
bigint_bitwise_shl_bigint_int(Interp *interp, PMC* self,
INTVAL value, PMC *dest)
{
- mpz_mul_2exp(BN(dest), BN(self), value);
+ if (value >= 0)
+ mpz_mul_2exp(BN(dest), BN(self), value);
+ else
+ mpz_tdiv_q_2exp(BN(dest), BN(self), -value);
}
static void
bigint_bitwise_shr_bigint_int(Interp *interp, PMC* self,
INTVAL value, PMC *dest)
{
- mpz_tdiv_q_2exp(BN(dest), BN(self), value);
+ if (value >= 0)
+ mpz_tdiv_q_2exp(BN(dest), BN(self), value);
+ else
+ mpz_mul_2exp(BN(dest), BN(self), -value);
}
#else /* ifdef PARROT_HAS_GMP */
Index: src/pmc/scalar.pmc
===================================================================
--- src/pmc/scalar.pmc (revision 18426)
+++ src/pmc/scalar.pmc (working copy)
@@ -20,6 +20,9 @@
#include "parrot/parrot.h"
+extern PMC*
+Parrot_BigInt_bitwise_shl_int(Interp *interp, PMC* pmc, INTVAL value, PMC*
dest);
+
pmclass scalar abstract noinit {
/*
@@ -1083,38 +1086,51 @@
*/
- PMC* bitwise_shl(PMC* value, PMC* dest) {
- INTVAL result;
-
- result = DYNSELF.get_integer() << VTABLE_get_integer(INTERP, value);
- if (!dest)
- dest = pmc_new(INTERP, SELF->vtable->base_type);
- VTABLE_set_integer_native(INTERP, dest, result);
- return dest;
+ PMC* bitwise_shl(PMC* shift_value, PMC* dest) {
+ Parrot_scalar_bitwise_shl_int(interp, SELF,
+ VTABLE_get_integer(INTERP, shift_value),
+ dest);
}
- PMC* bitwise_shl_int(INTVAL value, PMC* dest) {
- INTVAL result;
+ PMC* bitwise_shl_int(INTVAL shift_amount, PMC* dest) {
+ INTVAL base = DYNSELF.get_integer();
+ INTVAL result = base << shift_amount;
- result = DYNSELF.get_integer() << value;
- if (!dest)
- dest = pmc_new(INTERP, SELF->vtable->base_type);
- VTABLE_set_integer_native(INTERP, dest, result);
+ if ((result >> shift_amount) != base) {
+ /* Overflow; must promote dest or SELF to bigint. */
+ if (dest)
+ VTABLE_morph(INTERP, dest, enum_class_BigInt);
+ else
+ dest = pmc_new(INTERP, enum_class_BigInt);
+ VTABLE_set_integer_native(INTERP, dest, base);
+ Parrot_BigInt_bitwise_shl_int(interp, dest, shift_amount, dest);
+ }
+ else {
+ if (!dest)
+ dest = pmc_new(INTERP, SELF->vtable->base_type);
+ VTABLE_set_integer_native(INTERP, dest, result);
+ }
return dest;
}
- void i_bitwise_shl(PMC* value) {
- INTVAL result;
-
- result = DYNSELF.get_integer() << VTABLE_get_integer(INTERP, value);
- DYNSELF.set_integer_native(result);
+ void i_bitwise_shl(PMC* shift_value) {
+ Parrot_scalar_i_bitwise_shl_int(interp, SELF,
+ VTABLE_get_integer(INTERP,
shift_value));
}
- void i_bitwise_shl_int(INTVAL value) {
- INTVAL result;
+ void i_bitwise_shl_int(INTVAL shift_amount) {
+ INTVAL base = DYNSELF.get_integer();
+ INTVAL result = base << shift_amount;
- result = DYNSELF.get_integer() << value;
- DYNSELF.set_integer_native(result);
+ if ((result >> shift_amount) != base) {
+ /* Overflow. */
+ VTABLE_morph(INTERP, SELF, enum_class_BigInt);
+ DYNSELF.set_integer_native(base);
+ Parrot_BigInt_bitwise_shl_int(interp, SELF, shift_amount, SELF);
+ }
+ else {
+ DYNSELF.set_integer_native(result);
+ }
}
/*
Index: t/pmc/bigint.t
===================================================================
--- t/pmc/bigint.t (revision 18426)
+++ t/pmc/bigint.t (working copy)
@@ -25,7 +25,7 @@
=cut
if ( $PConfig{gmp} ) {
- plan tests => 36;
+ plan tests => 41;
}
else {
plan skip_all => "No BigInt Lib configured";
@@ -759,6 +759,26 @@
102400000000000
OUT
+pir_output_is( <<'CODE', <<'OUT', "shl_bigint with a negative shift" );
+## cf the shr_bigint case.
+.sub main :main
+ new $P0, .BigInt
+ set $P0, 8
+ new $P1, .BigInt
+ set $P1, -2
+ new $P2, .BigInt
+ shl $P2, $P0, $P1
+ say $P2
+ set $P0, "102400000000000"
+ set $P1, -10
+ shl $P2, $P0, $P1
+ say $P2
+.end
+CODE
+2
+100000000000
+OUT
+
pasm_output_is( <<'CODE', <<'OUT', "shl_int" );
new P0, .BigInt
set P0, 2
@@ -788,6 +808,66 @@
102400000000000
OUT
+pir_output_is( <<'CODE', <<'OUT', "shl_int with a negative shift" );
+## cf the shr_int case.
+.sub main :main
+ new $P0, .BigInt
+ set $P0, 4
+ new $P1, .Integer
+ set $P1, -1
+ new $P2, .BigInt
+ shl $P2, $P0, $P1
+ say $P2
+ set $P0, "200000000000"
+ set $P1, -1
+ shl $P2, $P0, $P1
+ say $P2
+ set $P0, "102400000000000"
+ set $P1, -10
+ shl $P2, $P0, $P1
+ say $P2
+.end
+CODE
+2
+100000000000
+100000000000
+OUT
+
+pir_output_is( <<'CODE', <<'OUT', "shl_int promotes Integer to Bigint" );
+.sub main :main
+ new $P0, .Integer
+ set $P0, 1000001
+ new $P1, .Integer
+ set $P1, 10
+ new $P2, .Integer
+ ## shift by 10 bits . . .
+ shl $P2, $P0, $P1
+ $S2 = typeof $P2
+ print $S2
+ print ' '
+ say $P2
+ ## then by 20 bits . . .
+ $P1 = 20
+ new $P3, .Integer
+ $P3 = 1000001
+ shl $P3, $P0, $P1
+ $S2 = typeof $P3
+ print $S2
+ print ' '
+ say $P3
+ ## then by another 20 bits (total 30) in place.
+ shl $P2, $P2, $P1
+ $S2 = typeof $P2
+ print $S2
+ print ' '
+ say $P2
+.end
+CODE
+Integer 1024001024
+BigInt 1048577048576
+BigInt 1073742897741824
+OUT
+
pasm_output_is( <<'CODE', <<'OUT', "shr_bigint" );
new P0, .BigInt
set P0, 8
@@ -810,6 +890,26 @@
100000000000
OUT
+pir_output_is( <<'CODE', <<'OUT', "shr_bigint with a negative shift" );
+## cf the shl_bigint case.
+.sub main :main
+ new $P0, .BigInt
+ set $P0, 2
+ new $P1, .BigInt
+ set $P1, -2
+ new $P2, .BigInt
+ shr $P2, $P0, $P1
+ say $P2
+ set $P0, "100000000000"
+ set $P1, -10
+ shr $P2, $P0, $P1
+ say $P2
+.end
+CODE
+8
+102400000000000
+OUT
+
pasm_output_is( <<'CODE', <<'OUT', "shr_int" );
new P0, .BigInt
set P0, 4
@@ -839,6 +939,30 @@
100000000000
OUT
+pir_output_is( <<'CODE', <<'OUT', "shr_int with a negative shift" );
+## cf the shl_int case.
+.sub main :main
+ new $P0, .BigInt
+ set $P0, 2
+ new $P1, .Integer
+ set $P1, -1
+ new $P2, .BigInt
+ shr $P2, $P0, $P1
+ say $P2
+ set $P0, "100000000000"
+ set $P1, -1
+ shr $P2, $P0, $P1
+ say $P2
+ set $P1, -10
+ shr $P2, $P0, $P1
+ say $P2
+.end
+CODE
+4
+200000000000
+102400000000000
+OUT
+
pir_output_is( <<'CODE', <<'OUT', "BUG #34949 gt" );
.sub main :main
.local pmc b
End of diffs.
