[MLton] share bug

[Stephen Weeks]

> One strange thing I meant to remark on before I put your patch in:
> the word `maybeSharePointer' NEVER appears in the stderr output.
> This means, from my reading of gc.c, that maybeSharePointer was
> never called with shouldHashCons true.

Ah.  That helps.  In reading the code more closely I see that
maybeSharePointer is only one place where GC_share may change a
pointer.  The others are at the end of mark().  It must be one of
those that is causing your problem.  I've put a new patch at the end
of this mail that covers those cases, and as far as I can tell, all of
the cases where GC_share changes a pointer.

This time I even tested the patch, on the following example.

--------------------------------------------------------------------------------
val a = Array.tabulate (2, fn i => [[i], [i + 1]])
(* Move everything into the old generation. *)
val () = MLton.GC.collect ()
(* Allocate a new object in the nursery. *)
val list = [hd (hd (Array.sub (a, 0)))] :: Array.sub (a, 0)
(* Share on the whole list, which should create an intergenerational pointer. *)
val () = MLton.share list
(* Check invariants. *)
val () = MLton.GC.collect ()
val () = print (concat ["size is = ", Int.toString (MLton.size list), "\n"])
val () = Array.update (a, 0, list)
val [[i], [j], [k]] = Array.sub (a, 0)
val _ = i + j + k
--------------------------------------------------------------------------------

If you compile the above with -debug true, it will fail in an assert
at the GC.collect.  With the patch below, it runs fine (the correct
size for the list is 60, not 72, since part of it is shared).

Here's the patch.

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

Index: gc.c
===================================================================
--- gc.c	(revision 4394)
+++ gc.c	(working copy)
@@ -880,12 +880,12 @@
         return s->nursery <= p and p < s->frontier;
 }
 
-#if ASSERT
-
 static inline bool isInOldGen (GC_state s, pointer p) {
         return s->heap.start <= p and p < s->heap.start + s->oldGenSize;
 }
 
+#if ASSERT
+
 static inline bool isInFromSpace (GC_state s, pointer p) {
         return (isInOldGen (s, p) or isInNursery (s, p));
 }
@@ -2094,6 +2094,13 @@
         return res;
 }
 
+static inline void markIntergenerational (GC_state s, Pointer *pp) {
+        if (s->mutatorMarksCards
+                and isInOldGen (s, (pointer)pp)
+                and isInNursery (s, *pp))
+                markCard (s, (pointer)pp);
+}
+
 static inline void maybeSharePointer (GC_state s,
                                         Pointer *pp, 
                                         Bool shouldHashCons) {
@@ -2103,6 +2110,7 @@
                 fprintf (stderr, "maybeSharePointer  pp = 0x%08x  *pp = 0x%08x\n",
                                 (uint)pp, (uint)*pp);
         *pp = hashCons (s, *pp, FALSE); 
+        markIntergenerational (s, pp);
 }
 
 /* ---------------------------------------------------------------- */
@@ -2377,6 +2385,8 @@
                 todo += index * POINTER_SIZE;
                 prev = *(pointer*)todo;
                 *(pointer*)todo = next;
+                if (shouldHashCons)
+                        markIntergenerational (s, (pointer*)todo);
                 goto markNextInNormal;
         } else if (ARRAY_TAG == tag) {
                 arrayIndex = arrayCounter (cur);
@@ -2386,6 +2396,8 @@
                 todo += numNonPointers + index * POINTER_SIZE;
                 prev = *(pointer*)todo;
                 *(pointer*)todo = next;
+                if (shouldHashCons)
+                        markIntergenerational (s, (pointer*)todo);
                 goto markNextInArray;
         } else {
                 assert (STACK_TAG == tag);
@@ -2396,6 +2408,8 @@
                 todo = top - layout->numBytes + frameOffsets [index + 1];
                 prev = *(pointer*)todo;
                 *(pointer*)todo = next;
+                if (shouldHashCons)
+                        markIntergenerational (s, (pointer*)todo);
                 index++;
                 goto markInFrame;
         }