[MLton-commit] r7083

[Wesley Terpstra]

When an arithmetic shift happens just before the heap runs out you see:
  ** glibc detected ** ./transporttest: realloc(): invalid pointer: 0x00007f94b429dff4 ***
  ======= Backtrace: =========
  /lib/libc.so.6[0x7f94b399319d]
  /lib/libc.so.6(realloc+0x237)[0x7f94b39978b7]
  /usr/lib/libgmp.so.3(__gmp_default_reallocate+0x1c)[0x7f94b3ef4a4c]
  /usr/lib/libgmp.so.3(__gmpz_realloc+0x3a)[0x7f94b3f096ba]
  /usr/lib/libgmp.so.3[0x7f94b3efe3a4]
  ./transporttest[0x419580]

The problem is that the line 
  S.max (1, S.- (numLimbs arg, shiftSize shift))
disagrees with gmp's mpz/cfdiv_q_2exp.c:
  usize = SIZ (u);
  abs_usize = ABS (usize);
  limb_cnt = cnt / GMP_NUMB_BITS;
  wsize = abs_usize - limb_cnt;
  if (wsize <= 0)
    {
      /* u < 2**cnt, so result 1, 0 or -1 according to rounding */
      PTR(w)[0] = 1;
      SIZ(w) = (usize == 0 || (usize ^ dir) < 0 ? 0 : dir);
      return;
    }

  /* +1 limb to allow for mpn_add_1 below */
  MPZ_REALLOC (w, wsize+1);

This causes gmp to need +1 more limb than is available in _mp_alloc triggering a realloc on the MLton heap. Boom!

The fix:
  S.+ (1, S.max (0, S.- (numLimbs arg, shiftSize shift)))
simply makes this match the logic in gmp.

PS. This whole "make enough for gmp" approach is very fragile...


----------------------------------------------------------------------

U   mlton/trunk/basis-library/integer/int-inf0.sml

----------------------------------------------------------------------

Modified: mlton/trunk/basis-library/integer/int-inf0.sml
===================================================================
--- mlton/trunk/basis-library/integer/int-inf0.sml	2009-04-15 01:16:52 UTC (rev 7082)
+++ mlton/trunk/basis-library/integer/int-inf0.sml	2009-04-16 18:31:18 UTC (rev 7083)
@@ -1203,7 +1203,7 @@
             if shift = 0wx0
                then arg
                else Prim.~>> (arg, shift,
-                              reserve (S.max (1, S.- (numLimbs arg, shiftSize shift)), 0))
+                              reserve (S.+ (1, S.max (0, S.- (numLimbs arg, shiftSize shift))), 0))
       end
 
       fun mkBigCvt {base: Int32.int,