UNREG: use __builtin___clear_cache where available
[ghc.git] / rts / Interpreter.c
index f88e474..1a883a5 100644 (file)
@@ -25,7 +25,7 @@
 #include "Threads.h"
 
 #include <string.h>     /* for memcpy */
-#ifdef HAVE_ERRNO_H
+#if defined(HAVE_ERRNO_H)
 #include <errno.h>
 #endif
 
@@ -83,7 +83,7 @@
 #define SAVE_STACK_POINTERS                     \
     cap->r.rCurrentTSO->stackobj->sp = Sp;
 
-#ifdef PROFILING
+#if defined(PROFILING)
 #define LOAD_THREAD_STATE()                     \
     LOAD_STACK_POINTERS                         \
     cap->r.rCCCS = cap->r.rCurrentTSO->prof.cccs;
@@ -92,7 +92,7 @@
     LOAD_STACK_POINTERS
 #endif
 
-#ifdef PROFILING
+#if defined(PROFILING)
 #define SAVE_THREAD_STATE()                     \
     SAVE_STACK_POINTERS                         \
     cap->r.rCurrentTSO->prof.cccs = cap->r.rCCCS;
    cap->r.rRet = (retcode);                     \
    return cap;
 
+// Note [avoiding threadPaused]
+//
+// Switching between the interpreter to compiled code can happen very
+// frequently, so we don't want to call threadPaused(), which is
+// expensive.  BUT we must be careful not to violate the invariant
+// that threadPaused() has been called on all threads before we GC
+// (see Note [upd-black-hole].  So the scheduler must ensure that when
+// we return in this way that we definitely immediately run the thread
+// again and don't GC or do something else.
+//
 #define RETURN_TO_SCHEDULER_NO_PAUSE(todo,retcode)      \
    SAVE_THREAD_STATE();                                 \
    cap->r.rCurrentTSO->what_next = (todo);              \
@@ -131,7 +141,7 @@ allocate_NONUPD (Capability *cap, int n_words)
 int rts_stop_next_breakpoint = 0;
 int rts_stop_on_exception = 0;
 
-#ifdef INTERP_STATS
+#if defined(INTERP_STATS)
 
 /* Hacky stats, for tuning the interpreter ... */
 int it_unknown_entries[N_CLOSURE_TYPES];
@@ -214,6 +224,48 @@ void interp_shutdown ( void )
 
 #endif
 
+#if defined(PROFILING)
+
+//
+// Build a zero-argument PAP with the current CCS
+// See Note [Evaluating functions with profiling] in Apply.cmm
+//
+STATIC_INLINE
+StgClosure * newEmptyPAP (Capability *cap,
+                          StgClosure *tagged_obj, // a FUN or a BCO
+                          uint32_t arity)
+{
+    StgPAP *pap = (StgPAP *)allocate(cap, sizeofW(StgPAP));
+    SET_HDR(pap, &stg_PAP_info, cap->r.rCCCS);
+    pap->arity = arity;
+    pap->n_args = 0;
+    pap->fun = tagged_obj;
+    return (StgClosure *)pap;
+}
+
+//
+// Make an exact copy of a PAP, except that we combine the current CCS with the
+// CCS in the PAP.  See Note [Evaluating functions with profiling] in Apply.cmm
+//
+STATIC_INLINE
+StgClosure * copyPAP  (Capability *cap, StgPAP *oldpap)
+{
+    uint32_t size = PAP_sizeW(oldpap->n_args);
+    StgPAP *pap = (StgPAP *)allocate(cap, size);
+    enterFunCCS(&cap->r, oldpap->header.prof.ccs);
+    SET_HDR(pap, &stg_PAP_info, cap->r.rCCCS);
+    pap->arity = oldpap->arity;
+    pap->n_args = oldpap->n_args;
+    pap->fun = oldpap->fun;
+    uint32_t i;
+    for (i = 0; i < ((StgPAP *)pap)->n_args; i++) {
+        pap->payload[i] = oldpap->payload[i];
+    }
+    return (StgClosure *)pap;
+}
+
+#endif
+
 static StgWord app_ptrs_itbl[] = {
     (W_)&stg_ap_p_info,
     (W_)&stg_ap_pp_info,
@@ -245,7 +297,7 @@ interpretBCO (Capability* cap)
              debugBelch(
              "\n---------------------------------------------------------------\n");
              debugBelch("Entering the interpreter, Sp = %p\n", Sp);
-#ifdef PROFILING
+#if defined(PROFILING)
              fprintCCS(stderr, cap->r.rCCCS);
              debugBelch("\n");
 #endif
@@ -314,7 +366,7 @@ eval_obj:
              "\n---------------------------------------------------------------\n");
              debugBelch("Evaluating: "); printObj(obj);
              debugBelch("Sp = %p\n", Sp);
