Add fork test case (fails on os x if pthread_atfork is not called).

pthread_atfork handlers on OS X: in the child, update the mach port for the forking thread and move all other threads to the dead ring.

Copied from Perforce
 Change: 193746

mps/code/comm.gmk

@@ -266,6 +266,7 @@ TEST_TARGETS=\
     expt825 \
     finalcv \
     finaltest \
+    forktest \
     fotest \
     gcbench \
     landtest \
@@ -499,6 +500,9 @@ $(PFM)/$(VARIETY)/finalcv: $(PFM)/$(VARIETY)/finalcv.o \
 $(PFM)/$(VARIETY)/finaltest: $(PFM)/$(VARIETY)/finaltest.o \
 	$(FMTDYTSTOBJ) $(TESTLIBOBJ) $(PFM)/$(VARIETY)/mps.a
 
+$(PFM)/$(VARIETY)/forktest: $(PFM)/$(VARIETY)/forktest.o \
+	$(TESTLIBOBJ) $(PFM)/$(VARIETY)/mps.a
+
 $(PFM)/$(VARIETY)/fotest: $(PFM)/$(VARIETY)/fotest.o \
 	$(TESTLIBOBJ) $(PFM)/$(VARIETY)/mps.a
 

mps/code/commpost.nmk

@@ -237,6 +237,9 @@ $(PFM)\$(VARIETY)\finalcv.exe: $(PFM)\$(VARIETY)\finalcv.obj \
 $(PFM)\$(VARIETY)\finaltest.exe: $(PFM)\$(VARIETY)\finaltest.obj \
 	$(PFM)\$(VARIETY)\mps.lib $(FMTTESTOBJ) $(TESTLIBOBJ)
 
+$(PFM)\$(VARIETY)\forktest.exe: $(PFM)\$(VARIETY)\forktest.obj \
+	$(PFM)\$(VARIETY)\mps.lib $(TESTLIBOBJ)
+
 $(PFM)\$(VARIETY)\fotest.exe: $(PFM)\$(VARIETY)\fotest.obj \
 	$(PFM)\$(VARIETY)\mps.lib $(TESTLIBOBJ)
 

mps/code/commpre.nmk

@@ -77,6 +77,7 @@ TEST_TARGETS=\
     expt825.exe \
     finalcv.exe \
     finaltest.exe \
+    forktest.exe \
     fotest.exe \
     gcbench.exe \
     landtest.exe \

mps/code/global.c

@@ -100,6 +100,16 @@ static void arenaDenounce(Arena arena)
 }
 
 
+
+/* GlobalsArenaRing -- return the global ring of arenas */
+
+Ring GlobalsArenaRing(void)
+{
+  AVER(arenaRingInit);
+  return &arenaRing;
+}
+
+
 /* GlobalsCheck -- check the arena globals */
 
 Bool GlobalsCheck(Globals arenaGlobals)

mps/code/mpm.h

@@ -492,6 +492,7 @@ extern Res GlobalsCompleteCreate(Globals arenaGlobals);
 extern void GlobalsPrepareToDestroy(Globals arenaGlobals);
 extern Res GlobalsDescribe(Globals arena, mps_lib_FILE *stream, Count depth);
 extern Ring GlobalsRememberedSummaryRing(Globals);
+extern Ring GlobalsArenaRing(void);
 
 #define ArenaGlobals(arena) (&(arena)->globals)
 #define GlobalsArena(glob) PARENT(ArenaStruct, globals, glob)

mps/code/protxc.c

@@ -342,6 +342,69 @@ extern void ProtThreadRegister(Bool setup)
 }
 
 
+/* atfork handlers -- support for fork()
+ *
+ * In order to support fork(), we need to solve the following problems:
+ *
+ * (1) the MPS lock might be held by another thread;
+ *
+ * (2.1) only the thread that called fork() exists in the child process;
+ *
+ * (2.2) in particular, the protection fault handling thread does not
+ * exist in the child process.
+ *
+ * (3) this thread has a new Mach port number in the child.
+ *
+ * TODO: what about protExcPort?
+ */
+
+static void prot_atfork_prepare(void)
+{
+  Ring node, nextNode;
+
+  /* Take all the locks, solving (1). */
+
+  /* For each arena, remember which thread is the current thread (if
+     any), solving (2.1). */
+  RING_FOR(node, GlobalsArenaRing(), nextNode) {
+    Globals arenaGlobals = RING_ELT(Globals, globalRing, node);
+    Arena arena = GlobalsArena(arenaGlobals);
+    ThreadRingForkPrepare(ArenaThreadRing(arena), ArenaDeadRing(arena));
+  }
+}
+
+static void prot_atfork_parent(void)
+{
+  Ring node, nextNode;
+  /* Release all the locks in reverse order. */
+
+  /* For each arena, mark threads as not forking any more. */
+  RING_FOR(node, GlobalsArenaRing(), nextNode) {
+    Globals arenaGlobals = RING_ELT(Globals, globalRing, node);
+    Arena arena = GlobalsArena(arenaGlobals);
+    ThreadRingForkParent(ArenaThreadRing(arena), ArenaDeadRing(arena));
+  }
+}
+
+static void prot_atfork_child(void)
+{
+  Ring node, nextNode;
+  /* For each arena, move all the threads to the dead ring, solving
+     (2.1), except for the thread that was marked as current by the
+     prepare handler, for which we update its mach port number,
+     solving (3). */
+  RING_FOR(node, GlobalsArenaRing(), nextNode) {
+    Globals arenaGlobals = RING_ELT(Globals, globalRing, node);
+    Arena arena = GlobalsArena(arenaGlobals);
+    ThreadRingForkChild(ArenaThreadRing(arena), ArenaDeadRing(arena));
+  }
+
+  /* Restart the protection fault handling thread, solving (2.2). */
+
+  /* Release all the locks in reverse order, solving (1). */
+}
+
+
 /* ProtSetup -- set up protection exception handling */
 
 static void protSetupInner(void)
