[project @ 2000-02-23 19:41:50 by lewie]

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

diff --git a/ghc/includes/PrimOps.h b/ghc/includes/PrimOps.h
index 464e9d7..4a0f952 100644 (file)
--- a/ghc/includes/PrimOps.h
+++ b/ghc/includes/PrimOps.h
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: PrimOps.h,v 1.42 2000/01/07 10:27:33 sewardj Exp $
+ * $Id: PrimOps.h,v 1.45 2000/01/18 12:37:33 simonmar Exp $
  *
  * (c) The GHC Team, 1998-1999
  *
@@ -734,7 +734,88 @@ EF_(unblockAsyncExceptionszh_fast);
 
 extern int cmp_thread(const StgTSO *tso1, const StgTSO *tso2);
 
-/* Hmm, I'll think about these later. */
+/* ------------------------------------------------------------------------
+   Parallel PrimOps
+
+   A par in the Haskell code is ultimately translated to a parzh macro
+   (with a case wrapped around it to guarantee that the macro is actually 
+    executed; see compiler/prelude/PrimOps.lhs)
+   ---------------------------------------------------------------------- */
+
+#if defined(GRAN)
+// hash coding changed from 2.10 to 4.00
+#define parzh(r,node)             parZh(r,node)
+
+#define parZh(r,node)                          \
+       PARZh(r,node,1,0,0,0,0,0)
+
+#define parAtzh(r,node,where,identifier,gran_info,size_info,par_info,rest) \
+       parATZh(r,node,where,identifier,gran_info,size_info,par_info,rest,1)
+
+#define parAtAbszh(r,node,proc,identifier,gran_info,size_info,par_info,rest) \
+       parATZh(r,node,proc,identifier,gran_info,size_info,par_info,rest,2)
+
+#define parAtRelzh(r,node,proc,identifier,gran_info,size_info,par_info,rest) \
+       parATZh(r,node,proc,identifier,gran_info,size_info,par_info,rest,3)
+
+#define parAtForNowzh(r,node,where,identifier,gran_info,size_info,par_info,rest)       \
+       parATZh(r,node,where,identifier,gran_info,size_info,par_info,rest,0)
+
+#define parATZh(r,node,where,identifier,gran_info,size_info,par_info,rest,local)       \
+{                                                      \
+  rtsSparkQ result;                                            \
+  if (closure_SHOULD_SPARK((StgClosure*)node)) {                               \
+    rtsSparkQ result;                                          \
+    STGCALL6(newSpark, node,identifier,gran_info,size_info,par_info,local);    \
+    if (local==2) {         /* special case for parAtAbs */   \
+      STGCALL3(GranSimSparkAtAbs, result,(I_)where,identifier);\
+    } else if (local==3) {  /* special case for parAtRel */   \
+      STGCALL3(GranSimSparkAtAbs, result,(I_)(CurrentProc+where),identifier);  \
+    } else {       \
+      STGCALL3(GranSimSparkAt, result,where,identifier);       \
+    }        \
+  }                                                     \
+}
+
+#define parLocalzh(r,node,identifier,gran_info,size_info,par_info,rest)        \
+       PARZh(r,node,rest,identifier,gran_info,size_info,par_info,1)
+
+#define parGlobalzh(r,node,identifier,gran_info,size_info,par_info,rest) \
+       PARZh(r,node,rest,identifier,gran_info,size_info,par_info,0)
+
+#define PARZh(r,node,rest,identifier,gran_info,size_info,par_info,local) \
+{                                                                        \
+  if (closure_SHOULD_SPARK((StgClosure*)node)) {                         \
+    rtsSpark *result;                                                   \
+    result = RET_STGCALL6(rtsSpark*, newSpark,                           \
+                          node,identifier,gran_info,size_info,par_info,local);\
+    STGCALL1(add_to_spark_queue,result);                               \
+    STGCALL2(GranSimSpark, local,(P_)node);                            \
+  }                                                                    \
+}
+
+#define copyablezh(r,node)                             \
+  /* copyable not yet implemented!! */
+
+#define noFollowzh(r,node)                             \
+  /* noFollow not yet implemented!! */
+
+#endif  /* GRAN */
+
+#if defined(SMP) || defined(PAR)
+#define parzh(r,node)                                  \
+{                                                      \
+  extern unsigned int context_switch;                  \
+  if (closure_SHOULD_SPARK((StgClosure *)node) &&      \
+      SparkTl < SparkLim) {                            \
+    *SparkTl++ = (StgClosure *)(node);                 \
+  }                                                    \
+  r = context_switch = 1;                              \
+}
+#else
+#define parzh(r,node) r = 1
+#endif
+
 /* -----------------------------------------------------------------------------
    Pointer equality
    -------------------------------------------------------------------------- */