[project @ 2002-06-26 08:18:38 by stolz]

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

diff --git a/ghc/rts/PrimOps.hc b/ghc/rts/PrimOps.hc
index ef07664..44bedf6 100644 (file)
--- a/ghc/rts/PrimOps.hc
+++ b/ghc/rts/PrimOps.hc
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: PrimOps.hc,v 1.93 2002/02/28 18:44:29 sof Exp $
+ * $Id: PrimOps.hc,v 1.99 2002/06/26 08:18:41 stolz Exp $
  *
  * (c) The GHC Team, 1998-2000
  *
@@ -244,40 +244,57 @@ StgWord GHC_ZCCReturnable_static_info[1];
 
 #define BYTES_TO_STGWORDS(n) ((n) + sizeof(W_) - 1)/sizeof(W_)
 
-FN_(newByteArrayzh_fast)                               \
- {                                                     \
-   W_ size, stuff_size, n;                             \
-   StgArrWords* p;                                     \
-   FB_                                                 \
-     MAYBE_GC(NO_PTRS,newByteArrayzh_fast);            \
-     n = R1.w;                                         \
-     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); \
-     SET_HDR(p, &stg_ARR_WORDS_info, CCCS);            \
-     p->words = stuff_size;                            \
-     TICK_RET_UNBOXED_TUP(1)                           \
-     RET_P(p);                                         \
-   FE_                                                 \
+FN_(newByteArrayzh_fast)
+ {
+   W_ size, stuff_size, n;
+   StgArrWords* p;
+   FB_
+     MAYBE_GC(NO_PTRS,newByteArrayzh_fast);
+     n = R1.w;
+     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);
+     SET_HDR(p, &stg_ARR_WORDS_info, CCCS);
+     p->words = stuff_size;
+     TICK_RET_UNBOXED_TUP(1)
+     RET_P(p);
+   FE_
  }
 
-FN_(newPinnedByteArrayzh_fast)                                 \
- {                                                             \
-   W_ size, stuff_size, n;                                     \
-   StgArrWords* p;                                             \
-   FB_                                                         \
-     MAYBE_GC(NO_PTRS,newPinnedByteArrayzh_fast);              \
-     n = R1.w;                                                 \
-     stuff_size = BYTES_TO_STGWORDS(n);                                \
-     size = sizeofW(StgArrWords)+ stuff_size;                  \
-     p = (StgArrWords *)RET_STGCALL1(P_,allocatePinned,size);  \
-     TICK_ALLOC_PRIM(sizeofW(StgArrWords),stuff_size,0);       \
-     SET_HDR(p, &stg_ARR_WORDS_info, CCCS);                    \
-     p->words = stuff_size;                                    \
-     TICK_RET_UNBOXED_TUP(1)                                   \
-     RET_P(p);                                                 \
-   FE_                                                         \
+FN_(newPinnedByteArrayzh_fast)
+ {
+   W_ size, stuff_size, n;
+   StgArrWords* p;
+   FB_
+     MAYBE_GC(NO_PTRS,newPinnedByteArrayzh_fast);
+     n = R1.w;
+     stuff_size = BYTES_TO_STGWORDS(n);
+
+     // We want an 8-byte aligned array.  allocatePinned() gives us
+     // 8-byte aligned memory by default, but we want to align the
+     // *goods* inside the ArrWords object, so we have to check the
+     // size of the ArrWords header and adjust our size accordingly.
+     size = sizeofW(StgArrWords)+ stuff_size;
+     if ((sizeof(StgArrWords) & 7) != 0) {
+        size++;
+     }
+
+     p = (StgArrWords *)RET_STGCALL1(P_,allocatePinned,size);
+     TICK_ALLOC_PRIM(sizeofW(StgArrWords),stuff_size,0);
+
+     // Again, if the ArrWords header isn't a multiple of 8 bytes, we
+     // have to push the object forward one word so that the goods
+     // fall on an 8-byte boundary.
+     if ((sizeof(StgArrWords) & 7) != 0) {
+        ((StgPtr)p)++;
+     }
+
+     SET_HDR(p, &stg_ARR_WORDS_info, CCCS);
+     p->words = stuff_size;
+     TICK_RET_UNBOXED_TUP(1)
+     RET_P(p);
+   FE_
  }
 
 FN_(newArrayzh_fast)
@@ -791,7 +808,10 @@ FN_(gcdIntegerIntzh_fast)
   I_ r;
   FB_
   r = RET_STGCALL3(StgInt,mpn_gcd_1,(mp_limb_t *)(BYTE_ARR_CTS(R2.p)), R1.i, R3.i);
-  RET_N(r);
+
+  R1.i = r;
+  /* Result parked in R1, return via info-pointer at TOS */
+  JMP_(ENTRY_CODE(Sp[0]));
   FE_
 }
 
@@ -1002,7 +1022,22 @@ FN_(forkzh_fast)
   /* switch at the earliest opportunity */ 
   context_switch = 1;
   
-  RET_N(R1.t);
+  RET_P(R1.t);
+  FE_
+}
+
+FN_(forkProcesszh_fast)
+{
+  pid_t pid;
+
+  FB_
+  /* args: none */
+  /* result: Pid */
+
+  R1.i = RET_STGCALL1(StgInt, forkProcess, CurrentTSO);
+
+  JMP_(ENTRY_CODE(Sp[0]));
+
   FE_
 }
 
@@ -1017,11 +1052,22 @@ FN_(myThreadIdzh_fast)
 {
   /* no args. */
   FB_
-  RET_N((P_)CurrentTSO);
+  RET_P((P_)CurrentTSO);
   FE_
 }
 
-
+FN_(labelThreadzh_fast)
+{
+  FB_
+  /* args: 
+       R1.p = ThreadId#
+       R2.p = Addr# */
+#ifdef DEBUG
+  STGCALL2(labelThread,(StgTSO *)R1.p,(char *)R2.p);
+#endif
+  JMP_(ENTRY_CODE(Sp[0]));
+  FE_
+}
 
 
 /* -----------------------------------------------------------------------------
@@ -1089,10 +1135,19 @@ FN_(newMVarzh_fast)
   FE_
 }
 
-#define PerformTake(tso, value) ({                     \
-    (tso)->sp[1] = (W_)value;                          \
+/* If R1 isn't available, pass it on the stack */
+#ifdef REG_R1
+#define PerformTake(tso, value) ({             \
+    (tso)->sp[1] = (W_)value;                  \
     (tso)->sp[0] = (W_)&stg_gc_unpt_r1_info;   \
   })
+#else
+#define PerformTake(tso, value) ({             \
+    (tso)->sp[1] = (W_)value;                  \
+    (tso)->sp[0] = (W_)&stg_ut_1_0_unreg_info; \
+  })
+#endif
+
 
 #define PerformPut(tso) ({                             \
     StgClosure *val = (StgClosure *)(tso)->sp[2];      \