twos_comp.diff

diff --git a/src/math/bigintops.c b/src/math/bigintops.c
index 0185219..f76b3b3 100644
--- a/src/math/bigintops.c
+++ b/src/math/bigintops.c
@@ -80,6 +80,63 @@ static mp_int * MVM_get_bigint(MVMObject *obj) {
   return &((P6bigint *)obj)->body.i;
 }
 
+static void grow_and_negate(mp_int *a, int size, mp_int *b) {
+    int i;
+    int actual_size = MAX(size, USED(a));
+    mp_zero(b);
+    mp_grow(b, actual_size);
+    USED(b) = actual_size;
+    for (i = 0; i < actual_size; i++) {
+        DIGIT(b, i) = (~DIGIT(a, i)) & MP_MASK;
+    }
+    mp_add_d(b, 1, b);
+}
+
+
+static void two_complement_bitop(mp_int *a, mp_int *b, mp_int *c,
+        int (*mp_bitop)(mp_int *, mp_int *, mp_int *)) {
+    mp_int d;
+    if (SIGN(a) ^ SIGN(b)) {
+        /* exactly one of them is negative, so need to perform
+         * some magic. tommath stores a sign bit, but Perl 6 expects
+         * 2's complement */
+        mp_init(&d);
+        if (MP_NEG == SIGN(a)) {
+            grow_and_negate(a, USED(b), &d);
+            mp_bitop(&d, b, c);
+        } else {
+            grow_and_negate(b, USED(a), &d);
+            mp_bitop(a, &d, c);
+        }
+        if (DIGIT(c, USED(c) - 1) & ((mp_digit)1<<(mp_digit)(DIGIT_BIT - 1))) {
+            grow_and_negate(c, c->used, &d);
+            mp_copy(&d, c);
+            mp_neg(c, c);
+        }
+        mp_clear(&d);
+    } else {
+        mp_bitop(a, b, c);
+    }
+
+}
+
+static void two_complement_shl(mp_int *result, mp_int *value, MVMint64 count) {
+    if (count >= 0) {
+        mp_mul_2d(value, count, result);
+    }
+    else if (MP_NEG == SIGN(value)) {
+        /* fake two's complement semantics on top of sign-magnitude
+         * algorithm appears to work [citation needed]
+         */
+        mp_add_d(value, 1, result);
+        mp_div_2d(result, -count, result, NULL);
+        mp_sub_d(result, 1, result);
+    }
+    else {
+        mp_div_2d(value, -count, result, NULL);
+    }
+}
+
 #define MVM_BIGINT_UNARY_OP(opname) \
 void MVM_bigint_##opname(MVMObject *b, MVMObject *a) { \
     mp_int *ia = MVM_get_bigint(a); \
@@ -95,6 +152,14 @@ void MVM_bigint_##opname(MVMObject *c, MVMObject *a, MVMObject *b) { \
     mp_##opname(ia, ib, ic); \
 }
 
+#define MVM_BIGINT_BINARY_OP_2(opname) \
+void MVM_bigint_##opname(MVMObject *c, MVMObject *a, MVMObject *b) { \
+    mp_int *ia = MVM_get_bigint(a); \
+    mp_int *ib = MVM_get_bigint(b); \
+    mp_int *ic = MVM_get_bigint(c); \
+    two_complement_bitop(ia, ib, ic, mp_##opname); \
+}
+
 #define MVM_BIGINT_COMPARE_OP(opname) \
 MVMint64 MVM_bigint_##opname(MVMObject *a, MVMObject *b) { \
     mp_int *ia = MVM_get_bigint(a); \
@@ -114,9 +179,9 @@ MVM_BIGINT_BINARY_OP(mod)
 MVM_BIGINT_BINARY_OP(gcd)
 MVM_BIGINT_BINARY_OP(lcm)
 
-MVM_BIGINT_BINARY_OP(or)
-MVM_BIGINT_BINARY_OP(xor)
-MVM_BIGINT_BINARY_OP(and)
+MVM_BIGINT_BINARY_OP_2(or)
+MVM_BIGINT_BINARY_OP_2(xor)
+MVM_BIGINT_BINARY_OP_2(and)
 
 MVM_BIGINT_COMPARE_OP(cmp)
 
@@ -173,12 +238,14 @@ void MVM_bigint_shl(MVMObject *b, MVMObject *a, MVMint64 n) {
     mp_int *ia = MVM_get_bigint(a);
     mp_int *ib = MVM_get_bigint(b);
     mp_mul_2d(ia, n, ib);
+    //~ two_complement_shl(ia, ib, n);
 }
 
 void MVM_bigint_shr(MVMObject *b, MVMObject *a, MVMint64 n) {
     mp_int *ia = MVM_get_bigint(a);
     mp_int *ib = MVM_get_bigint(b);
     mp_div_2d(ia, n, ib, NULL);
+    //~ two_complement_shl(ia, ib, -n);
 }
 
 void MVM_bigint_not(MVMObject *b, MVMObject *a) {

both on linux x64 and windows xp 32bit:

1..45
ok 1 - can round-trip negative number (string)
ok 2 - can round-trip negative number (string) by boxing
ok 3 - can round-trip negative number by unboxing
ok 4 - nqp::iseq_I can return false
ok 5 - nqp::iseq_I can return true
ok 6 - multiplication
ok 7 - addition
ok 8 - subtraction
ok 9 - division
ok 10 - bitshift left
ok 11 - original not modified by bitshift left
ok 12 - bitshift right
ok 13 - bit and
ok 14 - bit or
ok 15 - bit xor
ok 16 - bit negation
ok 17 - Bit ops (RT 109740)
not ok 18 - can box to a complex type with a P6bigint target
ok 19 - can get a bigint from a string with boxing type
not ok 20 - addition works on boxing type
ok 21 - pow (int, positive)
ok 22 - pow 0 ** large_number
ok 23 - pow 1 ** large_number
ok 24 - 2**100 to float
ok 25 - (-2)**101 to float
ok 26 - 123456789 * (-2)**101 to float
ok 27 - bigint -> float, 1e16
ok 28 - to_num and from_num round-trip
ok 29 - to_num and from_num round-trip on small floats
ok 30 - to_num and from_num round-trip on medium sized floats
ok 31 - to_num and from_num round-trip (negative number)
ok 32 - base_I with base 10
ok 33 - base_I with base 16
ok 34 - nqp::expmod_I
ok 35 - div_In santiy
ok 36 - div_In with big numbers
ok 37 - nqp::rand_I
ok 38 - is -4 prime
ok 39 - is 0 prime
ok 40 - is 1 prime
ok 41 - is 2 prime
ok 42 - is 4 prime
ok 43 - is 17 prime
ok 44 - nqp::gcd_I
ok 45 - nqp::lcm_I