-#ifdef PROFILING
+#if defined(PROFILING)
              fprintCCS(stderr, cap->r.rCCCS);
              debugBelch("\n");
 #endif
@@ -342,8 +394,9 @@ eval_obj:
     case CONSTR_2_0:
     case CONSTR_1_1:
     case CONSTR_0_2:
-    case CONSTR_STATIC:
-    case CONSTR_NOCAF_STATIC:
+    case CONSTR_NOCAF:
+        break;
+
     case FUN:
     case FUN_1_0:
     case FUN_0_1:
@@ -351,15 +404,30 @@ eval_obj:
     case FUN_1_1:
     case FUN_0_2:
     case FUN_STATIC:
+#if defined(PROFILING)
+        if (cap->r.rCCCS != obj->header.prof.ccs) {
+            tagged_obj =
+                newEmptyPAP(cap, tagged_obj, get_fun_itbl(obj)->f.arity);
+        }
+#endif
+        break;
+
     case PAP:
-        // already in WHNF
+#if defined(PROFILING)
+        if (cap->r.rCCCS != obj->header.prof.ccs) {
+            tagged_obj = copyPAP(cap, (StgPAP *)obj);
+        }
+#endif
         break;
 
     case BCO:
-    {
         ASSERT(((StgBCO *)obj)->arity > 0);
+#if defined(PROFILING)
+        if (cap->r.rCCCS != obj->header.prof.ccs) {
+            tagged_obj = newEmptyPAP(cap, tagged_obj, ((StgBCO *)obj)->arity);
+        }
+#endif
         break;
-    }
 
     case AP:    /* Copied from stg_AP_entry. */
     {
@@ -377,11 +445,11 @@ eval_obj:
             RETURN_TO_SCHEDULER(ThreadInterpret, StackOverflow);
         }
 
-#ifdef PROFILING
+#if defined(PROFILING)
         // restore the CCCS after evaluating the AP
         Sp -= 2;
         Sp[1] = (W_)cap->r.rCCCS;
-        Sp[0] = (W_)&stg_restore_cccs_info;
+        Sp[0] = (W_)&stg_restore_cccs_eval_info;
 #endif
 
         Sp -= sizeofW(StgUpdateFrame);
@@ -406,7 +474,7 @@ eval_obj:
     }
 
     default:
-#ifdef INTERP_STATS
+#if defined(INTERP_STATS)
     {
         int j;
 
@@ -422,11 +490,11 @@ eval_obj:
                  debugBelch("evaluating unknown closure -- yielding to sched\n");
                  printObj(obj);
             );
-#ifdef PROFILING
+#if defined(PROFILING)
         // restore the CCCS after evaluating the closure
         Sp -= 2;
         Sp[1] = (W_)cap->r.rCCCS;
-        Sp[0] = (W_)&stg_restore_cccs_info;
+        Sp[0] = (W_)&stg_restore_cccs_eval_info;
 #endif
         Sp -= 2;
         Sp[1] = (W_)tagged_obj;
@@ -447,7 +515,7 @@ do_return:
              "\n---------------------------------------------------------------\n");
              debugBelch("Returning: "); printObj(obj);
              debugBelch("Sp = %p\n", Sp);
-#ifdef PROFILING
+#if defined(PROFILING)
              fprintCCS(stderr, cap->r.rCCCS);
              debugBelch("\n");
 #endif
@@ -466,7 +534,8 @@ do_return:
         // NOTE: not using get_itbl().
         info = ((StgClosure *)Sp)->header.info;
 
