[project @ 1999-08-25 16:11:43 by simonmar]

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

diff --git a/ghc/rts/PrimOps.hc b/ghc/rts/PrimOps.hc
index f10674b..08ca10a 100644 (file)
--- a/ghc/rts/PrimOps.hc
+++ b/ghc/rts/PrimOps.hc
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: PrimOps.hc,v 1.25 1999/03/22 13:01:38 simonm Exp $
+ * $Id: PrimOps.hc,v 1.29 1999/08/25 16:11:48 simonmar Exp $
  *
  * (c) The GHC Team, 1998-1999
  *
@@ -168,7 +168,7 @@ W_ GHC_ZCCReturnable_static_info[0];
 # define RET_NP(a,b)   PUSH_N(3,a); PUSH_P(1,b); PUSHED(3)
 
 # define RET_PPP(a,b,c) PUSH_P(3,a); PUSH_P(2,b); PUSH_P(1,c); PUSHED(3)
-# define RET_NNP(a,b,c) PUSH_N(6,a); PUSH_N(4,b); PUSH_N(2,c); PUSHED(6)
+# define RET_NNP(a,b,c) PUSH_N(5,a); PUSH_N(3,b); PUSH_P(1,c); PUSHED(5)
 
 # define RET_NNNP(a,b,c,d) PUSH_N(7,a); PUSH_N(5,b); PUSH_N(3,c); PUSH_P(1,d); PUSHED(7)       
 # define RET_NPNP(a,b,c,d) PUSH_N(6,a); PUSH_P(4,b); PUSH_N(3,c); PUSH_P(1,d); PUSHED(6)       
@@ -743,17 +743,14 @@ FN_(forkzh_fast)
   FB_
   /* args: R1 = closure to spark */
   
-  if (closure_SHOULD_SPARK(R1.cl)) {
+  MAYBE_GC(R1_PTR, forkzh_fast);
 
-    MAYBE_GC(R1_PTR, forkzh_fast);
-
-    /* create it right now, return ThreadID in R1 */
-    R1.t = RET_STGCALL2(StgTSO *, createIOThread, 
-                       RtsFlags.GcFlags.initialStkSize, R1.cl);
+  /* create it right now, return ThreadID in R1 */
+  R1.t = RET_STGCALL2(StgTSO *, createIOThread, 
+                     RtsFlags.GcFlags.initialStkSize, R1.cl);
       
-    /* switch at the earliest opportunity */ 
-    context_switch = 1;
-  }
+  /* switch at the earliest opportunity */ 
+  context_switch = 1;
   
   JMP_(ENTRY_CODE(Sp[0]));
   FE_
@@ -845,7 +842,8 @@ FN_(takeMVarzh_fast)
       mvar->tail->link = CurrentTSO;
     }
     CurrentTSO->link = (StgTSO *)&END_TSO_QUEUE_closure;
-    CurrentTSO->blocked_on = (StgClosure *)mvar;
+    CurrentTSO->why_blocked = BlockedOnMVar;
+    CurrentTSO->block_info.closure = (StgClosure *)mvar;
     mvar->tail = CurrentTSO;
 
     BLOCK(R1_PTR, takeMVarzh_fast);
@@ -863,14 +861,12 @@ FN_(takeMVarzh_fast)
 FN_(putMVarzh_fast)
 {
   StgMVar *mvar;
-  StgTSO *tso;
 
   FB_
   /* args: R1 = MVar, R2 = value */
 
   mvar = (StgMVar *)R1.p;
   if (GET_INFO(mvar) == &FULL_MVAR_info) {
-    fflush(stdout);
     fprintf(stderr, "putMVar#: MVar already full.\n");
     stg_exit(EXIT_FAILURE);
   }
@@ -878,15 +874,12 @@ FN_(putMVarzh_fast)
   SET_INFO(mvar,&FULL_MVAR_info);
   mvar->value = R2.cl;
 
-  /* wake up the first thread on the queue,
-   * it will continue with the takeMVar operation and mark the MVar
-   * empty again.
+  /* wake up the first thread on the queue, it will continue with the
+   * takeMVar operation and mark the MVar empty again.
    */
-  tso = mvar->head;
-  if (tso != (StgTSO *)&END_TSO_QUEUE_closure) {
-    PUSH_ON_RUN_QUEUE(tso);
-    mvar->head = tso->link;
-    tso->link = (StgTSO *)&END_TSO_QUEUE_closure;
+  if (mvar->head != (StgTSO *)&END_TSO_QUEUE_closure) {
+    ASSERT(mvar->head->why_blocked == BlockedOnMVar);
+    mvar->head = RET_STGCALL1(StgTSO *,unblockOne,mvar->head);
     if (mvar->head == (StgTSO *)&END_TSO_QUEUE_closure) {
       mvar->tail = (StgTSO *)&END_TSO_QUEUE_closure;
     }
@@ -928,5 +921,50 @@ FN_(makeStableNamezh_fast)
   RET_P(sn_obj);
 }
 
+/* -----------------------------------------------------------------------------
+   Thread I/O blocking primitives
+   -------------------------------------------------------------------------- */
+
+FN_(waitReadzh_fast)
+{
+  FB_
+    /* args: R1.i */
+    ASSERT(CurrentTSO->why_blocked == NotBlocked);
+    CurrentTSO->why_blocked = BlockedOnRead;
+    CurrentTSO->block_info.fd = R1.i;
+    PUSH_ON_BLOCKED_QUEUE(CurrentTSO);
+    JMP_(stg_block_noregs);
+  FE_
+}
+
+FN_(waitWritezh_fast)
+{
+  FB_
+    /* args: R1.i */
+    ASSERT(CurrentTSO->why_blocked == NotBlocked);
+    CurrentTSO->why_blocked = BlockedOnWrite;
+    CurrentTSO->block_info.fd = R1.i;
+    PUSH_ON_BLOCKED_QUEUE(CurrentTSO);
+    JMP_(stg_block_noregs);
+  FE_
+}
+
+FN_(delayzh_fast)
+{
+  FB_
+    /* args: R1.i */
+    ASSERT(CurrentTSO->why_blocked == NotBlocked);
+    CurrentTSO->why_blocked = BlockedOnDelay;
+
+    /* Add on ticks_since_select, since these will be subtracted at
+     * the next awaitEvent call.
+     */
+    CurrentTSO->block_info.delay = R1.i + ticks_since_select;
+
+    PUSH_ON_BLOCKED_QUEUE(CurrentTSO);
+    JMP_(stg_block_noregs);
+  FE_
+}
+
 #endif /* COMPILER */