X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Frts%2FPrimOps.hc;h=134ed1bc0d83c08a89355df53ead97e1b700d95f;hb=5cb4bb13a817c44cdc4369c7f82949d9490d69a0;hp=168d968e38cb6afbd7f2ccdc64d95f77ef7f93b6;hpb=91af47d422942336b6e9f93d1250e6385e252a95;p=ghc-hetmet.git

diff --git a/ghc/rts/PrimOps.hc b/ghc/rts/PrimOps.hc
index 168d968..134ed1b 100644
--- a/ghc/rts/PrimOps.hc
+++ b/ghc/rts/PrimOps.hc
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: PrimOps.hc,v 1.107 2003/04/15 14:37:12 simonmar Exp $
+ * $Id: PrimOps.hc,v 1.116 2004/01/08 15:26:44 simonmar Exp $
  *
  * (c) The GHC Team, 1998-2002
  *
@@ -188,7 +188,7 @@ StgWord GHC_ZCCReturnable_static_info[1];
 #define PUSHED(m)   Sp -= (m); JMP_(ENTRY_CODE(Sp[m]));
 
 # define RET_P(a)     PUSH(1,a); PUSHED(1)
-# define RET_N(a)     PUSH(1,a); PUSHED(2)
+# define RET_N(a)     PUSH(1,a); PUSHED(1)
 
 # define RET_PP(a,b)   PUSH(2,a); PUSH(1,b); PUSHED(2)
 # define RET_NN(a,b)   PUSH(2,a); PUSH(1,b); PUSHED(2)
@@ -402,7 +402,22 @@ FN_(unsafeThawArrayzh_fast)
 {
   FB_
   SET_INFO((StgClosure *)R1.cl,&stg_MUT_ARR_PTRS_info);
-  recordMutable((StgMutClosure*)R1.cl);
+
+  // SUBTLETY TO DO WITH THE OLD GEN MUTABLE LIST
+  //
+  // A MUT_ARR_PTRS lives on the mutable list, but a MUT_ARR_PTRS_FROZEN 
+  // normally doesn't.  However, when we freeze a MUT_ARR_PTRS, we leave
+  // it on the mutable list for the GC to remove (removing something from
+  // the mutable list is not easy, because the mut_list is only singly-linked).
+  // 
+  // So, when we thaw a MUT_ARR_PTRS_FROZEN, we must cope with two cases:
+  // either it is on a mut_list, or it isn't.  We adopt the convention that
+  // the mut_link field is NULL if it isn't on a mut_list, and the GC
+  // maintains this invariant.
+  //
+  if (((StgMutArrPtrs *)R1.cl)->mut_link == NULL) {
+	recordMutable((StgMutClosure*)R1.cl);
+  }
 
   TICK_RET_UNBOXED_TUP(1);
   RET_P(R1.p);
@@ -1053,20 +1068,6 @@ FN_(forkzh_fast)
   FE_
 }
 
-FN_(forkProcesszh_fast)
-{
-  pid_t pid;
-
-  FB_
-  /* args: none */
-  /* result: Pid */
-
-  R1.i = RET_STGCALL1(StgInt, forkProcess, CurrentTSO);
-
-  RET_N(R1.i);
-  FE_
-}
-
 FN_(yieldzh_fast)
 {
   FB_
@@ -1095,6 +1096,15 @@ FN_(labelThreadzh_fast)
   FE_
 }
 
+FN_(isCurrentThreadBoundzh_fast)
+{
+  /* no args */
+  I_ r;
+  FB_
+  r = (I_)(RET_STGCALL1(StgBool, isThreadBound, CurrentTSO));
+  RET_N(r);
+  FE_
+}
 
 /* -----------------------------------------------------------------------------
  * MVar primitives
@@ -1627,22 +1637,26 @@ FN_(delayzh_fast)
   nat target;
 #endif
   FB_
-    /* args: R1.i */
+    /* args: R1.i (microsecond delay amount) */
     ASSERT(CurrentTSO->why_blocked == NotBlocked);
     CurrentTSO->why_blocked = BlockedOnDelay;
 
     ACQUIRE_LOCK(&sched_mutex);
 #ifdef mingw32_TARGET_OS
     /* could probably allocate this on the heap instead */
-    ares = (StgAsyncIOResult*)RET_STGCALL2(P_,stgMallocBytes,sizeof(StgAsyncIOResult), "asyncWritezh_fast");
+    ares = (StgAsyncIOResult*)RET_STGCALL2(P_,stgMallocBytes,sizeof(StgAsyncIOResult), "delayzh_fast");
     reqID = RET_STGCALL1(W_,addDelayRequest,R1.i);
     ares->reqID   = reqID;
     ares->len     = 0;
     ares->errCode = 0;
     CurrentTSO->block_info.async_result = ares;
+    /* Having all async-blocked threads reside on the blocked_queue simplifies matters, so
+     * change the status to OnDoProc & put the delayed thread on the blocked_queue.
+     */
+    CurrentTSO->why_blocked = BlockedOnDoProc;
     APPEND_TO_BLOCKED_QUEUE(CurrentTSO);
 #else
-    target = (R1.i / (TICK_MILLISECS*1000)) + getourtimeofday();
+    target = ((R1.i + TICK_MILLISECS*1000-1) / (TICK_MILLISECS*1000)) + getourtimeofday();
     CurrentTSO->block_info.target = target;
 
     /* Insert the new thread in the sleeping queue. */
@@ -1676,7 +1690,7 @@ FN_(asyncReadzh_fast)
     CurrentTSO->why_blocked = BlockedOnRead;
     ACQUIRE_LOCK(&sched_mutex);
     /* could probably allocate this on the heap instead */
-    ares = (StgAsyncIOResult*)RET_STGCALL2(P_,stgMallocBytes,sizeof(StgAsyncIOResult), "asyncWritezh_fast");
+    ares = (StgAsyncIOResult*)RET_STGCALL2(P_,stgMallocBytes,sizeof(StgAsyncIOResult), "asyncReadzh_fast");
     reqID = RET_STGCALL5(W_,addIORequest,R1.i,FALSE,R2.i,R3.i,(char*)R4.p);
     ares->reqID   = reqID;
     ares->len     = 0;
@@ -1709,4 +1723,27 @@ FN_(asyncWritezh_fast)
     JMP_(stg_block_async);
   FE_
 }
+
+FN_(asyncDoProczh_fast)
+{
+  StgAsyncIOResult* ares;
+  unsigned int reqID;
+  FB_
+    /* args: R1.i = proc, R2.i = param */
+    ASSERT(CurrentTSO->why_blocked == NotBlocked);
+    CurrentTSO->why_blocked = BlockedOnDoProc;
+    ACQUIRE_LOCK(&sched_mutex);
+    /* could probably allocate this on the heap instead */
+    ares = (StgAsyncIOResult*)RET_STGCALL2(P_,stgMallocBytes,sizeof(StgAsyncIOResult), "asyncDoProczh_fast");
+    reqID = RET_STGCALL2(W_,addDoProcRequest,R1.p,R2.p);
+    ares->reqID   = reqID;
+    ares->len     = 0;
+    ares->errCode = 0;
+    CurrentTSO->block_info.async_result = ares;
+    APPEND_TO_BLOCKED_QUEUE(CurrentTSO);
+    RELEASE_LOCK(&sched_mutex);
+    JMP_(stg_block_async);
+  FE_
+}
 #endif
+