[project @ 2004-02-12 02:04:59 by mthomas]

[ghc-hetmet.git] / ghc / rts / PrimOps.hc

diff --git a/ghc/rts/PrimOps.hc b/ghc/rts/PrimOps.hc
index 6acb8bd..134ed1b 100644 (file)
--- a/ghc/rts/PrimOps.hc
+++ b/ghc/rts/PrimOps.hc
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: PrimOps.hc,v 1.111 2003/09/02 09:20:05 simonmar Exp $
+ * $Id: PrimOps.hc,v 1.116 2004/01/08 15:26:44 simonmar Exp $
  *
  * (c) The GHC Team, 1998-2002
  *
@@ -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,7 +1637,7 @@ 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;
 
@@ -1646,7 +1656,7 @@ FN_(delayzh_fast)
     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. */
@@ -1736,3 +1746,4 @@ FN_(asyncDoProczh_fast)
   FE_
 }
 #endif
+