@@ -383,6 +446,9 @@ static void protSetupInner(void)
   AVER(pr == 0);
   if (pr != 0)
     fprintf(stderr, "ERROR: MPS pthread_create: %d\n", pr); /* .trans.must */
+
+  /* Install fork handlers. */
+  pthread_atfork(prot_atfork_prepare, prot_atfork_parent, prot_atfork_child);
 }
 
 void ProtSetup(void)

mps/code/th.h

@@ -73,6 +73,13 @@ extern Res ThreadScan(ScanState ss, Thread thread, Word *stackCold,
                       void *closure);
 
 
+/* ThreadRingFork* -- atfork handlers for Unix */
+
+void ThreadRingForkPrepare(Ring threadRing, Ring deadRing);
+void ThreadRingForkParent(Ring threadRing, Ring deadRing);
+void ThreadRingForkChild(Ring threadRing, Ring deadRing);
+
+
 #endif /* th_h */
 
 

mps/code/thxc.c

@@ -37,6 +37,7 @@ typedef struct mps_thr_s {      /* OS X / Mach thread structure */
   Arena arena;                  /* owning arena */
   RingStruct arenaRing;         /* attaches to arena */
   Bool alive;                   /* thread believed to be alive? */
+  Bool forking;                 /* thread currently calling fork? */
   thread_port_t port;           /* thread kernel port */
 } ThreadStruct;
 
@@ -48,6 +49,7 @@ Bool ThreadCheck(Thread thread)
   CHECKL(thread->serial < thread->arena->threadSerial);
   CHECKD_NOSIG(Ring, &thread->arenaRing);
   CHECKL(BoolCheck(thread->alive));
+  CHECKL(BoolCheck(thread->forking));
   CHECKL(MACH_PORT_VALID(thread->port));
   return TRUE;
 }
@@ -80,6 +82,7 @@ Res ThreadRegister(Thread *threadReturn, Arena arena)
   thread->serial = arena->threadSerial;
   ++arena->threadSerial;
   thread->alive = TRUE;
+  thread->forking = FALSE;
   thread->port = mach_thread_self();
   thread->sig = ThreadSig;
   AVERT(Thread, thread);
@@ -99,6 +102,7 @@ void ThreadDeregister(Thread thread, Arena arena)
 {
   AVERT(Thread, thread);
   AVERT(Arena, arena);
+  AVER(!thread->forking);
 
   RingRemove(&thread->arenaRing);
 
@@ -157,6 +161,16 @@ static Bool threadSuspend(Thread thread)
   return kern_return == KERN_SUCCESS;
 }
 
+
+/* ThreadRingSuspend -- suspend all threads on a ring, except the
+ * current one.
+ */
+void ThreadRingSuspend(Ring threadRing, Ring deadRing)
+{
+  mapThreadRing(threadRing, deadRing, threadSuspend);
+}
+
+
 static Bool threadResume(Thread thread)
 {
   kern_return_t kern_return;
@@ -169,15 +183,6 @@ static Bool threadResume(Thread thread)
   return kern_return == KERN_SUCCESS;
 }
 
-
-/* ThreadRingSuspend -- suspend all threads on a ring, except the
- * current one.
- */
-void ThreadRingSuspend(Ring threadRing, Ring deadRing)
-{
-  mapThreadRing(threadRing, deadRing, threadSuspend);
-}
-
 /* ThreadRingResume -- resume all threads on a ring, except the
  * current one.
  */
@@ -186,6 +191,59 @@ void ThreadRingResume(Ring threadRing, Ring deadRing)
   mapThreadRing(threadRing, deadRing, threadResume);
 }
 
+
+static Bool threadForkPrepare(Thread thread)
+{
+  AVER(!thread->forking);
+  thread->forking = (thread->port == mach_thread_self());
+  return TRUE;
+}
+
+/* ThreadRingForkPrepare -- prepare for a fork by marking the current
+ * thread as forking.
+ */
+void ThreadRingForkPrepare(Ring threadRing, Ring deadRing)
+{
+  mapThreadRing(threadRing, deadRing, threadForkPrepare);
+}
+
+
+static Bool threadForkParent(Thread thread)
+{
+  thread->forking = FALSE;
+  return TRUE;
+}
+
+/* ThreadRingForkParent -- clear the forking flag in the parent after
+ * a fork.
+ */
+void ThreadRingForkParent(Ring threadRing, Ring deadRing)
+{
+  mapThreadRing(threadRing, deadRing, threadForkParent);
+}
+
+
+static Bool threadForkChild(Thread thread)
+{
+  if (thread->forking) {
+    thread->port = mach_thread_self();
+    AVER(MACH_PORT_VALID(thread->port));
+    thread->forking = FALSE;
+    return TRUE;
+  } else {
+    return FALSE;
+  }
+}
+
+/* ThreadRingForkChild -- update the mach thread port for the current
+ * thread; move all other threads to the dead ring.
+ */
+void ThreadRingForkChild(Ring threadRing, Ring deadRing)
+{
+  mapThreadRing(threadRing, deadRing, threadForkChild);
+}
+
+
 Thread ThreadRingThread(Ring threadRing)
 {
   Thread thread;

mps/tool/testcases.txt

@@ -20,6 +20,7 @@ exposet0       =P
 expt825
 finalcv        =P
 finaltest      =P
+forktest       =X
 fotest
 gcbench        =N                benchmark
 landtest