+ * Singleton fork(). Do not copy any running threads.
+ * ------------------------------------------------------------------------- */
+
+StgInt forkProcess(StgTSO* tso) {
+
+#ifndef mingw32_TARGET_OS
+ pid_t pid;
+ StgTSO* t,*next;
+
+ IF_DEBUG(scheduler,sched_belch("forking!"));
+
+ pid = fork();
+ if (pid) { /* parent */
+
+ /* just return the pid */
+
+ } else { /* child */
+ /* wipe all other threads */
+ run_queue_hd = tso;
+ tso->link = END_TSO_QUEUE;
+
+ /* DO NOT TOUCH THE QUEUES directly because most of the code around
+ us is picky about finding the threat still in its queue when
+ handling the deleteThread() */
+
+ for (t = all_threads; t != END_TSO_QUEUE; t = next) {
+ next = t->link;
+ if (t->id != tso->id) {
+ deleteThread(t);
+ }
+ }
+ }
+ return pid;
+#else /* mingw32 */
+ barf("forkProcess#: primop not implemented for mingw32, sorry!");
+ return -1;
+#endif /* mingw32 */
+}
+
+/* ---------------------------------------------------------------------------