Fix scoped type variables for expression type signatures
[ghc-hetmet.git] / rts / PrimOps.cmm
index f1c214e..990d6f3 100644 (file)
@@ -138,7 +138,7 @@ unsafeThawArrayzh_fast
   //
   if (StgHeader_info(R1) != stg_MUT_ARR_PTRS_FROZEN0_info) {
        SET_INFO(R1,stg_MUT_ARR_PTRS_DIRTY_info);
-       foreign "C" recordMutableLock(R1 "ptr") [R1];
+       recordMutable(R1, R1);
        // must be done after SET_INFO, because it ASSERTs closure_MUTABLE()
        RET_P(R1);
   } else {
@@ -567,7 +567,7 @@ name                                                                    \
   MP_INT__mp_size(mp_tmp2)  = (s2);                                     \
   MP_INT__mp_d(mp_tmp2)            = BYTE_ARR_CTS(d2);                         \
                                                                         \
-  foreign "C" mpz_init(mp_result1 "ptr") [];                            \
+  foreign "C" __gmpz_init(mp_result1 "ptr") [];                            \
                                                                         \
   /* Perform the operation */                                           \
   foreign "C" mp_fun(mp_result1 "ptr",mp_tmp1  "ptr",mp_tmp2  "ptr") []; \
@@ -594,7 +594,7 @@ name                                                                    \
   MP_INT__mp_size(mp_tmp1)     = (s1);                                 \
   MP_INT__mp_d(mp_tmp1)                = BYTE_ARR_CTS(d1);                     \
                                                                         \
-  foreign "C" mpz_init(mp_result1 "ptr") [];                            \
+  foreign "C" __gmpz_init(mp_result1 "ptr") [];                            \
                                                                         \
   /* Perform the operation */                                           \
   foreign "C" mp_fun(mp_result1 "ptr",mp_tmp1 "ptr") [];                \
@@ -628,8 +628,8 @@ name
   MP_INT__mp_size(mp_tmp2)     = (s2);                                                 \
   MP_INT__mp_d(mp_tmp2)                = BYTE_ARR_CTS(d2);                                     \
                                                                                         \
-  foreign "C" mpz_init(mp_result1 "ptr") [];                                               \
-  foreign "C" mpz_init(mp_result2 "ptr") [];                                               \
+  foreign "C" __gmpz_init(mp_result1 "ptr") [];                                               \
+  foreign "C" __gmpz_init(mp_result2 "ptr") [];                                               \
                                                                                         \
   /* Perform the operation */                                                           \
   foreign "C" mp_fun(mp_result1 "ptr",mp_result2 "ptr",mp_tmp1 "ptr",mp_tmp2 "ptr") [];    \
@@ -640,20 +640,20 @@ name
            MP_INT__mp_d(mp_result2) - SIZEOF_StgArrWords);                              \
 }
 
-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(quotIntegerzh_fast,     mpz_tdiv_q)
-GMP_TAKE2_RET1(remIntegerzh_fast,      mpz_tdiv_r)
-GMP_TAKE2_RET1(divExactIntegerzh_fast, mpz_divexact)
-GMP_TAKE2_RET1(andIntegerzh_fast,      mpz_and)
-GMP_TAKE2_RET1(orIntegerzh_fast,       mpz_ior)
-GMP_TAKE2_RET1(xorIntegerzh_fast,      mpz_xor)
-GMP_TAKE1_RET1(complementIntegerzh_fast, mpz_com)
+GMP_TAKE2_RET1(plusIntegerzh_fast,     __gmpz_add)
+GMP_TAKE2_RET1(minusIntegerzh_fast,    __gmpz_sub)
+GMP_TAKE2_RET1(timesIntegerzh_fast,    __gmpz_mul)
+GMP_TAKE2_RET1(gcdIntegerzh_fast,      __gmpz_gcd)
+GMP_TAKE2_RET1(quotIntegerzh_fast,     __gmpz_tdiv_q)
+GMP_TAKE2_RET1(remIntegerzh_fast,      __gmpz_tdiv_r)
+GMP_TAKE2_RET1(divExactIntegerzh_fast, __gmpz_divexact)
+GMP_TAKE2_RET1(andIntegerzh_fast,      __gmpz_and)
+GMP_TAKE2_RET1(orIntegerzh_fast,       __gmpz_ior)
+GMP_TAKE2_RET1(xorIntegerzh_fast,      __gmpz_xor)
+GMP_TAKE1_RET1(complementIntegerzh_fast, __gmpz_com)
 