-        if (info == (StgInfoTable *)&stg_restore_cccs_info) {
+        if (info == (StgInfoTable *)&stg_restore_cccs_info ||
+            info == (StgInfoTable *)&stg_restore_cccs_eval_info) {
             cap->r.rCCCS = (CostCentreStack*)Sp[1];
             Sp += 2;
             goto do_return;
@@ -593,7 +662,7 @@ do_return_unboxed:
              "\n---------------------------------------------------------------\n");
              debugBelch("Returning: "); printObj(obj);
              debugBelch("Sp = %p\n", Sp);
-#ifdef PROFILING
+#if defined(PROFILING)
              fprintCCS(stderr, cap->r.rCCCS);
              debugBelch("\n");
 #endif
@@ -685,7 +754,7 @@ do_apply:
                 }
                 obj = UNTAG_CLOSURE(pap->fun);
 
-#ifdef PROFILING
+#if defined(PROFILING)
                 enterFunCCS(&cap->r, pap->header.prof.ccs);
 #endif
                 goto run_BCO_fun;
@@ -696,7 +765,7 @@ do_apply:
                     Sp[i] = (W_)pap->payload[i];
                 }
                 obj = UNTAG_CLOSURE(pap->fun);
-#ifdef PROFILING
+#if defined(PROFILING)
                 enterFunCCS(&cap->r, pap->header.prof.ccs);
 #endif
                 goto run_BCO_fun;
@@ -877,13 +946,13 @@ run_BCO:
         register StgWord16* instrs    = (StgWord16*)(bco->instrs->payload);
         register StgWord*  literals   = (StgWord*)(&bco->literals->payload[0]);
         register StgPtr*   ptrs       = (StgPtr*)(&bco->ptrs->payload[0]);
-#ifdef DEBUG
+#if defined(DEBUG)
         int bcoSize;
         bcoSize = bco->instrs->bytes / sizeof(StgWord16);
 #endif
         IF_DEBUG(interpreter,debugBelch("bcoSize = %d\n", bcoSize));
 
-#ifdef INTERP_STATS
+#if defined(INTERP_STATS)
         it_lastopc = 0; /* no opcode */
 #endif
 
@@ -910,7 +979,7 @@ run_BCO:
 
         INTERP_TICK(it_insns);
 
-#ifdef INTERP_STATS
+#if defined(INTERP_STATS)
         ASSERT( (int)instrs[bciPtr] >= 0 && (int)instrs[bciPtr] < 27 );
         it_ofreq[ (int)instrs[bciPtr] ] ++;
         it_oofreq[ it_lastopc ][ (int)instrs[bciPtr] ] ++;
