X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Frts%2FPrimOps.hc;h=936b9086a6b91486b29bf61460793d8912c3feea;hb=17315bf6c11c17ad38ca5a65d7e938ac32d07d8a;hp=784c6a1676a8fcab805c294e5d59da904f7c6efb;hpb=723545930025a24708a8a0923435c95cc7f058c9;p=ghc-hetmet.git

diff --git a/ghc/rts/PrimOps.hc b/ghc/rts/PrimOps.hc
index 784c6a1..936b908 100644
--- a/ghc/rts/PrimOps.hc
+++ b/ghc/rts/PrimOps.hc
@@ -1,5 +1,7 @@
 /* -----------------------------------------------------------------------------
- * $Id: PrimOps.hc,v 1.8 1999/01/26 16:16:25 simonm Exp $
+ * $Id: PrimOps.hc,v 1.30 1999/09/15 13:45:18 simonmar Exp $
+ *
+ * (c) The GHC Team, 1998-1999
  *
  * Primitive functions / data
  *
@@ -17,6 +19,8 @@
 #include "Storage.h"
 #include "BlockAlloc.h" /* tmp */
 #include "StablePriv.h"
+#include "HeapStackCheck.h"
+#include "StgRun.h"
 
 /* ** temporary **
 
@@ -26,16 +30,9 @@
    for these.
 */
 
-W_ GHC_ZcCCallable_static_info[0];
-W_ GHC_ZcCReturnable_static_info[0];
+W_ GHC_ZCCCallable_static_info[0];
+W_ GHC_ZCCReturnable_static_info[0];
 
-#ifndef aix_TARGET_OS /* AIX gives link errors with this as a const (RO assembler section) */
-const 
-#endif 
-      StgClosure *PrelBase_Bool_closure_tbl[] = {
-    &False_closure,
-    &True_closure
-};
 
 /* -----------------------------------------------------------------------------
    Macros for Hand-written primitives.
@@ -74,6 +71,10 @@ const
         R1.w = (W_)(a); R2.w = (W_)(b); R3.w = (W_)(c); R4.w = (W_)d; \
         JMP_(ENTRY_CODE(Sp[0]));
 
+# define RET_NPNP(a,b,c,d) \
+        R1.w = (W_)(a); R2.w = (W_)(b); R3.w = (W_)(c); R4.w = (W_)(d); \
+	JMP_(ENTRY_CODE(Sp[0]));
+
 # define RET_NNPNNP(a,b,c,d,e,f) \
         R1.w = (W_)(a); R2.w = (W_)(b); R3.w = (W_)(c); \
         R4.w = (W_)(d); R5.w = (W_)(e); R6.w = (W_)(f); \
@@ -114,6 +115,15 @@ const
         Sp -= 5;				\
         JMP_(ENTRY_CODE(Sp[5]));
 
+# define RET_NPNP(a,b,c,d)			\
+	R1.w = (W_)(a); 			\
+        Sp[-4] = (W_)(b); 			\
+    /*  Sp[-3] = ARGTAG(1); */			\
+        Sp[-2] = (W_)(c); 			\
+        Sp[-1] = (W_)(d); 			\
+        Sp -= 4;				\
+        JMP_(ENTRY_CODE(Sp[4]));
+
 # define RET_NNPNNP(a,b,c,d,e,f)		\
         R1.w = (W_)(a);				\
 	Sp[-1] = (W_)(f);			\
@@ -158,9 +168,10 @@ const
 # 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)	
 # define RET_NNPNNP(a,b,c,d,e,f) PUSH_N(10,a); PUSH_N(8,b); PUSH_P(6,c); PUSH_N(5,d); PUSH_N(3,e); PUSH_P(1,f); PUSHED(10)
 
 #endif
@@ -186,18 +197,18 @@ const
 #define BYTES_TO_STGWORDS(n) ((n) + sizeof(W_) - 1)/sizeof(W_)
 
 #define newByteArray(ty,scale)				\