-GMP_TAKE2_RET2(quotRemIntegerzh_fast, mpz_tdiv_qr)
-GMP_TAKE2_RET2(divModIntegerzh_fast,  mpz_fdiv_qr)
+GMP_TAKE2_RET2(quotRemIntegerzh_fast, __gmpz_tdiv_qr)
+GMP_TAKE2_RET2(divModIntegerzh_fast,  __gmpz_fdiv_qr)
 
 #ifndef THREADED_RTS
 section "bss" {
@@ -668,7 +668,7 @@ gcdIntzh_fast
     FETCH_MP_TEMP(mp_tmp_w);
 
     W_[mp_tmp_w] = R1;
-    r = foreign "C" mpn_gcd_1(mp_tmp_w "ptr", 1, R2) [];
+    r = foreign "C" __gmpn_gcd_1(mp_tmp_w "ptr", 1, R2) [];
 
     R1 = r;
     /* Result parked in R1, return via info-pointer at TOS */
@@ -679,7 +679,7 @@ gcdIntzh_fast
 gcdIntegerIntzh_fast
 {
     /* R1 = s1; R2 = d1; R3 = the int */
-    R1 = foreign "C" mpn_gcd_1( BYTE_ARR_CTS(R2) "ptr", R1, R3) [];
+    R1 = foreign "C" __gmpn_gcd_1( BYTE_ARR_CTS(R2) "ptr", R1, R3) [];
     
     /* Result parked in R1, return via info-pointer at TOS */
     jump %ENTRY_CODE(Sp(0));
@@ -695,7 +695,7 @@ cmpIntegerIntzh_fast
     vsize = 0;
     v_digit = R3;
 
-    // paraphrased from mpz_cmp_si() in the GMP sources
+    // paraphrased from __gmpz_cmp_si() in the GMP sources
     if (%gt(v_digit,0)) {
        vsize = 1;
     } else { 
@@ -737,7 +737,7 @@ cmpIntegerzh_fast
     W_ usize, vsize, size, up, vp;
     CInt cmp;
 
-    // paraphrased from mpz_cmp() in the GMP sources
+    // paraphrased from __gmpz_cmp() in the GMP sources
     usize = R1;
     vsize = R3;
 
@@ -760,7 +760,7 @@ cmpIntegerzh_fast
     up = BYTE_ARR_CTS(R2);
     vp = BYTE_ARR_CTS(R4);
 
-    cmp = foreign "C" mpn_cmp(up "ptr", vp "ptr", size) [];
+    cmp = foreign "C" __gmpn_cmp(up "ptr", vp "ptr", size) [];
 
     if (cmp == 0 :: CInt) {
        R1 = 0; 
@@ -1005,7 +1005,7 @@ INFO_TABLE_RET(stg_catch_retry_frame,
    trec = StgTSO_trec(CurrentTSO);
    "ptr" outer = foreign "C" stmGetEnclosingTRec(trec "ptr") [];
    r = foreign "C" stmCommitNestedTransaction(MyCapability() "ptr", trec "ptr") [];
-   if (r) {
+   if (r != 0) {
      /* Succeeded (either first branch or second branch) */
      StgTSO_trec(CurrentTSO) = outer;
      Sp = Sp + SIZEOF_StgCatchRetryFrame;
@@ -1016,7 +1016,7 @@ INFO_TABLE_RET(stg_catch_retry_frame,
      W_ new_trec;
      "ptr" new_trec = foreign "C" stmStartTransaction(MyCapability() "ptr", outer "ptr") [];
      StgTSO_trec(CurrentTSO) = new_trec;
-     if (StgCatchRetryFrame_running_alt_code(frame)) {
+     if (StgCatchRetryFrame_running_alt_code(frame) != 0::I32) {
        R1 = StgCatchRetryFrame_alt_code(frame);
      } else {
        R1 = StgCatchRetryFrame_first_code(frame);
@@ -1075,7 +1075,7 @@ INFO_TABLE_RET(stg_atomically_frame,
 
   /* The TSO is not currently waiting: try to commit the transaction */
   valid = foreign "C" stmCommitTransaction(MyCapability() "ptr", trec "ptr") [];
-  if (valid) {
+  if (valid != 0) {
     /* Transaction was valid: commit succeeded */
     StgTSO_trec(CurrentTSO) = NO_TREC;
     Sp = Sp + SIZEOF_StgAtomicallyFrame;
@@ -1109,7 +1109,7 @@ INFO_TABLE_RET(stg_atomically_waiting_frame,
 
   /* The TSO is currently waiting: should we stop waiting? */
   valid = foreign "C" stmReWait(MyCapability() "ptr", CurrentTSO "ptr") [];
-  if (valid) {
+  if (valid != 0) {
     /* Previous attempt is still valid: no point trying again yet */
          IF_NOT_REG_R1(Sp_adj(-2);
                        Sp(1) = stg_NO_FINALIZER_closure;
@@ -1200,7 +1200,7 @@ atomicallyzh_fast
 
   /* Nested transactions are not allowed; raise an exception */
   if (old_trec != NO_TREC) {
-     R1 = GHCziIOBase_NestedAtomically_closure;
+     R1 = base_GHCziIOBase_NestedAtomically_closure;
      jump raisezh_fast;
   }
 
@@ -1295,7 +1295,7 @@ retry_pop_stack:
   if (frame_type == CATCH_RETRY_FRAME) {
     // The retry reaches a CATCH_RETRY_FRAME before the atomic frame
     ASSERT(outer != NO_TREC);
-    if (!StgCatchRetryFrame_running_alt_code(frame)) {
+    if (!StgCatchRetryFrame_running_alt_code(frame) != 0::I32) {
       // Retry in the first code: try the alternative
       "ptr" trec = foreign "C" stmStartTransaction(MyCapability() "ptr", outer "ptr") [];
       StgTSO_trec(CurrentTSO) = trec;
@@ -1307,12 +1307,12 @@ retry_pop_stack:
       W_ other_trec;
       other_trec = StgCatchRetryFrame_first_code_trec(frame);
       r = foreign "C" stmCommitNestedTransaction(MyCapability() "ptr", other_trec "ptr") [];
-      if (r) {
+      if (r != 0) {
         r = foreign "C" stmCommitNestedTransaction(MyCapability() "ptr", trec "ptr") [];
       } else {
         foreign "C" stmAbortTransaction(MyCapability() "ptr", trec "ptr") [];
       }
-      if (r) {
+      if (r != 0) {
         // Merge between siblings succeeded: commit it back to enclosing transaction
         // and then propagate the retry
         StgTSO_trec(CurrentTSO) = outer;
@@ -1334,7 +1334,7 @@ retry_pop_stack:
   ASSERT(frame_type == ATOMICALLY_FRAME);
   ASSERT(outer == NO_TREC);
   r = foreign "C" stmWait(MyCapability() "ptr", CurrentTSO "ptr", trec "ptr") [];
-  if (r) {
+  if (r != 0) {
     // Transaction was valid: stmWait put us on the TVars' queues, we now block
     StgHeader_info(frame) = stg_atomically_waiting_frame_info;
     Sp = frame;
@@ -1522,7 +1522,7 @@ takeMVarzh_fast
       /* actually perform the putMVar for the thread that we just woke up */
       tso = StgMVar_head(mvar);
       PerformPut(tso,StgMVar_value(mvar));
-      foreign "C" dirtyTSO(tso "ptr") [];
+      dirtyTSO(tso);
 
 #if defined(GRAN) || defined(PAR)
       /* ToDo: check 2nd arg (mvar) is right */
@@ -1596,7 +1596,7 @@ tryTakeMVarzh_fast
        /* actually perform the putMVar for the thread that we just woke up */
        tso = StgMVar_head(mvar);
        PerformPut(tso,StgMVar_value(mvar));
-        foreign "C" dirtyTSO(tso "ptr") [];
+        dirtyTSO(tso);
 
 #if defined(GRAN) || defined(PAR)
        /* ToDo: check 2nd arg (mvar) is right */
@@ -1666,7 +1666,7 @@ putMVarzh_fast
        /* actually perform the takeMVar */
        tso = StgMVar_head(mvar);
        PerformTake(tso, R2);
-        foreign "C" dirtyTSO(tso "ptr") [];
+        dirtyTSO(tso);
       
 #if defined(GRAN) || defined(PAR)
        /* ToDo: check 2nd arg (mvar) is right */
@@ -1732,7 +1732,7 @@ tryPutMVarzh_fast
        /* actually perform the takeMVar */
        tso = StgMVar_head(mvar);
        PerformTake(tso, R2);
-        foreign "C" dirtyTSO(tso "ptr") [];
+        dirtyTSO(tso);
       
 #if defined(GRAN) || defined(PAR)
        /* ToDo: check 2nd arg (mvar) is right */
@@ -1975,8 +1975,8 @@ delayzh_fast
 #else
 
     W_ time;
-    time = foreign "C" getourtimeofday();
-    target = (R1 / (TICK_MILLISECS*1000)) + time;
+    time = foreign "C" getourtimeofday() [R1];
+    target = (R1 / (TO_W_(RtsFlags_MiscFlags_tickInterval(RtsFlags))*1000)) + time;
     StgTSO_block_info(CurrentTSO) = target;
 
     /* Insert the new thread in the sleeping queue. */