Make scheduler-allocated data collectible

basis-library/mlton/thread.sig

@@ -47,13 +47,17 @@ signature MLTON_THREAD =
           (* The level (depth) of a thread's heap in the hierarchy. *)
           val getDepth : thread -> int
           val setDepth : thread * int -> unit
+          val setMinLocalCollectionDepth : thread * int -> unit
 
           (* Merge the heap of the deepest child of this thread. Requires that
            * this child is inactive and has an associated heap. *)
           val mergeThreads : thread * thread -> unit
 
           (* Move all chunks at the current depth up one level. *)
           val promoteChunks : thread -> unit
+
+          (* "put a new thread in the hierarchy *)
+          val moveNewThreadToDepth : thread * int -> unit
         end
 
       type 'a t

basis-library/mlton/thread.sml

@@ -75,6 +75,10 @@ struct
 
   fun getDepth t = Word32.toInt (Prim.getDepth t)
   fun setDepth (t, d) = Prim.setDepth (t, Word32.fromInt d)
+  fun setMinLocalCollectionDepth (t, d) =
+    Prim.setMinLocalCollectionDepth (t, Word32.fromInt d)
+  fun moveNewThreadToDepth (t, d) =
+    Prim.moveNewThreadToDepth (t, Word32.fromInt d)
 end
 
 fun prepend (T r: 'a t, f: 'b -> 'a): 'b t =

basis-library/primitive/prim-mlton.sml

@@ -405,8 +405,10 @@ structure Thread =
 
       val getDepth = _import "GC_HH_getDepth" runtime private: thread -> Word32.word;
       val setDepth = _import "GC_HH_setDepth" runtime private: thread * Word32.word -> unit;
+      val setMinLocalCollectionDepth = _import "GC_HH_setMinLocalCollectionDepth" runtime private: thread * Word32.word -> unit;
       val mergeThreads = _import "GC_HH_mergeThreads" runtime private: thread * thread -> unit;
       val promoteChunks = _import "GC_HH_promoteChunks" runtime private: thread -> unit;
+      val moveNewThreadToDepth = _import "GC_HH_moveNewThreadToDepth" runtime private: thread * Word32.word -> unit;
    end
 
 structure Weak =

basis-library/schedulers/shh/Scheduler.sml

@@ -280,10 +280,13 @@ struct
 
   fun setupSchedLoop () =
     let
+      val mySchedThread = Thread.current ()
+      val _ = HH.setDepth (mySchedThread, 1)
+      val _ = HH.setMinLocalCollectionDepth (mySchedThread, 1)
+
       val myId = myWorkerId ()
       val myRand = SMLNJRandom.rand (0, myId)
       (*val myRand = SimpleRandom.rand myId*)
-      val mySchedThread = Thread.current ()
       val {queue=myQueue, schedThread, ...} =
         vectorSub (workerLocalData, myId)
       val _ = schedThread := SOME mySchedThread
@@ -327,8 +330,9 @@ struct
         in
           if depth >= 1 then () else
             die (fn _ => "scheduler bug: acquired with depth " ^ Int.toString depth ^ "\n");
-          HH.setDepth (taskThread, depth+1);
           Queue.setDepth myQueue (depth+1);
+          HH.moveNewThreadToDepth (taskThread, depth);
+          HH.setDepth (taskThread, depth+1);
           setTaskBox myId task;
           stopTimer idleTimer';
           threadSwitch taskThread;
@@ -376,7 +380,6 @@ struct
         (* val schedHeap = HH.newHeap () *)
       in
         amOriginal := false;
-        HH.setDepth (schedThread, 1);
         setQueueDepth (myWorkerId ()) 1;
         threadSwitch schedThread
       end

mlton/backend/rep-type.fun

@@ -427,6 +427,8 @@ structure ObjectType =
                      Bits.toBytes (Type.width (Type.exnStack ()))
                   val bytesCurrentDepth =
                      Bits.toBytes (Type.width Type.word32)
+                  val bytesMinLocalCollectionDepth =
+                     Bits.toBytes (Type.width Type.word32)
                   val bytesAllocatedSinceLastCollection =
                      Bits.toBytes (Control.Target.Size.csize ())
                   val bytesSurvivedLastCollection =
@@ -448,6 +450,7 @@ structure ObjectType =
                         bytesBytesNeeded +
                         bytesExnStack +
                         bytesCurrentDepth +
+                        bytesMinLocalCollectionDepth +
                         bytesAllocatedSinceLastCollection +
                         bytesSurvivedLastCollection +
                         bytesHierarchicalHeap +
@@ -469,6 +472,7 @@ structure ObjectType =
                                                Type.csize (),
                                                Type.exnStack (),
                                                Type.word32,
+                                               Type.word32,
                                                Type.csize (),
                                                Type.csize (),
                                                Type.cpointer (),

runtime/gc/hierarchical-heap-collection.c

@@ -87,10 +87,10 @@ void HM_HHC_collectLocal(uint32_t desiredScope, bool force) {
     return;
   }
 
-  if (!force && thread->currentDepth <= 1) {
-    LOG(LM_HH_COLLECTION, LL_INFO, "Skipping collection during sequential section");
-    return;
-  }
+  // if (!force && thread->currentDepth <= 1) {
+  //   LOG(LM_HH_COLLECTION, LL_INFO, "Skipping collection during sequential section");
+  //   return;
+  // }
 
   uint64_t topval = *(uint64_t*)objptrToPointer(s->wsQueueTop, NULL);
   uint32_t potentialLocalScope = UNPACK_IDX(topval);
@@ -99,7 +99,7 @@ void HM_HHC_collectLocal(uint32_t desiredScope, bool force) {
   uint32_t minDepth = originalLocalScope;
   // claim as many levels as we can, but only as far as desired
   while (minDepth > desiredScope &&
-         minDepth > s->controls->hhConfig.minLocalDepth &&
+         minDepth > thread->minLocalCollectionDepth &&
          tryClaimLocalScope(s)) {
     minDepth--;
   }

runtime/gc/init-world.c

@@ -197,7 +197,7 @@ void duplicateWorld (GC_state d, GC_state s) {
   /* SAM_NOTE: TODO:
    * initWorld calls switchToThread, but duplicateWorld does not. Why?
    * Is this safe? */
-  initThreadAndHeap(d, 1);
+  initThreadAndHeap(d, 0);
 
   /* Now copy stats, heap data from original */
   d->cumulativeStatistics->maxHeapSize = s->cumulativeStatistics->maxHeapSize;

runtime/gc/new-object.c

@@ -105,6 +105,7 @@ GC_thread newThread(GC_state s, size_t reserved) {
   thread->bytesNeeded = 0;
   thread->exnStack = BOGUS_EXN_STACK;
   thread->currentDepth = HM_HH_INVALID_DEPTH;
+  thread->minLocalCollectionDepth = s->controls->hhConfig.minLocalDepth;
   thread->bytesAllocatedSinceLastCollection = 0;
   thread->bytesSurvivedLastCollection = 0;
   thread->hierarchicalHeap = NULL;
@@ -163,6 +164,7 @@ GC_thread newThreadWithHeap(GC_state s, size_t reserved, uint32_t depth) {
   thread->bytesNeeded = 0;
   thread->exnStack = BOGUS_EXN_STACK;
   thread->currentDepth = depth;
+  thread->minLocalCollectionDepth = s->controls->hhConfig.minLocalDepth;
   thread->bytesAllocatedSinceLastCollection = totalSize;
   thread->bytesSurvivedLastCollection = 0;
   thread->hierarchicalHeap = hh;

runtime/gc/parallel.c

@@ -6,10 +6,6 @@ void Parallel_init (void) {
   GC_state s = pthread_getspecific (gcstate_key);
 
   if (!Proc_isInitialized (s)) {
-    for (uint32_t proc = 1; proc < s->numberOfProcs; proc++) {
-      getThreadCurrent(&(s->procStates[proc]))->currentDepth = 1;
-    }
-
     /* Now wake them up! */
     Proc_signalInitialization (s);
   }

runtime/gc/thread.c

@@ -38,6 +38,12 @@ void GC_HH_setDepth(pointer threadp, Word32 depth) {
   assert(((HM_chunk)blockOf(s->frontier))->magic == CHUNK_MAGIC);
 }
 
+void GC_HH_setMinLocalCollectionDepth(pointer threadp, Word32 depth) {
+  GC_state s = pthread_getspecific(gcstate_key);
+  GC_thread thread = threadObjptrToStruct(s, pointerToObjptr(threadp, NULL));
+  thread->minLocalCollectionDepth = depth;
+}
+
 void GC_HH_mergeThreads(pointer threadp, pointer childp) {
   GC_state s = pthread_getspecific(gcstate_key);
 
@@ -105,6 +111,30 @@ void GC_HH_promoteChunks(pointer threadp) {
   HM_HH_promoteChunks(s, thread);
 }
 
+void GC_HH_moveNewThreadToDepth(pointer threadp, uint32_t depth) {
+  GC_state s = pthread_getspecific(gcstate_key);
+  GC_thread thread = threadObjptrToStruct(s, pointerToObjptr(threadp, NULL));
+  assert(thread != NULL);
+  HM_HierarchicalHeap hh = thread->hierarchicalHeap;
+
+  /* A few sanity checks. The thread should be a "new" thread that was
+   * just created by a call to copyThreadWithHeap.
+   *
+   * We could put in assertions to check this more thoroughly, for example
+   * we could check that the only stuff currently in the chunk of the thread
+   * is exactly the thread and its stack, and nothing else. But these sanity
+   * checks are good enough for now... */
+  assert(hh != NULL);
+  assert(HM_HH_getDepth(hh) == 0);
+  assert(HM_getChunkListFirstChunk(HM_HH_getChunkList(hh)) ==
+         HM_getChunkListLastChunk(HM_HH_getChunkList(hh)));
+  assert(HM_getChunkOf(threadp) == HM_getChunkListFirstChunk(HM_HH_getChunkList(hh)));
+  assert(HM_getChunkOf(objptrToPointer(thread->stack, NULL)) ==
+         HM_getChunkListFirstChunk(HM_HH_getChunkList(hh)));
+
+  thread->currentDepth = depth;
+  hh->depth = depth;
+}
 
 #endif /* MLTON_GC_INTERNAL_BASIS */
 

runtime/gc/thread.h

@@ -1,4 +1,4 @@
-/* Copyright (C) 2018-2019 Sam Westrick
+/* Copyright (C) 2018-2020 Sam Westrick
  * Copyright (C) 2014-2016 Ram Raghunathan
  * Copyright (C) 1999-2007 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
@@ -44,6 +44,8 @@ typedef struct GC_thread {
    * Fresh chunks are placed at this level. */
   uint32_t currentDepth;
 
+  uint32_t minLocalCollectionDepth;
+
   size_t bytesAllocatedSinceLastCollection;
   size_t bytesSurvivedLastCollection;
 
@@ -61,6 +63,7 @@ COMPILE_TIME_ASSERT(GC_thread__packed,
                     sizeof(size_t) +  // bytesNeeded
                     sizeof(size_t) +  // exnStack
                     sizeof(uint32_t) + // currentDepth
+                    sizeof(uint32_t) + // minLocalCollectionDepth
                     sizeof(size_t) +  // bytesAllocatedSinceLastCollection
                     sizeof(size_t) +  // bytesSurvivedLastCollection
                     sizeof(void*) +   // hierarchicalHeap
@@ -82,6 +85,14 @@ PRIVATE Word32 GC_HH_getDepth(pointer thread);
 PRIVATE void GC_HH_setDepth(pointer thread, Word32 depth);
 PRIVATE void GC_HH_mergeThreads(pointer threadp, pointer childp);
 PRIVATE void GC_HH_promoteChunks(pointer thread);
+PRIVATE void GC_HH_setMinLocalCollectionDepth(pointer thread, Word32 depth);
+
+/* Moves a "new" thread to the appropriate depth, before we switch to it.
+ * This essentially puts the thread (and its stack) into the hierarchy.
+ * Also sets the depth of the thread.
+ */
+PRIVATE void GC_HH_moveNewThreadToDepth(pointer thread, Word32 depth);
+
 #endif /* MLTON_GC_INTERNAL_BASIS */
 
 #if (defined (MLTON_GC_INTERNAL_FUNCS))