Add warning comment about Mach-O section name hack.
[ghc.git] / rts / RtsAPI.c
index 0463f15..720b732 100644 (file)
@@ -380,7 +380,7 @@ INLINE_HEADER void pushClosure   (StgTSO *tso, StgWord c) {
 }
 
 StgTSO *
-createGenThread (Capability *cap, nat stack_size,  StgClosure *closure)
+createGenThread (Capability *cap, W_ stack_size,  StgClosure *closure)
 {
   StgTSO *t;
   t = createThread (cap, stack_size);
@@ -390,7 +390,7 @@ createGenThread (Capability *cap, nat stack_size,  StgClosure *closure)
 }
 
 StgTSO *
-createIOThread (Capability *cap, nat stack_size,  StgClosure *closure)
+createIOThread (Capability *cap, W_ stack_size,  StgClosure *closure)
 {
   StgTSO *t;
   t = createThread (cap, stack_size);
@@ -406,7 +406,7 @@ createIOThread (Capability *cap, nat stack_size,  StgClosure *closure)
  */
 
 StgTSO *
-createStrictIOThread(Capability *cap, nat stack_size,  StgClosure *closure)
+createStrictIOThread(Capability *cap, W_ stack_size,  StgClosure *closure)
 {
   StgTSO *t;
   t = createThread(cap, stack_size);
@@ -522,7 +522,16 @@ rts_checkSchedStatus (char* site, Capability *cap)
        stg_exit(EXIT_FAILURE);
     case Interrupted:
        errorBelch("%s: interrupted", site);
-       stg_exit(EXIT_FAILURE);
+#ifdef THREADED_RTS
+        // The RTS is shutting down, and the process will probably
+        // soon exit.  We don't want to preempt the shutdown
+        // by exiting the whole process here, so we just terminate the
+        // current thread.  Don't forget to release the cap first though.
+        rts_unlock(cap);
+        shutdownThread();
+#else
+        stg_exit(EXIT_FAILURE);
+#endif
     default:
        errorBelch("%s: Return code (%d) not ok",(site),(rc));  
        stg_exit(EXIT_FAILURE);
@@ -553,6 +562,14 @@ rts_lock (void)
 
     cap = NULL;
     waitForReturnCapability(&cap, task);
+
+    if (task->incall->prev_stack == NULL) {
+      // This is a new outermost call from C into Haskell land.
+      // Until the corresponding call to rts_unlock, this task
+      // is doing work on behalf of the RTS.
+      traceTaskCreate(task, cap);
+    }
+
     return (Capability *)cap;
 }
 
@@ -586,4 +603,11 @@ rts_unlock (Capability *cap)
     // Finally, we can release the Task to the free list.
     boundTaskExiting(task);
     RELEASE_LOCK(&cap->lock);
+
+    if (task->incall == NULL) {
+      // This is the end of an outermost call from C into Haskell land.
+      // From here on, the task goes back to C land and we should not count
+      // it as doing work on behalf of the RTS.
+      traceTaskDelete(task);
+    }
 }