X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Frts%2FPrimOps.hc;h=aa31718aada5625eeee008e4d8017e92c7575d38;hb=b41f38a42b197dfb166ebfe78476b24982379e19;hp=ae400803d99aa19b02a436b7c9ee4072c24b6f71;hpb=ed4cd6d403d932026f38608f81c3a8872e38b2ce;p=ghc-hetmet.git

diff --git a/ghc/rts/PrimOps.hc b/ghc/rts/PrimOps.hc
index ae40080..aa31718 100644
--- a/ghc/rts/PrimOps.hc
+++ b/ghc/rts/PrimOps.hc
@@ -1,5 +1,7 @@
 /* -----------------------------------------------------------------------------
- * $Id: PrimOps.hc,v 1.7 1999/01/26 11:12:46 simonm Exp $
+ * $Id: PrimOps.hc,v 1.14 1999/02/11 14:22:53 simonm Exp $
+ *
+ * (c) The GHC Team, 1998-1999
  *
  * Primitive functions / data
  *
@@ -26,8 +28,8 @@
    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 
@@ -186,18 +188,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 +214,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 +222,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 +242,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 +267,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 */
@@ -294,16 +296,16 @@ FN_(makeForeignObjZh_fast)
 
 #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 +315,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 +330,28 @@ FN_(mkWeakZh_fast)
   FE_
 }
 
-FN_(deRefWeakZh_fast)
+FN_(finalizeWeakzh_fast)
 {
   /* R1.p = weak ptr
    */
   StgWeak *w;
   FB_
-  
-  TICK_RET_UNBOXED_TUP(2);
+  TICK_RET_UNBOXED_TUP(0);
   w = (StgWeak *)R1.p;
-  if (w->header.info == &WEAK_info) {
-	RET_NP(1, w->value);
+
+  /* already dead? */
+  if (w->header.info == &DEAD_WEAK_info) {
+      RET_NP(0,&NO_FINALIZER_closure);
+  }
+
+  /* kill it */
+  w->header.info = &DEAD_WEAK_info;
+
+  /* return the finalizer */
+  if (w->finalizer == &NO_FINALIZER_closure) {
+      RET_NP(0,&NO_FINALIZER_closure);
   } else {
-	RET_NP(0, w);
+      RET_NP(1,w->finalizer);
   }
   FE_
 }
@@ -347,7 +362,7 @@ FN_(deRefWeakZh_fast)
    Arbitrary-precision Integer operations.
    -------------------------------------------------------------------------- */
 
-FN_(int2IntegerZh_fast)
+FN_(int2Integerzh_fast)
 {
    /* arguments: R1 = Int# */
 
@@ -356,7 +371,7 @@ 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 */
 
@@ -384,7 +399,7 @@ FN_(int2IntegerZh_fast)
    FE_
 }
 
-FN_(word2IntegerZh_fast)
+FN_(word2Integerzh_fast)
 {
    /* arguments: R1 = Word# */
 
@@ -394,7 +409,7 @@ 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 */
 
@@ -418,13 +433,13 @@ FN_(word2IntegerZh_fast)
    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;
@@ -445,7 +460,7 @@ FN_(addr2IntegerZh_fast)
 
 #ifdef SUPPORT_LONG_LONGS
 
-FN_(int64ToIntegerZh_fast)
+FN_(int64ToIntegerzh_fast)
 {
    /* arguments: L1 = Int64# */
 
@@ -464,7 +479,7 @@ 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 */
 
@@ -502,7 +517,7 @@ FN_(int64ToIntegerZh_fast)
    FE_
 }
 
-FN_(word64ToIntegerZh_fast)
+FN_(word64ToIntegerzh_fast)
 {
    /* arguments: L1 = Word64# */
 
@@ -518,7 +533,7 @@ 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 */
 
@@ -634,16 +649,16 @@ FN_(name)								\
   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,7 +669,7 @@ FN_(decodeFloatZh_fast)
   /* arguments: F1 = Float# */
   arg = F1;
 
-  HP_CHK_GEN(sizeof(StgArrWords)+1, NO_PTRS, decodeFloatZh_fast,);
+  HP_CHK_GEN(sizeof(StgArrWords)+1, NO_PTRS, decodeFloatzh_fast,);
   TICK_ALLOC_PRIM(sizeofW(StgArrWords),1,0);
   CCS_ALLOC(CCCS,sizeofW(StgArrWords)+1); /* ccs prof */
 
@@ -677,7 +692,7 @@ FN_(decodeFloatZh_fast)
 #define DOUBLE_MANTISSA_SIZE (sizeof(StgDouble)/sizeof(W_))
 #define ARR_SIZE (sizeof(StgArrWords) + DOUBLE_MANTISSA_SIZE)
 
-FN_(decodeDoubleZh_fast)
+FN_(decodeDoublezh_fast)
 { MP_INT mantissa;
   I_ exponent;
   StgDouble arg;
@@ -687,7 +702,7 @@ FN_(decodeDoubleZh_fast)
   /* arguments: D1 = Double# */
   arg = D1;
 
-  HP_CHK_GEN(ARR_SIZE, NO_PTRS, decodeDoubleZh_fast,);
+  HP_CHK_GEN(ARR_SIZE, NO_PTRS, decodeDoublezh_fast,);
   TICK_ALLOC_PRIM(sizeof(StgArrWords),DOUBLE_MANTISSA_SIZE,0);
   CCS_ALLOC(CCCS,ARR_SIZE); /* ccs prof */
 
@@ -710,14 +725,14 @@ 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, 
@@ -731,7 +746,7 @@ FN_(forkZh_fast)
   FE_
 }
 
-FN_(killThreadZh_fast)
+FN_(killThreadzh_fast)
 {
   FB_
   /* args: R1.p = TSO to kill */
@@ -752,14 +767,14 @@ FN_(killThreadZh_fast)
   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 */
@@ -774,7 +789,7 @@ FN_(newMVarZh_fast)
   FE_
 }
 
-FN_(takeMVarZh_fast)
+FN_(takeMVarzh_fast)
 {
   StgMVar *mvar;
   StgClosure *val;
@@ -796,7 +811,7 @@ FN_(takeMVarZh_fast)
     CurrentTSO->link = (StgTSO *)&END_TSO_QUEUE_closure;
     mvar->tail = CurrentTSO;
 
-    BLOCK(R1_PTR, takeMVarZh_fast);
+    BLOCK(R1_PTR, takeMVarzh_fast);
   }
 
   SET_INFO(mvar,&EMPTY_MVAR_info);
@@ -808,7 +823,7 @@ FN_(takeMVarZh_fast)
   FE_
 }
 
-FN_(putMVarZh_fast)
+FN_(putMVarzh_fast)
 {
   StgMVar *mvar;
   StgTSO *tso;
@@ -849,13 +864,13 @@ 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 */
@@ -871,3 +886,4 @@ FN_(makeStableNameZh_fast)
 }
 
 #endif /* COMPILER */
+