[MLton-commit] r6988

[Matthew Fluet]

Ensure that the current stack is traceable for MLton.share.
----------------------------------------------------------------------

U   mlton/trunk/mlton/backend/ssa-to-rssa.fun
U   mlton/trunk/runtime/gc/share.c
U   mlton/trunk/runtime/gc/size.c

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

Modified: mlton/trunk/mlton/backend/ssa-to-rssa.fun
===================================================================
--- mlton/trunk/mlton/backend/ssa-to-rssa.fun	2008-11-12 09:15:56 UTC (rev 6987)
+++ mlton/trunk/mlton/backend/ssa-to-rssa.fun	2008-11-12 17:24:23 UTC (rev 6988)
@@ -233,15 +233,19 @@
             bytesNeeded = NONE,
             convention = Cdecl,
             ensuresBytesFree = false,
-            mayGC = false,
+            mayGC = true, (* MLton.share works by tracing an object.
+                           * Make sure all the GC invariants are true,
+                           * because tracing might encounter the current
+                           * stack in the heap.
+                           *)
             maySwitchThreads = false,
             modifiesFrontier = true, (* actually, just readsFrontier *)
             prototype = (Vector.new2 (CType.gcState, CType.cpointer), NONE),
-            readsStackTop = false,
+            readsStackTop = true,
             return = Type.unit,
             symbolScope = Private,
             target = Direct "GC_share",
-            writesStackTop = false}
+            writesStackTop = true}
 
       (* CHECK; size with objptr *)
       fun size t =
@@ -249,9 +253,10 @@
             bytesNeeded = NONE,
             convention = Cdecl,
             ensuresBytesFree = false,
-            mayGC = true, (* MLton.size works by running the garbage
-                           * collector to trace the heap. Make sure all
-                           * invariants needed to do this safely are true.
+            mayGC = true, (* MLton.share works by tracing an object.
+                           * Make sure all the GC invariants are true,
+                           * because tracing might encounter the current
+                           * stack in the heap.
                            *)
             maySwitchThreads = false,
             modifiesFrontier = true,

Modified: mlton/trunk/runtime/gc/share.c
===================================================================
--- mlton/trunk/runtime/gc/share.c	2008-11-12 09:15:56 UTC (rev 6987)
+++ mlton/trunk/runtime/gc/share.c	2008-11-12 17:24:23 UTC (rev 6988)
@@ -10,6 +10,7 @@
   size_t bytesExamined;
   size_t bytesHashConsed;
 
+  enter (s); /* update stack in heap, in case it is reached */
   if (DEBUG_SHARE)
     fprintf (stderr, "GC_share "FMTPTR"\n", (uintptr_t)object);
   if (DEBUG_SHARE or s->controls.messages)
@@ -24,4 +25,5 @@
   s->cumulativeStatistics.bytesHashConsed += bytesHashConsed;
   if (DEBUG_SHARE or s->controls.messages)
     printBytesHashConsedMessage (bytesHashConsed, bytesExamined);
+  leave (s);
 }

Modified: mlton/trunk/runtime/gc/size.c
===================================================================
--- mlton/trunk/runtime/gc/size.c	2008-11-12 09:15:56 UTC (rev 6987)
+++ mlton/trunk/runtime/gc/size.c	2008-11-12 17:24:23 UTC (rev 6988)
@@ -1,4 +1,4 @@
-/* Copyright (C) 1999-2007 Henry Cejtin, Matthew Fluet, Suresh
+/* Copyright (C) 1999-2008 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  * Copyright (C) 1997-2000 NEC Research Institute.
  *
@@ -9,7 +9,7 @@
 size_t GC_size (GC_state s, pointer root) {
   size_t res;
   
-  enter(s); /* write a valid stack header in case it is reached */
+  enter (s); /* update stack in heap, in case it is reached */
   if (DEBUG_SIZE)
     fprintf (stderr, "GC_size marking\n");
   res = dfsMarkByMode (s, root, MARK_MODE, FALSE, FALSE);