@@ -928,7 +997,7 @@ run_BCO:
         case bci_BRK_FUN:
         {
             int arg1_brk_array, arg2_array_index, arg3_module_uniq;
-#ifdef PROFILING
+#if defined(PROFILING)
             int arg4_cc;
 #endif
             StgArrBytes *breakPoints;
@@ -946,7 +1015,7 @@ run_BCO:
             arg1_brk_array      = BCO_GET_LARGE_ARG;
             arg2_array_index    = BCO_NEXT;
             arg3_module_uniq    = BCO_GET_LARGE_ARG;
-#ifdef PROFILING
+#if defined(PROFILING)
             arg4_cc             = BCO_GET_LARGE_ARG;
 #else
             BCO_GET_LARGE_ARG;
@@ -958,7 +1027,7 @@ run_BCO:
             returning_from_break =
                 cap->r.rCurrentTSO->flags & TSO_STOPPED_ON_BREAKPOINT;
 
-#ifdef PROFILING
+#if defined(PROFILING)
             cap->r.rCCCS = pushCostCentre(cap->r.rCCCS,
                                           (CostCentre*)BCO_LIT(arg4_cc));
 #endif
@@ -973,13 +1042,13 @@ run_BCO:
                // "rts_stop_next_breakpoint" flag is true OR if the
                // breakpoint flag for this particular expression is
                // true
-               if (rts_stop_next_breakpoint == rtsTrue ||
+               if (rts_stop_next_breakpoint == true ||
                    ((StgWord8*)breakPoints->payload)[arg2_array_index]
-                     == rtsTrue)
+                     == true)
                {
                   // make sure we don't automatically stop at the
                   // next breakpoint
-                  rts_stop_next_breakpoint = rtsFalse;
+                  rts_stop_next_breakpoint = false;
 
                   // allocate memory for a new AP_STACK, enough to
                   // store the top stack frame plus an
@@ -1099,7 +1168,7 @@ run_BCO:
             Sp -= 2;
             Sp[1] = BCO_PTR(o_bco);
             Sp[0] = (W_)&stg_ctoi_R1p_info;
-#ifdef PROFILING
+#if defined(PROFILING)
             Sp -= 2;
             Sp[1] = (W_)cap->r.rCCCS;
             Sp[0] = (W_)&stg_restore_cccs_info;
@@ -1112,7 +1181,7 @@ run_BCO:
             Sp[-2] = (W_)&stg_ctoi_R1unpt_info;
             Sp[-1] = BCO_PTR(o_bco);
             Sp -= 2;
-#ifdef PROFILING
+#if defined(PROFILING)
             Sp -= 2;
             Sp[1] = (W_)cap->r.rCCCS;
             Sp[0] = (W_)&stg_restore_cccs_info;
@@ -1125,7 +1194,7 @@ run_BCO:
             Sp[-2] = (W_)&stg_ctoi_R1n_info;
             Sp[-1] = BCO_PTR(o_bco);
             Sp -= 2;
-#ifdef PROFILING
+#if defined(PROFILING)
             Sp -= 2;
             Sp[1] = (W_)cap->r.rCCCS;
             Sp[0] = (W_)&stg_restore_cccs_info;
@@ -1138,7 +1207,7 @@ run_BCO:
             Sp[-2] = (W_)&stg_ctoi_F1_info;
             Sp[-1] = BCO_PTR(o_bco);
             Sp -= 2;
-#ifdef PROFILING
+#if defined(PROFILING)
             Sp -= 2;
             Sp[1] = (W_)cap->r.rCCCS;
             Sp[0] = (W_)&stg_restore_cccs_info;
@@ -1151,7 +1220,7 @@ run_BCO:
             Sp[-2] = (W_)&stg_ctoi_D1_info;
             Sp[-1] = BCO_PTR(o_bco);
             Sp -= 2;
-#ifdef PROFILING
+#if defined(PROFILING)
             Sp -= 2;
             Sp[1] = (W_)cap->r.rCCCS;
             Sp[0] = (W_)&stg_restore_cccs_info;
@@ -1164,7 +1233,7 @@ run_BCO:
             Sp[-2] = (W_)&stg_ctoi_L1_info;
             Sp[-1] = BCO_PTR(o_bco);
             Sp -= 2;
-#ifdef PROFILING
+#if defined(PROFILING)
             Sp -= 2;
             Sp[1] = (W_)cap->r.rCCCS;
             Sp[0] = (W_)&stg_restore_cccs_info;
@@ -1177,7 +1246,7 @@ run_BCO:
             Sp[-2] = (W_)&stg_ctoi_V_info;
             Sp[-1] = BCO_PTR(o_bco);
             Sp -= 2;
-#ifdef PROFILING
+#if defined(PROFILING)
             Sp -= 2;
             Sp[1] = (W_)cap->r.rCCCS;
             Sp[0] = (W_)&stg_restore_cccs_info;
@@ -1310,7 +1379,7 @@ run_BCO:
 
             // The function should be a BCO
             if (get_itbl(pap->fun)->type != BCO) {
-#ifdef DEBUG
+#if defined(DEBUG)
                 printClosure(pap->fun);
 #endif
                 barf("bci_MKPAP");
@@ -1618,7 +1687,7 @@ run_BCO:
             Sp[0] = (W_)&stg_ret_p_info;
 
             SAVE_THREAD_STATE();
-            tok = suspendThread(&cap->r, interruptible ? rtsTrue : rtsFalse);
+            tok = suspendThread(&cap->r, interruptible);
 
             // We already made a copy of the arguments above.
             ffi_call(cif, fn, ret, argptrs);