- FN_(new##ty##ArrayZh_fast)				\
+ FN_(new##ty##Arrayzh_fast)				\
  {							\
    W_ stuff_size, size, n;				\
    StgArrWords* p;					\
    FB_							\
-     MAYBE_GC(NO_PTRS,new##ty##ArrayZh_fast);		\
+     MAYBE_GC(NO_PTRS,new##ty##Arrayzh_fast);		\
      n = R1.w;						\
      stuff_size = BYTES_TO_STGWORDS(n*scale);		\
      size = sizeofW(StgArrWords)+ stuff_size;		\
      p = (StgArrWords *)RET_STGCALL1(P_,allocate,size);	\
      TICK_ALLOC_PRIM(sizeofW(StgArrWords),stuff_size,0); \
-     SET_HDR(p, &MUT_ARR_WORDS_info, CCCS);		\
+     SET_HDR(p, &ARR_WORDS_info, CCCS);		\
      p->words = stuff_size;				\
      TICK_RET_UNBOXED_TUP(1)				\
      RET_P(p);						\
@@ -212,7 +223,7 @@ newByteArray(Float,  sizeof(StgFloat));
 newByteArray(Double, sizeof(StgDouble));
 newByteArray(StablePtr, sizeof(StgStablePtr));
 
-FN_(newArrayZh_fast)
+FN_(newArrayzh_fast)
 {
   W_ size, n, init;
   StgMutArrPtrs* arr;
@@ -220,7 +231,7 @@ FN_(newArrayZh_fast)
   FB_
     n = R1.w;
 
-    MAYBE_GC(R2_PTR,newArrayZh_fast);
+    MAYBE_GC(R2_PTR,newArrayzh_fast);
 
     size = sizeofW(StgMutArrPtrs) + n;
     arr = (StgMutArrPtrs *)RET_STGCALL1(P_, allocate, size);
@@ -240,13 +251,13 @@ FN_(newArrayZh_fast)
   FE_
 }
 
-FN_(newMutVarZh_fast)
+FN_(newMutVarzh_fast)
 {
   StgMutVar* mv;
   /* Args: R1.p = initialisation value */
   FB_
 
-  HP_CHK_GEN(sizeofW(StgMutVar), R1_PTR, newMutVarZh_fast,);
+  HP_CHK_GEN(sizeofW(StgMutVar), R1_PTR, newMutVarzh_fast,);
   TICK_ALLOC_PRIM(sizeofW(StgHeader)+1,1, 0); /* hack, dependent on rep. */
   CCS_ALLOC(CCCS,sizeofW(StgMutVar));
 
@@ -265,14 +276,14 @@ FN_(newMutVarZh_fast)
    -------------------------------------------------------------------------- */
 
 #ifndef PAR
-FN_(makeForeignObjZh_fast)
+FN_(makeForeignObjzh_fast)
 {
   /* R1.p = ptr to foreign object,
   */
   StgForeignObj *result;
   FB_
 
-  HP_CHK_GEN(sizeofW(StgForeignObj), NO_PTRS, makeForeignObjZh_fast,);
+  HP_CHK_GEN(sizeofW(StgForeignObj), NO_PTRS, makeForeignObjzh_fast,);
   TICK_ALLOC_PRIM(sizeofW(StgHeader),
 		  sizeofW(StgForeignObj)-sizeofW(StgHeader), 0);
   CCS_ALLOC(CCCS,sizeofW(StgForeignObj)); /* ccs prof */
@@ -288,22 +299,34 @@ FN_(makeForeignObjZh_fast)
 }
 #endif
 
+/* These two are out-of-line for the benefit of the NCG */
+FN_(unsafeThawArrayzh_fast)
+{
+  FB_
+  SET_INFO((StgClosure *)R1.cl,&MUT_ARR_PTRS_info);
+  recordMutable((StgMutClosure*)R1.cl);
+
+  TICK_RET_UNBOXED_TUP(1);
+  RET_P(R1.p);
+  FE_
+}
+
 /* -----------------------------------------------------------------------------
    Weak Pointer Primitives
    -------------------------------------------------------------------------- */
 
 #ifndef PAR
 
-FN_(mkWeakZh_fast)
+FN_(mkWeakzh_fast)
 {
   /* R1.p = key
      R2.p = value
-     R3.p = finaliser
+     R3.p = finalizer
   */
   StgWeak *w;
   FB_
 
-  HP_CHK_GEN(sizeofW(StgWeak), R1_PTR|R2_PTR|R3_PTR, mkWeakZh_fast,);
+  HP_CHK_GEN(sizeofW(StgWeak), R1_PTR|R2_PTR|R3_PTR, mkWeakzh_fast,);
   TICK_ALLOC_PRIM(sizeofW(StgHeader)+1,  // +1 is for the link field
 		  sizeofW(StgWeak)-sizeofW(StgHeader)-1, 0);
   CCS_ALLOC(CCCS,sizeofW(StgWeak)); /* ccs prof */
@@ -313,7 +336,11 @@ FN_(mkWeakZh_fast)
 
   w->key        = R1.cl;
   w->value      = R2.cl;
-  w->finaliser  = R3.cl;
+  if (R3.cl) {
+     w->finalizer  = R3.cl;
+  } else {
+     w->finalizer  = &NO_FINALIZER_closure;
+  }
 
   w->link       = weak_ptr_list;
   weak_ptr_list = w;
@@ -324,19 +351,31 @@ FN_(mkWeakZh_fast)
   FE_
 }
 
-FN_(deRefWeakZh_fast)
+FN_(finalizzeWeakzh_fast)
 {
   /* R1.p = weak ptr
    */
-  StgWeak *w;
+  StgDeadWeak *w;
+  StgClosure *f;
   FB_
-  
-  TICK_RET_UNBOXED_TUP(2);
-  w = (StgWeak *)R1.p;
-  if (w->header.info == &WEAK_info) {
-	RET_NP(1, w->value);
+  TICK_RET_UNBOXED_TUP(0);
+  w = (StgDeadWeak *)R1.p;
+
+  /* already dead? */
+  if (w->header.info == &DEAD_WEAK_info) {
+      RET_NP(0,&NO_FINALIZER_closure);
+  }
+
+  /* kill it */
+  w->header.info = &DEAD_WEAK_info;
+  f = ((StgWeak *)w)->finalizer;
+  w->link = ((StgWeak *)w)->link;
+
+  /* return the finalizer */
+  if (f == &NO_FINALIZER_closure) {
+      RET_NP(0,&NO_FINALIZER_closure);
   } else {
-	RET_NP(0, w);
+      RET_NP(1,f);
   }
   FE_
 }
@@ -347,7 +386,7 @@ FN_(deRefWeakZh_fast)
    Arbitrary-precision Integer operations.
    -------------------------------------------------------------------------- */
 
-FN_(int2IntegerZh_fast)
+FN_(int2Integerzh_fast)
 {
    /* arguments: R1 = Int# */
 
@@ -356,11 +395,11 @@ FN_(int2IntegerZh_fast)
    FB_
 
    val = R1.i;
-   HP_CHK_GEN(sizeofW(StgArrWords)+1, NO_PTRS, int2IntegerZh_fast,);
+   HP_CHK_GEN(sizeofW(StgArrWords)+1, NO_PTRS, int2Integerzh_fast,);
    TICK_ALLOC_PRIM(sizeofW(StgArrWords),1,0);
    CCS_ALLOC(CCCS,sizeofW(StgArrWords)+1); /* ccs prof */
 
-   p = stgCast(StgArrWords*,Hp)-1;
+   p = (StgArrWords *)Hp - 1;
    SET_ARR_HDR(p, &ARR_WORDS_info, CCCS, 1);
 
    /* mpz_set_si is inlined here, makes things simpler */
@@ -374,17 +413,16 @@ FN_(int2IntegerZh_fast)
 	s = 0;
    }
 
-   /* returns (# alloc :: Int#, 
-		 size  :: Int#, 
+   /* returns (# size  :: Int#, 
 		 data  :: ByteArray# 
 	       #)
    */
-   TICK_RET_UNBOXED_TUP(3);
-   RET_NNP(1,s,p);
+   TICK_RET_UNBOXED_TUP(2);
+   RET_NP(s,p);
    FE_
 }
 
-FN_(word2IntegerZh_fast)
+FN_(word2Integerzh_fast)
 {
    /* arguments: R1 = Word# */
 
@@ -394,11 +432,11 @@ FN_(word2IntegerZh_fast)
    FB_
 
    val = R1.w;
-   HP_CHK_GEN(sizeofW(StgArrWords)+1, NO_PTRS, word2IntegerZh_fast,)
+   HP_CHK_GEN(sizeofW(StgArrWords)+1, NO_PTRS, word2Integerzh_fast,)
    TICK_ALLOC_PRIM(sizeofW(StgArrWords),1,0);
    CCS_ALLOC(CCCS,sizeofW(StgArrWords)+1); /* ccs prof */
 
-   p = stgCast(StgArrWords*,Hp)-1;
+   p = (StgArrWords *)Hp - 1;
    SET_ARR_HDR(p, &ARR_WORDS_info, CCCS, 1);
 
    if (val != 0) {
@@ -408,23 +446,22 @@ FN_(word2IntegerZh_fast)
 	s = 0;
    }
 
-   /* returns (# alloc :: Int#, 
-		 size  :: Int#, 
+   /* returns (# size  :: Int#, 
 		 data  :: ByteArray# 
 	       #)
    */
-  TICK_RET_UNBOXED_TUP(3);
-   RET_NNP(1,s,p);
+   TICK_RET_UNBOXED_TUP(2);
+   RET_NP(s,p);
    FE_
 }
 
-FN_(addr2IntegerZh_fast)
+FN_(addr2Integerzh_fast)
 {
   MP_INT result;
   char *str;
   FB_
 
-  MAYBE_GC(NO_PTRS,addr2IntegerZh_fast);
+  MAYBE_GC(NO_PTRS,addr2Integerzh_fast);
 
   /* args:   R1 :: Addr# */
   str = R1.a;
@@ -433,8 +470,12 @@ FN_(addr2IntegerZh_fast)
   if (RET_STGCALL3(int, mpz_init_set_str,&result,(str),/*base*/10))
       abort();
 
-  TICK_RET_UNBOXED_TUP(3);
-  RET_NNP(result._mp_alloc, result._mp_size, 
+   /* returns (# size  :: Int#, 
+		 data  :: ByteArray# 
+	       #)
+   */
+  TICK_RET_UNBOXED_TUP(2);
+  RET_NP(result._mp_size, 
 	  result._mp_d - sizeofW(StgArrWords));
   FE_
 }
@@ -445,13 +486,13 @@ FN_(addr2IntegerZh_fast)
 
 #ifdef SUPPORT_LONG_LONGS
 
-FN_(int64ToIntegerZh_fast)
+FN_(int64ToIntegerzh_fast)
 {
    /* arguments: L1 = Int64# */
 
    StgInt64  val; /* to avoid aliasing */
    W_ hi;
-   I_  s,a, neg, words_needed;
+   I_  s, neg, words_needed;
    StgArrWords* p;	/* address of array result */
    FB_
 
@@ -464,15 +505,13 @@ FN_(int64ToIntegerZh_fast)
        /* minimum is one word */
        words_needed = 1;
    }
-   HP_CHK_GEN(sizeofW(StgArrWords)+words_needed, NO_PTRS, int64ToIntegerZh_fast,)
+   HP_CHK_GEN(sizeofW(StgArrWords)+words_needed, NO_PTRS, int64ToIntegerzh_fast,)
    TICK_ALLOC_PRIM(sizeofW(StgArrWords),words_needed,0);
    CCS_ALLOC(CCCS,sizeofW(StgArrWords)+words_needed); /* ccs prof */
 
-   p = stgCast(StgArrWords*,(Hp-words_needed+1))-1;
+   p = (StgArrWords *)(Hp-words_needed+1) - 1;
    SET_ARR_HDR(p, &ARR_WORDS_info, CCCS, words_needed);
 
-   a = words_needed;
-
    if ( val < 0LL ) {
      neg = 1;
      val = -val;
@@ -480,7 +519,7 @@ FN_(int64ToIntegerZh_fast)
 
    hi = (W_)((LW_)val / 0x100000000ULL);
 
-   if ( a == 2 )  { 
+   if ( words_needed == 2 )  { 
       s = 2; 
       Hp[-1] = (W_)val;
       Hp[0] = hi;
@@ -492,23 +531,22 @@ FN_(int64ToIntegerZh_fast)
    }
    s = ( neg ? -s : s );
 
-   /* returns (# alloc :: Int#, 
-		 size  :: Int#, 
+   /* returns (# size  :: Int#, 
 		 data  :: ByteArray# 
 	       #)
    */
-   TICK_RET_UNBOXED_TUP(3);
-   RET_NNP(a,s,p);
+   TICK_RET_UNBOXED_TUP(2);
+   RET_NP(s,p);
    FE_
 }
 
-FN_(word64ToIntegerZh_fast)
+FN_(word64ToIntegerzh_fast)
 {
    /* arguments: L1 = Word64# */
 
-   StgNat64 val; /* to avoid aliasing */
+   StgWord64 val; /* to avoid aliasing */
    StgWord hi;
-   I_  s,a,words_needed;
+   I_  s, words_needed;
    StgArrWords* p;	/* address of array result */
    FB_
 
@@ -518,15 +556,13 @@ FN_(word64ToIntegerZh_fast)
    } else {
       words_needed = 1;
    }
-   HP_CHK_GEN(sizeofW(StgArrWords)+words_needed, NO_PTRS, word64ToIntegerZh_fast,)
+   HP_CHK_GEN(sizeofW(StgArrWords)+words_needed, NO_PTRS, word64ToIntegerzh_fast,)
    TICK_ALLOC_PRIM(sizeofW(StgArrWords),words_needed,0);
    CCS_ALLOC(CCCS,sizeofW(StgArrWords)+words_needed); /* ccs prof */
 
-   p = stgCast(StgArrWords*,(Hp-words_needed+1))-1;
+   p = (StgArrWords *)(Hp-words_needed+1) - 1;
    SET_ARR_HDR(p, &ARR_WORDS_info, CCCS, words_needed);
 
-   a = words_needed;
-
    hi = (W_)((LW_)val / 0x100000000ULL);
    if ( val >= 0x100000000ULL ) { 
      s = 2;
@@ -539,13 +575,12 @@ FN_(word64ToIntegerZh_fast)
       s = 0;
    }
 
-   /* returns (# alloc :: Int#, 
-		 size  :: Int#, 
+   /* returns (# size  :: Int#, 
 		 data  :: ByteArray# 
 	       #)
    */
-   TICK_RET_UNBOXED_TUP(3);
-   RET_NNP(a,s,p);
+   TICK_RET_UNBOXED_TUP(2);
+   RET_NP(s,p);
    FE_
 }
 
@@ -558,25 +593,23 @@ FN_(word64ToIntegerZh_fast)
 FN_(name)								\
 {									\
   MP_INT arg1, arg2, result;						\
-  I_ a1, s1, a2, s2;							\
+  I_ s1, s2;							\
   StgArrWords* d1;							\
   StgArrWords* d2;							\
   FB_									\
  									\
   /* call doYouWantToGC() */						\
-  MAYBE_GC(R3_PTR | R6_PTR, name);					\
+  MAYBE_GC(R2_PTR | R4_PTR, name);					\
 									\
-  a1 = R1.i;								\
-  s1 = R2.i;								\
-  d1 = stgCast(StgArrWords*,R3.p);					\
-  a2 = R4.i;								\
-  s2 = R5.i;								\
-  d2 = stgCast(StgArrWords*,R6.p);					\
+  d1 = (StgArrWords *)R2.p;						\
+  s1 = R1.i;								\
+  d2 = (StgArrWords *)R4.p;						\
+  s2 = R3.i;								\
 									\
-  arg1._mp_alloc	= (a1);						\
+  arg1._mp_alloc	= d1->words;					\
   arg1._mp_size		= (s1);						\
   arg1._mp_d		= (unsigned long int *) (BYTE_ARR_CTS(d1));	\
-  arg2._mp_alloc	= (a2);						\
+  arg2._mp_alloc	= d2->words;					\
   arg2._mp_size		= (s2);						\
   arg2._mp_d		= (unsigned long int *) (BYTE_ARR_CTS(d2));	\
 									\
@@ -585,10 +618,9 @@ FN_(name)								\
   /* Perform the operation */						\
   STGCALL3(mp_fun,&result,&arg1,&arg2);					\
 									\
-  TICK_RET_UNBOXED_TUP(3);						\
-  RET_NNP(result._mp_alloc, 						\
-	  result._mp_size, 						\
-          result._mp_d-sizeofW(StgArrWords));				\
+  TICK_RET_UNBOXED_TUP(2);						\
+  RET_NP(result._mp_size, 						\
+         result._mp_d-sizeofW(StgArrWords));				\
   FE_									\
 }
 
@@ -596,25 +628,23 @@ FN_(name)								\
 FN_(name)								\
 {									\
   MP_INT arg1, arg2, result1, result2;					\
-  I_ a1, s1, a2, s2;							\
+  I_ s1, s2;							\
   StgArrWords* d1;							\
   StgArrWords* d2;							\
   FB_									\
  									\
   /* call doYouWantToGC() */						\
-  MAYBE_GC(R3_PTR | R6_PTR, name);					\
+  MAYBE_GC(R2_PTR | R4_PTR, name);					\
 									\
-  a1 = R1.i;								\
-  s1 = R2.i;								\
-  d1 = stgCast(StgArrWords*,R3.p);					\
-  a2 = R4.i;								\
-  s2 = R5.i;								\
-  d2 = stgCast(StgArrWords*,R6.p);					\
+  d1 = (StgArrWords *)R2.p;						\
+  s1 = R1.i;								\
+  d2 = (StgArrWords *)R4.p;						\
+  s2 = R3.i;								\
 									\
-  arg1._mp_alloc	= (a1);						\
+  arg1._mp_alloc	= d1->words;					\
   arg1._mp_size		= (s1);						\
   arg1._mp_d		= (unsigned long int *) (BYTE_ARR_CTS(d1));	\
-  arg2._mp_alloc	= (a2);						\
+  arg2._mp_alloc	= d2->words;					\
   arg2._mp_size		= (s2);						\
   arg2._mp_d		= (unsigned long int *) (BYTE_ARR_CTS(d2));	\
 									\
@@ -624,26 +654,24 @@ FN_(name)								\
   /* Perform the operation */						\
   STGCALL4(mp_fun,&result1,&result2,&arg1,&arg2);			\
 									\
-  TICK_RET_UNBOXED_TUP(6);						\
-  RET_NNPNNP(result1._mp_alloc,						\
-	     result1._mp_size, 						\
-             result1._mp_d-sizeofW(StgArrWords),			\
-	     result2._mp_alloc,						\
-	     result2._mp_size, 						\
-             result2._mp_d-sizeofW(StgArrWords));			\
+  TICK_RET_UNBOXED_TUP(4);						\
+  RET_NPNP(result1._mp_size, 						\
+           result1._mp_d-sizeofW(StgArrWords),				\
+	   result2._mp_size, 						\
+           result2._mp_d-sizeofW(StgArrWords));				\
   FE_									\
 }
 
-GMP_TAKE2_RET1(plusIntegerZh_fast,  mpz_add);
-GMP_TAKE2_RET1(minusIntegerZh_fast, mpz_sub);
-GMP_TAKE2_RET1(timesIntegerZh_fast, mpz_mul);
-GMP_TAKE2_RET1(gcdIntegerZh_fast,   mpz_gcd);
+GMP_TAKE2_RET1(plusIntegerzh_fast,  mpz_add);
+GMP_TAKE2_RET1(minusIntegerzh_fast, mpz_sub);
+GMP_TAKE2_RET1(timesIntegerzh_fast, mpz_mul);
+GMP_TAKE2_RET1(gcdIntegerzh_fast,   mpz_gcd);
 
-GMP_TAKE2_RET2(quotRemIntegerZh_fast, mpz_tdiv_qr);
-GMP_TAKE2_RET2(divModIntegerZh_fast,  mpz_fdiv_qr);
+GMP_TAKE2_RET2(quotRemIntegerzh_fast, mpz_tdiv_qr);
+GMP_TAKE2_RET2(divModIntegerzh_fast,  mpz_fdiv_qr);
 
 #ifndef FLOATS_AS_DOUBLES
-FN_(decodeFloatZh_fast)
+FN_(decodeFloatzh_fast)
 { 
   MP_INT mantissa;
   I_ exponent;
@@ -654,30 +682,30 @@ FN_(decodeFloatZh_fast)
   /* arguments: F1 = Float# */
   arg = F1;
 
-  HP_CHK_GEN(sizeof(StgArrWords)+1, NO_PTRS, decodeFloatZh_fast,);
+  HP_CHK_GEN(sizeofW(StgArrWords)+1, NO_PTRS, decodeFloatzh_fast,);
   TICK_ALLOC_PRIM(sizeofW(StgArrWords),1,0);
   CCS_ALLOC(CCCS,sizeofW(StgArrWords)+1); /* ccs prof */
 
   /* Be prepared to tell Lennart-coded __decodeFloat	*/
   /* where mantissa._mp_d can be put (it does not care about the rest) */
-  p = stgCast(StgArrWords*,Hp)-1;
+  p = (StgArrWords *)Hp - 1;
   SET_ARR_HDR(p,&ARR_WORDS_info,CCCS,1)
   mantissa._mp_d = (void *)BYTE_ARR_CTS(p);
 
   /* Perform the operation */
   STGCALL3(__decodeFloat,&mantissa,&exponent,arg);
 
-  /* returns: (R1 = Int# (expn), R2 = Int#, R3 = Int#, R4 = ByteArray#) */
-  TICK_RET_UNBOXED_TUP(4);
-  RET_NNNP(exponent,mantissa._mp_alloc,mantissa._mp_size,p);
+  /* returns: (Int# (expn), Int#, ByteArray#) */
+  TICK_RET_UNBOXED_TUP(3);
+  RET_NNP(exponent,mantissa._mp_size,p);
   FE_
 }
 #endif /* !FLOATS_AS_DOUBLES */
 
-#define DOUBLE_MANTISSA_SIZE (sizeof(StgDouble)/sizeof(W_))
-#define ARR_SIZE (sizeof(StgArrWords) + DOUBLE_MANTISSA_SIZE)
+#define DOUBLE_MANTISSA_SIZE (sizeofW(StgDouble))
+#define ARR_SIZE (sizeofW(StgArrWords) + DOUBLE_MANTISSA_SIZE)
 
-FN_(decodeDoubleZh_fast)
+FN_(decodeDoublezh_fast)
 { MP_INT mantissa;
   I_ exponent;
   StgDouble arg;
@@ -687,22 +715,22 @@ FN_(decodeDoubleZh_fast)
   /* arguments: D1 = Double# */
   arg = D1;
 
-  HP_CHK_GEN(ARR_SIZE, NO_PTRS, decodeDoubleZh_fast,);
-  TICK_ALLOC_PRIM(sizeof(StgArrWords),DOUBLE_MANTISSA_SIZE,0);
+  HP_CHK_GEN(ARR_SIZE, NO_PTRS, decodeDoublezh_fast,);
+  TICK_ALLOC_PRIM(sizeofW(StgArrWords),DOUBLE_MANTISSA_SIZE,0);
   CCS_ALLOC(CCCS,ARR_SIZE); /* ccs prof */
 
   /* Be prepared to tell Lennart-coded __decodeDouble	*/
   /* where mantissa.d can be put (it does not care about the rest) */
-  p = stgCast(StgArrWords*,Hp-ARR_SIZE+1);
+  p = (StgArrWords *)(Hp-ARR_SIZE+1);
   SET_ARR_HDR(p, &ARR_WORDS_info, CCCS, DOUBLE_MANTISSA_SIZE);
   mantissa._mp_d = (void *)BYTE_ARR_CTS(p);
 
   /* Perform the operation */
   STGCALL3(__decodeDouble,&mantissa,&exponent,arg);
 
-  /* returns: (R1 = Int# (expn), R2 = Int#, R3 = Int#, R4 = ByteArray#) */
-  TICK_RET_UNBOXED_TUP(4);
-  RET_NNNP(exponent,mantissa._mp_alloc,mantissa._mp_size,p);
+  /* returns: (Int# (expn), Int#, ByteArray#) */
+  TICK_RET_UNBOXED_TUP(3);
+  RET_NNP(exponent,mantissa._mp_size,p);
   FE_
 }
 
@@ -710,62 +738,82 @@ FN_(decodeDoubleZh_fast)
  * Concurrency primitives
  * -------------------------------------------------------------------------- */
 
-FN_(forkZh_fast)
+FN_(forkzh_fast)
 {
   FB_
   /* args: R1 = closure to spark */
   
-  if (closure_SHOULD_SPARK(stgCast(StgClosure*,R1.p))) {
-
-    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_
 }
 
-FN_(killThreadZh_fast)
+FN_(yieldzh_fast)
+{
+  FB_
+  JMP_(stg_yield_noregs);
+  FE_
+}
+
+FN_(killThreadzh_fast)
 {
   FB_
-  /* args: R1.p = TSO to kill */
+  /* args: R1.p = TSO to kill, R2.p = Exception */
 
   /* The thread is dead, but the TSO sticks around for a while.  That's why
    * we don't have to explicitly remove it from any queues it might be on.
    */
-  STGCALL1(deleteThread, (StgTSO *)R1.p);
 
-  /* We might have killed ourselves.  In which case, better return to the
-   * scheduler...
+  /* We might have killed ourselves.  In which case, better be *very*
+   * careful.  If the exception killed us, then return to the scheduler.
+   * If the exception went to a catch frame, we'll just continue from
+   * the handler.
    */
-  if ((StgTSO *)R1.p == CurrentTSO) {
-	JMP_(stg_stop_thread_entry); /* leave semi-gracefully */
+  if (R1.t == CurrentTSO) {
+	SaveThreadState();	/* inline! */
+	STGCALL2(raiseAsync, R1.t, R2.cl);
+	if (CurrentTSO->whatNext == ThreadKilled) {
+		R1.w = ThreadYielding;
+		JMP_(StgReturn);
+	}
+	LoadThreadState();
+	if (CurrentTSO->whatNext == ThreadEnterGHC) {
+		R1.w = Sp[0];
+		Sp++;
+		JMP_(GET_ENTRY(R1.cl));
+	} else {
+	  	barf("killThreadzh_fast");
+	}
+  } else {
+	STGCALL2(raiseAsync, R1.t, R2.cl);
   }
 
   JMP_(ENTRY_CODE(Sp[0]));
   FE_
 }
 
-FN_(newMVarZh_fast)
+FN_(newMVarzh_fast)
 {
   StgMVar *mvar;
 
   FB_
   /* args: none */
 
-  HP_CHK_GEN(sizeofW(StgMVar), NO_PTRS, newMVarZh_fast,);
+  HP_CHK_GEN(sizeofW(StgMVar), NO_PTRS, newMVarzh_fast,);
   TICK_ALLOC_PRIM(sizeofW(StgMutVar)-1, // consider head,tail,link as admin wds
 	 	  1, 0);
   CCS_ALLOC(CCCS,sizeofW(StgMVar)); /* ccs prof */
   
   mvar = (StgMVar *) (Hp - sizeofW(StgMVar) + 1);
-  SET_INFO(mvar,&EMPTY_MVAR_info);
+  SET_HDR(mvar,&EMPTY_MVAR_info,CCCS);
   mvar->head = mvar->tail = (StgTSO *)&END_TSO_QUEUE_closure;
   mvar->value = (StgClosure *)&END_TSO_QUEUE_closure;
 
@@ -774,7 +822,7 @@ FN_(newMVarZh_fast)
   FE_
 }
 
-FN_(takeMVarZh_fast)
+FN_(takeMVarzh_fast)
 {
   StgMVar *mvar;
   StgClosure *val;
@@ -794,9 +842,11 @@ FN_(takeMVarZh_fast)
       mvar->tail->link = CurrentTSO;
     }
     CurrentTSO->link = (StgTSO *)&END_TSO_QUEUE_closure;
+    CurrentTSO->why_blocked = BlockedOnMVar;
+    CurrentTSO->block_info.closure = (StgClosure *)mvar;
     mvar->tail = CurrentTSO;
 
-    BLOCK(R1_PTR, takeMVarZh_fast);
+    BLOCK(R1_PTR, takeMVarzh_fast);
   }
 
   SET_INFO(mvar,&EMPTY_MVAR_info);
@@ -808,17 +858,15 @@ FN_(takeMVarZh_fast)
   FE_
 }
 
-FN_(putMVarZh_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);
   }
@@ -826,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;
     }
@@ -849,26 +894,77 @@ FN_(putMVarZh_fast)
    Stable pointer primitives
    -------------------------------------------------------------------------  */
 
-FN_(makeStableNameZh_fast)
+FN_(makeStableNamezh_fast)
 {
   StgWord index;
   StgStableName *sn_obj;
   FB_
 
-  HP_CHK_GEN(sizeofW(StgStableName), R1_PTR, makeStableNameZh_fast,);
+  HP_CHK_GEN(sizeofW(StgStableName), R1_PTR, makeStableNamezh_fast,);
   TICK_ALLOC_PRIM(sizeofW(StgHeader), 
 		  sizeofW(StgStableName)-sizeofW(StgHeader), 0);
   CCS_ALLOC(CCCS,sizeofW(StgStableName)); /* ccs prof */
   
   index = RET_STGCALL1(StgWord,lookupStableName,R1.p);
 
-  sn_obj = (StgStableName *) (Hp - sizeofW(StgStableName) + 1);
-  sn_obj->header.info = &STABLE_NAME_info;
-  sn_obj->sn = index;
+  /* Is there already a StableName for this heap object? */
+  if (stable_ptr_table[index].sn_obj == NULL) {
+    sn_obj = (StgStableName *) (Hp - sizeofW(StgStableName) + 1);
+    sn_obj->header.info = &STABLE_NAME_info;
+    sn_obj->sn = index;
+    stable_ptr_table[index].sn_obj = (StgClosure *)sn_obj;
+  } else {
+    (StgClosure *)sn_obj = stable_ptr_table[index].sn_obj;
+  }
 
   TICK_RET_UNBOXED_TUP(1);
   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 */