Add a new primitive forkOn#, for forking a thread on a specific Capability

[ghc-hetmet.git] / ghc / includes / Cmm.h

diff --git a/ghc/includes/Cmm.h b/ghc/includes/Cmm.h
index 21c8257..783b0e4 100644 (file)
--- a/ghc/includes/Cmm.h
+++ b/ghc/includes/Cmm.h
@@ -232,9 +232,11 @@
 
 #define ENTER()                                                \
  again:                                                        \
+  W_ info;                                             \
+  info = %INFO_PTR(R1);                                        \
   switch [INVALID_OBJECT .. N_CLOSURE_TYPES]           \
-         (TO_W_( %INFO_TYPE(%GET_STD_INFO(R1)) )) {    \
-  case                                                         \
+         (TO_W_( %INFO_TYPE(%STD_INFO(info)) )) {      \
+  case                                                 \
     IND,                                               \
     IND_OLDGEN,                                                \
     IND_PERM,                                          \
@@ -244,7 +246,7 @@
       R1 = StgInd_indirectee(R1);                      \
       goto again;                                      \
    }                                                   \
-  case                                                         \
+  case                                                 \
     BCO,                                               \
     FUN,                                               \
     FUN_1_0,                                           \
@@ -259,7 +261,7 @@
    }                                                   \
   default:                                             \
    {                                                   \
-      jump %GET_ENTRY(R1);                             \
+      jump %ENTRY_CODE(info);                          \
    }                                                   \
   }
 
@@ -292,6 +294,8 @@
 #error mp_limb_t != StgWord: assumptions in PrimOps.cmm are now false
 #endif
 
+#define MyCapability()  (BaseReg - OFFSET_Capability_r)
+
 /* -------------------------------------------------------------------------
    Allocation and garbage collection
    ------------------------------------------------------------------------- */
@@ -317,14 +321,33 @@
    HP_CHK_GEN(alloc,liveness,reentry);                 \
    TICK_ALLOC_HEAP_NOCTR(alloc);
 
+// allocateLocal() allocates from the nursery, so we check to see
+// whether the nursery is nearly empty in any function that uses
+// allocateLocal() - this includes many of the primops.
 #define MAYBE_GC(liveness,reentry)                     \
-   if (W_[alloc_blocks] >= W_[alloc_blocks_lim]) {     \
+  if (bdescr_link(CurrentNursery) == NULL || CInt[alloc_blocks] >= CInt[alloc_blocks_lim]) {           \
        R9  = liveness;                                 \
         R10 = reentry;                                 \
         jump stg_gc_gen_hp;                            \
    }
 
 /* -----------------------------------------------------------------------------
+   Closure headers
+   -------------------------------------------------------------------------- */
+
+/*
+ * This is really ugly, since we don't do the rest of StgHeader this
+ * way.  The problem is that values from DerivedConstants.h cannot be 
+ * dependent on the way (SMP, PROF etc.).  For SIZEOF_StgHeader we get
+ * the value from GHC, but it seems like too much trouble to do that
+ * for StgThunkHeader.
+ */
+#define SIZEOF_StgThunkHeader SIZEOF_StgHeader+SIZEOF_StgSMPThunkHeader
+
+#define StgThunk_payload(__ptr__,__ix__) \
+    W_[__ptr__+SIZEOF_StgThunkHeader+ WDS(__ix__)]
+
+/* -----------------------------------------------------------------------------
    Closures
    -------------------------------------------------------------------------- */
 
@@ -363,8 +386,8 @@
  */
         
 #define StgFunInfoExtra_slow_apply(fun_info)    \
-        (StgFunInfoExtraRev_slow_apply_offset(fun_info)    \
-        + (fun_info) + SIZEOF_StgFunInfoExtraRev + SIZEOF_StgInfoTable)
+        (TO_W_(StgFunInfoExtraRev_slow_apply_offset(fun_info))    \
+               + (fun_info) + SIZEOF_StgFunInfoExtraRev + SIZEOF_StgInfoTable)
 
 #define StgFunInfoExtra_fun_type(i)   StgFunInfoExtraRev_fun_type(i)
 #define StgFunInfoExtra_arity(i)      StgFunInfoExtraRev_arity(i)
@@ -485,4 +508,10 @@
     TICK_BUMP(ALLOC_HEAP_ctr);                 \
     TICK_BUMP_BY(ALLOC_HEAP_tot,n)
 
+/* -----------------------------------------------------------------------------
+   Misc junk
+   -------------------------------------------------------------------------- */
+
+#define TICK_MILLISECS   (1000/TICK_FREQUENCY)   /* ms per tick */
+
 #endif /* CMM_H */