Simplify type of ms_srcimps and ms_textual_imps.
[ghc.git] / rts / RtsAPI.c
index ec19b16..2b3ad74 100644 (file)
@@ -198,7 +198,10 @@ rts_apply (Capability *cap, HaskellObj f, HaskellObj arg)
     StgThunk *ap;
 
     ap = (StgThunk *)allocate(cap,sizeofW(StgThunk) + 2);
-    SET_HDR(ap, (StgInfoTable *)&stg_ap_2_upd_info, CCS_SYSTEM);
+    // Here we don't want to use CCS_SYSTEM, because it's a hidden cost centre,
+    // and evaluating Haskell code under a hidden cost centre leads to
+    // confusing profiling output. (#7753)
+    SET_HDR(ap, (StgInfoTable *)&stg_ap_2_upd_info, CCS_MAIN);
     ap->payload[0] = f;
     ap->payload[1] = arg;
     return (StgClosure *)ap;
@@ -364,9 +367,9 @@ rts_getBool (HaskellObj p)
 
     info = get_itbl((StgClosure *)UNTAG_CLOSURE(p));
     if (info->srt_bitmap == 0) { // srt_bitmap is the constructor tag
-       return 0;
+        return 0;
     } else {
-       return 1;
+        return 1;
     }
 }
 
@@ -426,7 +429,7 @@ void rts_eval (/* inout */ Capability **cap,
                /* out */   HaskellObj *ret)
 {
     StgTSO *tso;
-    
+
     tso = createGenThread(*cap, RtsFlags.GcFlags.initialStkSize, p);
     scheduleWaitThread(tso,ret,cap);
 }
@@ -450,8 +453,8 @@ void rts_evalIO (/* inout */ Capability **cap,
                  /* in    */ HaskellObj p,
                  /* out */   HaskellObj *ret)
 {
-    StgTSO* tso; 
-    
+    StgTSO* tso;
+
     tso = createStrictIOThread(*cap, RtsFlags.GcFlags.initialStkSize, p);
     scheduleWaitThread(tso,ret,cap);
 }
@@ -479,8 +482,8 @@ void rts_evalStableIO (/* inout */ Capability **cap,
     stat = rts_getSchedStatus(*cap);
 
     if (stat == Success && ret != NULL) {
-       ASSERT(r != NULL);
-       *ret = getStablePtr((StgPtr)r);
+        ASSERT(r != NULL);
+        *ret = getStablePtr((StgPtr)r);
     }
 }
 
@@ -516,16 +519,25 @@ rts_checkSchedStatus (char* site, Capability *cap)
     SchedulerStatus rc = cap->running_task->incall->stat;
     switch (rc) {
     case Success:
-       return;
+        return;
     case Killed:
-       errorBelch("%s: uncaught exception",site);
-       stg_exit(EXIT_FAILURE);
+        errorBelch("%s: uncaught exception",site);
+        stg_exit(EXIT_FAILURE);
     case Interrupted:
-       errorBelch("%s: interrupted", site);
-       stg_exit(EXIT_FAILURE);
+        errorBelch("%s: interrupted", site);
+#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);
+        errorBelch("%s: Return code (%d) not ok",(site),(rc));
+        stg_exit(EXIT_FAILURE);
     }
 }
 
@@ -552,7 +564,7 @@ rts_lock (void)
     }
 
     cap = NULL;
-    waitForReturnCapability(&cap, task);
+    waitForCapability(&cap, task);
 
     if (task->incall->prev_stack == NULL) {
       // This is a new outermost call from C into Haskell land.
@@ -602,3 +614,9 @@ rts_unlock (Capability *cap)
       traceTaskDelete(task);
     }
 }
+
+void rts_done (void)
+{
+    freeMyTask();
+}
+