Fix GHCi on PowerPC OS X

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

diff --git a/rts/PrimOps.cmm b/rts/PrimOps.cmm
index 075da41..e0823e4 100644 (file)
--- a/rts/PrimOps.cmm
+++ b/rts/PrimOps.cmm
@@ -418,12 +418,15 @@ int64ToIntegerzh_fast
    /* arguments: L1 = Int64# */
 
    L_ val;
-   W_ hi, s, neg, words_needed, p;
+   W_ hi, lo, s, neg, words_needed, p;
 
    val = L1;
    neg = 0;
 
-   if ( %ge(val,0x100000000::L_) || %le(val,-0x100000000::L_) )  { 
+   hi = TO_W_(val >> 32);
+   lo = TO_W_(val);
+
+   if ( hi != 0 && hi != 0xFFFFFFFF )  { 
        words_needed = 2;
    } else { 
        // minimum is one word
@@ -437,21 +440,24 @@ int64ToIntegerzh_fast
    SET_HDR(p, stg_ARR_WORDS_info, W_[CCCS]);
    StgArrWords_words(p) = words_needed;
 
-   if ( %lt(val,0::L_) ) {
+   if ( %lt(hi,0) ) {
      neg = 1;
-     val = -val;
+     lo = -lo;
+     if(lo == 0) {
+       hi = -hi;
+     } else {
+       hi = -hi - 1;
+     }
    }
 
-   hi = TO_W_(val >> 32);
-
    if ( words_needed == 2 )  { 
       s = 2;
-      Hp(-1) = TO_W_(val);
+      Hp(-1) = lo;
       Hp(0) = hi;
    } else { 
-       if ( val != 0::L_ ) {
+       if ( lo != 0 ) {
           s = 1;
-          Hp(0) = TO_W_(val);
+          Hp(0) = lo;
        } else /* val==0 */  {
           s = 0;
        }
@@ -465,16 +471,18 @@ int64ToIntegerzh_fast
    */
    RET_NP(s,p);
 }
-
 word64ToIntegerzh_fast
 {
    /* arguments: L1 = Word64# */
 
    L_ val;
-   W_ hi, s, words_needed, p;
+   W_ hi, lo, s, words_needed, p;
 
    val = L1;
-   if ( val >= 0x100000000::L_ ) {
+   hi = TO_W_(val >> 32);
+   lo = TO_W_(val);
+
+   if ( hi != 0 ) {
       words_needed = 2;
    } else {
       words_needed = 1;
@@ -487,15 +495,14 @@ word64ToIntegerzh_fast
    SET_HDR(p, stg_ARR_WORDS_info, W_[CCCS]);
    StgArrWords_words(p) = words_needed;
 
-   hi = TO_W_(val >> 32);
-   if ( val >= 0x100000000::L_ ) { 
+   if ( hi != 0 ) { 
      s = 2;
-     Hp(-1) = TO_W_(val);
+     Hp(-1) = lo;
      Hp(0)  = hi;
    } else {
-      if ( val != 0::L_ ) {
+      if ( lo != 0 ) {
         s = 1;
-        Hp(0) = TO_W_(val);
+        Hp(0) = lo;
      } else /* val==0 */  {
       s = 0;
      }
@@ -508,6 +515,7 @@ word64ToIntegerzh_fast
 }
 
 
+
 #endif /* SUPPORT_LONG_LONGS */
 
 /* ToDo: this is shockingly inefficient */
@@ -1953,6 +1961,55 @@ mkApUpd0zh_fast
     RET_P(ap);
 }
 
+infoPtrzh_fast
+{
+/* args: R1 = closure to analyze */
+   
+  MAYBE_GC(R1_PTR, infoPtrzh_fast);
+
+  W_ info;
+  info = %GET_STD_INFO(R1);
+  RET_N(info);
+}
+
+closurePayloadzh_fast
+{
+/* args: R1 = closure to analyze */
+// TODO: Consider the absence of ptrs or nonptrs as a special case ?
+
+    MAYBE_GC(R1_PTR, closurePayloadzh_fast);
+
+    W_ info, ptrs, nptrs, p, ptrs_arr, nptrs_arr;
+    info  = %GET_STD_INFO(R1);
+    ptrs  = TO_W_(%INFO_PTRS(info)); 
+    nptrs = TO_W_(%INFO_NPTRS(info));
+    p = 0;
+
+    ALLOC_PRIM (SIZEOF_StgMutArrPtrs + WDS(ptrs), R1_PTR, closurePayloadzh_fast);
+    ptrs_arr = Hp - SIZEOF_StgMutArrPtrs - WDS(ptrs) + WDS(1);
+    SET_HDR(ptrs_arr, stg_MUT_ARR_PTRS_FROZEN_info, W_[CCCS]);
+    StgMutArrPtrs_ptrs(ptrs_arr) = ptrs;
+for:
+    if(p < ptrs) {
+        W_[ptrs_arr + SIZEOF_StgMutArrPtrs + WDS(p)] = StgClosure_payload(R1,p);
+        p = p + 1;
+        goto for;
+    }
+    
+    ALLOC_PRIM (SIZEOF_StgArrWords + WDS(nptrs), R1_PTR, closurePayloadzh_fast);
+    nptrs_arr = Hp - SIZEOF_StgArrWords - WDS(nptrs) + WDS(1);
+    SET_HDR(nptrs_arr, stg_ARR_WORDS_info, W_[CCCS]);
+    StgArrWords_words(nptrs_arr) = nptrs;
+    p = 0;
+for2:
+    if(p < nptrs) {
+        W_[BYTE_ARR_CTS(nptrs_arr) + WDS(p)] = StgClosure_payload(R1, p+ptrs);
+        p = p + 1;
+        goto for2;
+    }
+    RET_PP(ptrs_arr, nptrs_arr);
+}
+
 /* -----------------------------------------------------------------------------
    Thread I/O blocking primitives
    -------------------------------------------------------------------------- */
@@ -2044,8 +2101,11 @@ delayzh_fast
 #else
 
     W_ time;
+    W_ divisor;
     time = foreign "C" getourtimeofday() [R1];
-    target = (R1 / (TO_W_(RtsFlags_MiscFlags_tickInterval(RtsFlags))*1000)) + time;
+    divisor = TO_W_(RtsFlags_MiscFlags_tickInterval(RtsFlags))*1000;
+    target = ((R1 + divisor - 1) / divisor) /* divide rounding up */
+           + time + 1; /* Add 1 as getourtimeofday rounds down */
     StgTSO_block_info(CurrentTSO) = target;
 
     /* Insert the new thread in the sleeping queue. */