X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Frts%2FPrimOps.hc;h=efb83c5fa2c92c1241aa1ec1effe8038fe1693bb;hb=e47c7704a86a74638de357b53c398c8d0dec92be;hp=acc47541f9cd0ca10c7d5c4bf3c5230e14834b93;hpb=34a98f40dea6d31ced5213b7810dc39b4989c395;p=ghc-hetmet.git

diff --git a/ghc/rts/PrimOps.hc b/ghc/rts/PrimOps.hc
index acc4754..efb83c5 100644
--- a/ghc/rts/PrimOps.hc
+++ b/ghc/rts/PrimOps.hc
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: PrimOps.hc,v 1.58 2000/11/13 14:40:37 simonmar Exp $
+ * $Id: PrimOps.hc,v 1.69 2001/01/25 13:30:31 simonmar Exp $
  *
  * (c) The GHC Team, 1998-2000
  *
@@ -27,13 +27,13 @@
    classes CCallable and CReturnable don't really exist, but the
    compiler insists on generating dictionaries containing references
    to GHC_ZcCCallable_static_info etc., so we provide dummy symbols
-   for these.
+   for these.  Some C compilers can't cope with zero-length static arrays,
+   so we have to make these one element long.
 */
 
-W_ GHC_ZCCCallable_static_info[0];
-W_ GHC_ZCCReturnable_static_info[0];
-
-
+StgWord GHC_ZCCCallable_static_info[1];
+StgWord GHC_ZCCReturnable_static_info[1];
+  
 /* -----------------------------------------------------------------------------
    Macros for Hand-written primitives.
    -------------------------------------------------------------------------- */
@@ -244,15 +244,14 @@ W_ GHC_ZCCReturnable_static_info[0];
 
 #define BYTES_TO_STGWORDS(n) ((n) + sizeof(W_) - 1)/sizeof(W_)
 
-#define newByteArray(ty,scale)				\
- FN_(new##ty##Arrayzh_fast)				\
+FN_(newByteArrayzh_fast)				\
  {							\
-   W_ stuff_size, size, n;				\
+   W_ size, stuff_size, n;				\
    StgArrWords* p;					\
    FB_							\
-     MAYBE_GC(NO_PTRS,new##ty##Arrayzh_fast);		\
+     MAYBE_GC(NO_PTRS,newByteArrayzh_fast);		\
      n = R1.w;						\
-     stuff_size = BYTES_TO_STGWORDS(n*scale);		\
+     stuff_size = BYTES_TO_STGWORDS(n);			\
      size = sizeofW(StgArrWords)+ stuff_size;		\
      p = (StgArrWords *)RET_STGCALL1(P_,allocate,size);	\
      TICK_ALLOC_PRIM(sizeofW(StgArrWords),stuff_size,0); \
@@ -263,15 +262,6 @@ W_ GHC_ZCCReturnable_static_info[0];
    FE_							\
  }
 
-newByteArray(Char,   1)
-/* Char arrays really contain only 8-bit bytes for compatibility. */
-newByteArray(Int,    sizeof(I_))
-newByteArray(Word,   sizeof(W_))
-newByteArray(Addr,   sizeof(P_))
-newByteArray(Float,  sizeof(StgFloat))
-newByteArray(Double, sizeof(StgDouble))
-newByteArray(StablePtr, sizeof(StgStablePtr))
-
 FN_(newArrayzh_fast)
 {
   W_ size, n, init;
@@ -981,17 +971,12 @@ FN_(putMVarzh_fast)
     if (mvar->head == (StgTSO *)&stg_END_TSO_QUEUE_closure) {
       mvar->tail = (StgTSO *)&stg_END_TSO_QUEUE_closure;
     }
-
-    /* unlocks the MVar in the SMP case */
-    SET_INFO(mvar,&stg_FULL_MVAR_info);
-
-    /* yield, to give the newly woken thread a chance to take the MVar */
-    JMP_(stg_yield_noregs);
   }
 
   /* unlocks the MVar in the SMP case */
   SET_INFO(mvar,&stg_FULL_MVAR_info);
 
+  /* ToDo: yield here for better communication performance? */
   JMP_(ENTRY_CODE(Sp[0]));
   FE_
 }
@@ -1028,6 +1013,58 @@ FN_(makeStableNamezh_fast)
 }
 
 /* -----------------------------------------------------------------------------
+   Bytecode object primitives
+   -------------------------------------------------------------------------  */
+
+#ifdef GHCI
+FN_(newBCOzh_fast)
+{
+  /* R1.p = instrs
+     R2.p = literals
+     R3.p = ptrs
+     R4.p = itbls
+  */
+  StgBCO *bco;
+  FB_
+
+  HP_CHK_GEN_TICKY(sizeofW(StgBCO),R1_PTR|R2_PTR|R3_PTR|R4_PTR, newBCOzh_fast,);
+  TICK_ALLOC_PRIM(sizeofW(StgHeader), sizeofW(StgBCO)-sizeofW(StgHeader), 0);
+  CCS_ALLOC(CCCS,sizeofW(StgBCO)); /* ccs prof */
+  bco = (StgBCO *) (Hp + 1 - sizeofW(StgBCO));
+  SET_HDR(bco, &stg_BCO_info, CCCS);
+
+  bco->instrs     = (StgArrWords*)R1.cl;
+  bco->literals   = (StgArrWords*)R2.cl;
+  bco->ptrs       = (StgMutArrPtrs*)R3.cl;
+  bco->itbls      = (StgArrWords*)R4.cl;
+
+  TICK_RET_UNBOXED_TUP(1);
+  RET_P(bco);
+  FE_
+}
+
+FN_(mkApUpd0zh_fast)
+{
+  /* R1.p = the fn for the AP_UPD
+  */
+  StgAP_UPD* ap;
+  FB_
+  HP_CHK_GEN_TICKY(AP_sizeW(0), R1_PTR, mkApUpd0zh_fast,);
+  TICK_ALLOC_PRIM(sizeofW(StgHeader), AP_sizeW(0)-sizeofW(StgHeader), 0);
+  CCS_ALLOC(CCCS,AP_sizeW(0)); /* ccs prof */
+  ap = (StgAP_UPD *) (Hp + 1 - AP_sizeW(0));
+  SET_HDR(ap, &stg_AP_UPD_info, CCCS);
+
+  ap->n_args = 0;
+  ap->fun = R1.cl;
+
+  TICK_RET_UNBOXED_TUP(1);
+  RET_P(ap);
+  FE_
+}
+#endif
+
+/* -----------------------------------------------------------------------------
    Thread I/O blocking primitives
    -------------------------------------------------------------------------- */
 
@@ -1070,7 +1107,7 @@ FN_(delayzh_fast)
 
     ACQUIRE_LOCK(&sched_mutex);
 
-    target = (R1.i / (TICK_MILLISECS*1000)) + timestamp + ticks_since_timestamp;
+    target = (R1.i / (TICK_MILLISECS*1000)) + getourtimeofday();
     CurrentTSO->block_info.target = target;
 
     /* Insert the new thread in the sleeping queue. */