Added compiler/cmm/Dataflow.hs

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

diff --git a/rts/PrimOps.cmm b/rts/PrimOps.cmm
index bb9fadd..800f93e 100644 (file)
--- a/rts/PrimOps.cmm
+++ b/rts/PrimOps.cmm
@@ -1533,7 +1533,7 @@ takeMVarzh_fast
       }
 
 #if defined(THREADED_RTS)
-      foreign "C" unlockClosure(mvar "ptr", stg_FULL_MVAR_info) [];
+      unlockClosure(mvar, stg_FULL_MVAR_info);
 #endif
       RET_P(val);
   } 
@@ -1543,7 +1543,7 @@ takeMVarzh_fast
       StgMVar_value(mvar) = stg_END_TSO_QUEUE_closure;
  
 #if defined(THREADED_RTS)
-      foreign "C" unlockClosure(mvar "ptr", stg_EMPTY_MVAR_info) [];
+      unlockClosure(mvar, stg_EMPTY_MVAR_info);
 #else
       SET_INFO(mvar,stg_EMPTY_MVAR_info);
 #endif
@@ -1569,7 +1569,7 @@ tryTakeMVarzh_fast
 
     if (info == stg_EMPTY_MVAR_info) {
 #if defined(THREADED_RTS)
-        foreign "C" unlockClosure(mvar "ptr", stg_EMPTY_MVAR_info) [];
+        unlockClosure(mvar, stg_EMPTY_MVAR_info);
 #endif
        /* HACK: we need a pointer to pass back, 
         * so we abuse NO_FINALIZER_closure
@@ -1606,7 +1606,7 @@ tryTakeMVarzh_fast
            StgMVar_tail(mvar) = stg_END_TSO_QUEUE_closure;
        }
 #if defined(THREADED_RTS)
-        foreign "C" unlockClosure(mvar "ptr", stg_FULL_MVAR_info) [];
+        unlockClosure(mvar, stg_FULL_MVAR_info);
 #endif
     }
     else 
@@ -1614,7 +1614,7 @@ tryTakeMVarzh_fast
        /* No further putMVars, MVar is now empty */
        StgMVar_value(mvar) = stg_END_TSO_QUEUE_closure;
 #if defined(THREADED_RTS)
-       foreign "C" unlockClosure(mvar "ptr", stg_EMPTY_MVAR_info) [];
+       unlockClosure(mvar, stg_EMPTY_MVAR_info);
 #else
        SET_INFO(mvar,stg_EMPTY_MVAR_info);
 #endif
@@ -1676,7 +1676,7 @@ putMVarzh_fast
        }
 
 #if defined(THREADED_RTS)
-       foreign "C" unlockClosure(mvar "ptr", stg_EMPTY_MVAR_info) [];
+       unlockClosure(mvar, stg_EMPTY_MVAR_info);
 #endif
        jump %ENTRY_CODE(Sp(0));
     }
@@ -1686,7 +1686,7 @@ putMVarzh_fast
        StgMVar_value(mvar) = R2;
 
 #if defined(THREADED_RTS)
-       foreign "C" unlockClosure(mvar "ptr", stg_FULL_MVAR_info) [];
+       unlockClosure(mvar, stg_FULL_MVAR_info);
 #else
        SET_INFO(mvar,stg_FULL_MVAR_info);
 #endif
@@ -1712,7 +1712,7 @@ tryPutMVarzh_fast
 
     if (info == stg_FULL_MVAR_info) {
 #if defined(THREADED_RTS)
-       foreign "C" unlockClosure(mvar "ptr", stg_FULL_MVAR_info) [];
+       unlockClosure(mvar, stg_FULL_MVAR_info);
 #endif
        RET_N(0);
     }
@@ -1742,7 +1742,7 @@ tryPutMVarzh_fast
        }
 
 #if defined(THREADED_RTS)
-       foreign "C" unlockClosure(mvar "ptr", stg_EMPTY_MVAR_info) [];
+       unlockClosure(mvar, stg_EMPTY_MVAR_info);
 #endif
     }
     else
@@ -1751,7 +1751,7 @@ tryPutMVarzh_fast
        StgMVar_value(mvar) = R2;
 
 #if defined(THREADED_RTS)
-       foreign "C" unlockClosure(mvar "ptr", stg_FULL_MVAR_info) [];
+       unlockClosure(mvar, stg_FULL_MVAR_info);
 #else
        SET_INFO(mvar,stg_FULL_MVAR_info);
 #endif
@@ -1884,8 +1884,6 @@ unpackClosurezh_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));
 
     // Some closures have non-standard layout, so we omit those here.
     W_ type;
@@ -1903,6 +1901,8 @@ unpackClosurezh_fast
         goto out;
     }
     default: {
+        ptrs  = TO_W_(%INFO_PTRS(info)); 
+        nptrs = TO_W_(%INFO_NPTRS(info));
         goto out;
     }}
 out:
@@ -2165,13 +2165,18 @@ noDuplicatezh_fast
 
 getApStackValzh_fast
 {
-   W_ ap_stack, offset, val;
+   W_ ap_stack, offset, val, ok;
 
-   /* args: R1 = tso, R2 = offset */
+   /* args: R1 = AP_STACK, R2 = offset */
    ap_stack = R1;
    offset   = R2;
 
-   val = StgClosure_payload(ap_stack,offset); 
-
-   RET_P(val);
+   if (%INFO_PTR(ap_stack) == stg_AP_STACK_info) {
+        ok = 1;
+        val = StgAP_STACK_payload(ap_stack,offset); 
+   } else {
+        ok = 0;
+        val = R1;
+   }
+   RET_NP(ok,val);
 }