Enable two-step allocator on FreeBSD
[ghc.git] / rts / Threads.c
index 1782da6..78c5b6c 100644 (file)
@@ -112,7 +112,7 @@ createThread(Capability *cap, W_ size)
 
     tso->trec = NO_TREC;
 
-#ifdef PROFILING
+#if defined(PROFILING)
     tso->prof.cccs = CCS_MAIN;
 #endif
 
@@ -165,19 +165,8 @@ rts_getThreadId(StgPtr tso)
 }
 
 /* ---------------------------------------------------------------------------
- * Getting & setting the thread allocation limit
+ * Enabling and disabling the thread allocation limit
  * ------------------------------------------------------------------------ */
-HsInt64 rts_getThreadAllocationCounter(StgPtr tso)
-{
-    // NB. doesn't take into account allocation in the current nursery
-    // block, so it might be off by up to 4k.
-    return PK_Int64((W_*)&(((StgTSO *)tso)->alloc_limit));
-}
-
-void rts_setThreadAllocationCounter(StgPtr tso, HsInt64 i)
-{
-    ASSIGN_Int64((W_*)&(((StgTSO *)tso)->alloc_limit), i);
-}
 
 void rts_enableThreadAllocationLimit(StgPtr tso)
 {
@@ -194,7 +183,7 @@ void rts_disableThreadAllocationLimit(StgPtr tso)
    Fails fatally if the TSO is not on the queue.
    -------------------------------------------------------------------------- */
 
-rtsBool // returns True if we modified queue
+bool // returns true if we modified queue
 removeThreadFromQueue (Capability *cap, StgTSO **queue, StgTSO *tso)
 {
     StgTSO *t, *prev;
@@ -205,33 +194,33 @@ removeThreadFromQueue (Capability *cap, StgTSO **queue, StgTSO *tso)
             if (prev) {
                 setTSOLink(cap,prev,t->_link);
                 t->_link = END_TSO_QUEUE;
-                return rtsFalse;
+                return false;
             } else {
                 *queue = t->_link;
                 t->_link = END_TSO_QUEUE;
-                return rtsTrue;
+                return true;
             }
         }
     }
     barf("removeThreadFromQueue: not found");
 }
 
-rtsBool // returns True if we modified head or tail
+bool // returns true if we modified head or tail
 removeThreadFromDeQueue (Capability *cap,
                          StgTSO **head, StgTSO **tail, StgTSO *tso)
 {
     StgTSO *t, *prev;
-    rtsBool flag = rtsFalse;
+    bool flag = false;
 
     prev = NULL;
     for (t = *head; t != END_TSO_QUEUE; prev = t, t = t->_link) {
         if (t == tso) {
             if (prev) {
                 setTSOLink(cap,prev,t->_link);
-                flag = rtsFalse;
+                flag = false;
             } else {
                 *head = t->_link;
-                flag = rtsTrue;
+                flag = true;
             }
             t->_link = END_TSO_QUEUE;
             if (*tail == tso) {
@@ -240,7 +229,7 @@ removeThreadFromDeQueue (Capability *cap,
                 } else {
                     *tail = END_TSO_QUEUE;
                 }
-                return rtsTrue;
+                return true;
             } else {
                 return flag;
             }
@@ -263,7 +252,7 @@ tryWakeupThread (Capability *cap, StgTSO *tso)
 {
     traceEventThreadWakeup (cap, tso, tso->cap->no);
 
-#ifdef THREADED_RTS
+#if defined(THREADED_RTS)
     if (tso->cap != cap)
     {
         MessageWakeup *msg;
@@ -308,8 +297,11 @@ tryWakeupThread (Capability *cap, StgTSO *tso)
         goto unblock;
     }
 
-    case BlockedOnBlackHole:
     case BlockedOnSTM:
+        tso->block_info.closure = &stg_STM_AWOKEN_closure;
+        goto unblock;
+
+    case BlockedOnBlackHole:
     case ThreadMigrating:
         goto unblock;
 
@@ -446,7 +438,7 @@ updateThunk (Capability *cap, StgTSO *tso, StgClosure *thunk, StgClosure *val)
         return;
     }
 
-    v = ((StgInd*)thunk)->indirectee;
+    v = UNTAG_CLOSURE(((StgInd*)thunk)->indirectee);
 
     updateWithIndirection(cap, thunk, val);
 
@@ -503,7 +495,7 @@ isThreadBound(StgTSO* tso USED_IF_THREADS)
 #if defined(THREADED_RTS)
   return (tso->bound != NULL);
 #endif
-  return rtsFalse;
+  return false;
 }
 
 /* -----------------------------------------------------------------------------
@@ -640,8 +632,8 @@ threadStackOverflow (Capability *cap, StgTSO *tso)
             // if including this frame would exceed the size of the
             // new stack (taking into account the underflow frame),
             // then stop at the previous frame.
-            if (sp + size > old_stack->stack + (new_stack->stack_size -
-                                                sizeofW(StgUnderflowFrame))) {
+            if (sp + size > old_stack->sp + (new_stack->stack_size -
+                                             sizeofW(StgUnderflowFrame))) {
                 break;
             }
             sp += size;
@@ -749,7 +741,7 @@ threadStackUnderflow (Capability *cap, StgTSO *tso)
    NOTE: this should be kept in sync with stg_tryPutMVarzh in PrimOps.cmm
    ------------------------------------------------------------------------- */
 
-rtsBool performTryPutMVar(Capability *cap, StgMVar *mvar, StgClosure *value)
+bool performTryPutMVar(Capability *cap, StgMVar *mvar, StgClosure *value)
 {
     const StgInfoTable *info;
     StgMVarTSOQueue *q;
@@ -761,7 +753,7 @@ rtsBool performTryPutMVar(Capability *cap, StgMVar *mvar, StgClosure *value)
 #if defined(THREADED_RTS)
         unlockClosure((StgClosure*)mvar, info);
 #endif
-        return rtsFalse;
+        return false;
     }
 
     q = mvar->head;
@@ -774,7 +766,7 @@ loop:
 
         mvar->value = value;
         unlockClosure((StgClosure*)mvar, &stg_MVAR_DIRTY_info);
-        return rtsTrue;
+        return true;
     }
     if (q->header.info == &stg_IND_info ||
         q->header.info == &stg_MSG_NULL_info) {
@@ -808,7 +800,7 @@ loop:
 
     tryWakeupThread(cap, tso);
 
-    // If it was an readMVar, then we can still do work,
+    // If it was a readMVar, then we can still do work,
     // so loop back. (XXX: This could take a while)
     if (why_blocked == BlockedOnMVarRead) {
         q = ((StgMVarTSOQueue*)q)->link;
@@ -819,14 +811,14 @@ loop:
 
     unlockClosure((StgClosure*)mvar, info);
 
-    return rtsTrue;
+    return true;
 }
 
 /* ----------------------------------------------------------------------------
  * Debugging: why is a thread blocked
  * ------------------------------------------------------------------------- */
 
-#if DEBUG
+#if defined(DEBUG)
 void
 printThreadBlockage(StgTSO *tso)
 {
@@ -876,7 +868,7 @@ printThreadBlockage(StgTSO *tso)
     debugBelch("is blocked on an STM operation");
     break;
   default:
-    barf("printThreadBlockage: strange tso->why_blocked: %d for TSO %d (%d)",
+    barf("printThreadBlockage: strange tso->why_blocked: %d for TSO %d (%p)",
          tso->why_blocked, tso->id, tso);
   }
 }