[project @ 2005-04-27 14:25:17 by simonmar]
[ghc-hetmet.git] / ghc / rts / PrimOps.cmm
index c647b48..ff1b442 100644 (file)
@@ -118,8 +118,6 @@ newArrayzh_fast
 
 unsafeThawArrayzh_fast
 {
-  SET_INFO(R1,stg_MUT_ARR_PTRS_info);
-
   // SUBTLETY TO DO WITH THE OLD GEN MUTABLE LIST
   //
   // A MUT_ARR_PTRS lives on the mutable list, but a MUT_ARR_PTRS_FROZEN 
@@ -127,15 +125,21 @@ unsafeThawArrayzh_fast
   // it on the mutable list for the GC to remove (removing something from
   // the mutable list is not easy, because the mut_list is only singly-linked).
   // 
+  // So that we can tell whether a MUT_ARR_PTRS_FROZEN is on the mutable list,
+  // when we freeze it we set the info ptr to be MUT_ARR_PTRS_FROZEN0 to indicate
+  // that it is still on the mutable list.
+
   // So, when we thaw a MUT_ARR_PTRS_FROZEN, we must cope with two cases:
   // either it is on a mut_list, or it isn't.  We adopt the convention that
   // the mut_link field is NULL if it isn't on a mut_list, and the GC
   // maintains this invariant.
   //
-  if (StgMutClosure_mut_link(R1) == NULL) {
-       foreign "C" recordMutable(R1 "ptr");
+  if (%INFO_TYPE(%GET_STD_INFO(R1)) != HALF_W_(MUT_ARR_PTRS_FROZEN0)) {
+       foreign "C" recordMutableLock(R1 "ptr");
   }
 
+  SET_INFO(R1,stg_MUT_ARR_PTRS_info);
+
   RET_P(R1);
 }
 
@@ -179,18 +183,18 @@ atomicModifyMutVarzh_fast
     */
 
 #if MIN_UPD_SIZE > 1
-#define THUNK_1_SIZE (SIZEOF_StgHeader + WDS(MIN_UPD_SIZE))
+#define THUNK_1_SIZE (SIZEOF_StgThunkHeader + WDS(MIN_UPD_SIZE))
 #define TICK_ALLOC_THUNK_1() TICK_ALLOC_UP_THK(WDS(1),WDS(MIN_UPD_SIZE-1))
 #else
-#define THUNK_1_SIZE (SIZEOF_StgHeader + WDS(1))
+#define THUNK_1_SIZE (SIZEOF_StgThunkHeader + WDS(1))
 #define TICK_ALLOC_THUNK_1() TICK_ALLOC_UP_THK(WDS(1),0)
 #endif
 
 #if MIN_UPD_SIZE > 2
-#define THUNK_2_SIZE (SIZEOF_StgHeader + WDS(MIN_UPD_SIZE))
+#define THUNK_2_SIZE (SIZEOF_StgThunkHeader + WDS(MIN_UPD_SIZE))
 #define TICK_ALLOC_THUNK_2() TICK_ALLOC_UP_THK(WDS(2),WDS(MIN_UPD_SIZE-2))
 #else
-#define THUNK_2_SIZE (SIZEOF_StgHeader + WDS(2))
+#define THUNK_2_SIZE (SIZEOF_StgThunkHeader + WDS(2))
 #define TICK_ALLOC_THUNK_2() TICK_ALLOC_UP_THK(WDS(2),0)
 #endif
 
@@ -198,6 +202,10 @@ atomicModifyMutVarzh_fast
 
    HP_CHK_GEN_TICKY(SIZE, R1_PTR & R2_PTR, atomicModifyMutVarzh_fast);
 
+#if defined(SMP)
+    foreign "C" ACQUIRE_LOCK(sm_mutex "ptr");
+#endif
+
    x = StgMutVar_var(R1);
 
    TICK_ALLOC_THUNK_2();
@@ -205,15 +213,15 @@ atomicModifyMutVarzh_fast
    z = Hp - THUNK_2_SIZE + WDS(1);
    SET_HDR(z, stg_ap_2_upd_info, W_[CCCS]);
    LDV_RECORD_CREATE(z);
-   StgClosure_payload(z,0) = R2;
-   StgClosure_payload(z,1) = x;
+   StgThunk_payload(z,0) = R2;
+   StgThunk_payload(z,1) = x;
 
    TICK_ALLOC_THUNK_1();
    CCCS_ALLOC(THUNK_1_SIZE);
    y = z - THUNK_1_SIZE;
    SET_HDR(y, stg_sel_0_upd_info, W_[CCCS]);
    LDV_RECORD_CREATE(y);
-   StgClosure_payload(y,0) = z;
+   StgThunk_payload(y,0) = z;
 
    StgMutVar_var(R1) = y;
 
@@ -222,7 +230,11 @@ atomicModifyMutVarzh_fast
    r = y - THUNK_1_SIZE;
    SET_HDR(r, stg_sel_1_upd_info, W_[CCCS]);
    LDV_RECORD_CREATE(r);
-   StgClosure_payload(r,0) = z;
+   StgThunk_payload(r,0) = z;
+
+#if defined(SMP)
+    foreign "C" RELEASE_LOCK(sm_mutex "ptr");
+#endif
 
    RET_P(r);
 }
@@ -277,7 +289,7 @@ mkWeakzh_fast
   StgWeak_link(w)      = W_[weak_ptr_list];
   W_[weak_ptr_list]    = w;
 
-  IF_DEBUG(weak, foreign "C" fprintf(stderr,stg_weak_msg,w));
+  IF_DEBUG(weak, foreign "C" debugBelch(stg_weak_msg,w));
 
   RET_P(w);
 }
@@ -1137,7 +1149,7 @@ atomicallyzh_fast
   Sp = Sp - SIZEOF_StgAtomicallyFrame;
   frame = Sp;
 
-  SET_HDR(frame,stg_atomically_frame_info,CCCS);
+  SET_HDR(frame,stg_atomically_frame_info, W_[CCCS]);
   StgAtomicallyFrame_waiting(frame) = 0 :: CInt; // False
   StgAtomicallyFrame_code(frame) = R1;
 
@@ -1164,7 +1176,7 @@ catchSTMzh_fast
   Sp = Sp - SIZEOF_StgCatchSTMFrame;
   frame = Sp;
 
-  SET_HDR(frame, stg_catch_stm_frame_info, CCCS);
+  SET_HDR(frame, stg_catch_stm_frame_info, W_[CCCS]);
   StgCatchSTMFrame_handler(frame) = R2;
 
   /* Apply R1 to the realworld token */
@@ -1192,7 +1204,7 @@ catchRetryzh_fast
   Sp = Sp - SIZEOF_StgCatchRetryFrame;
   frame = Sp;
   
-  SET_HDR(frame, stg_catch_retry_frame_info, CCCS);
+  SET_HDR(frame, stg_catch_retry_frame_info, W_[CCCS]);
   StgCatchRetryFrame_running_alt_code(frame) = 0 :: CInt; // false;
   StgCatchRetryFrame_first_code(frame) = R1;
   StgCatchRetryFrame_alt_code(frame) = R2;
@@ -1417,6 +1429,10 @@ takeMVarzh_fast
 {
     W_ mvar, val, info, tso;
 
+#if defined(SMP)
+    foreign "C" ACQUIRE_LOCK(sm_mutex "ptr");
+#endif
+
     /* args: R1 = MVar closure */
     mvar = R1;
 
@@ -1436,6 +1452,10 @@ takeMVarzh_fast
        StgTSO_block_info(CurrentTSO)  = mvar;
        StgMVar_tail(mvar) = CurrentTSO;
        
+#if defined(SMP)
+       foreign "C" RELEASE_LOCK(sm_mutex "ptr");
+#endif
+
        jump stg_block_takemvar;
   }
 
@@ -1464,6 +1484,11 @@ takeMVarzh_fast
       if (StgMVar_head(mvar) == stg_END_TSO_QUEUE_closure) {
          StgMVar_tail(mvar) = stg_END_TSO_QUEUE_closure;
       }
+
+#if defined(SMP)
+      foreign "C" RELEASE_LOCK(sm_mutex "ptr");
+#endif
+
       RET_P(val);
   } 
   else
@@ -1475,6 +1500,11 @@ takeMVarzh_fast
        */
       SET_INFO(mvar,stg_EMPTY_MVAR_info);
       StgMVar_value(mvar) = stg_END_TSO_QUEUE_closure;
+
+#if defined(SMP)
+      foreign "C" RELEASE_LOCK(sm_mutex "ptr");
+#endif
+
       RET_P(val);
   }
 }
@@ -1484,6 +1514,10 @@ tryTakeMVarzh_fast
 {
     W_ mvar, val, info, tso;
 
+#if defined(SMP)
+    foreign "C" ACQUIRE_LOCK(sm_mutex "ptr");
+#endif
+
     /* args: R1 = MVar closure */
 
     mvar = R1;
@@ -1494,6 +1528,9 @@ tryTakeMVarzh_fast
        /* HACK: we need a pointer to pass back, 
         * so we abuse NO_FINALIZER_closure
         */
+#if defined(SMP)
+       foreign "C" RELEASE_LOCK(sm_mutex "ptr");
+#endif
        RET_NP(0, stg_NO_FINALIZER_closure);
     }
 
@@ -1527,13 +1564,13 @@ tryTakeMVarzh_fast
     {
        /* No further putMVars, MVar is now empty */
        StgMVar_value(mvar) = stg_END_TSO_QUEUE_closure;
-       
-       /* do this last... we might have locked the MVar in the SMP case,
-        * and writing the info pointer will unlock it.
-        */
        SET_INFO(mvar,stg_EMPTY_MVAR_info);
     }
     
+#if defined(SMP)
+    foreign "C" RELEASE_LOCK(sm_mutex "ptr");
+#endif
+
     RET_NP(1, val);
 }
 
@@ -1542,6 +1579,10 @@ putMVarzh_fast
 {
     W_ mvar, info, tso;
 
+#if defined(SMP)
+    foreign "C" ACQUIRE_LOCK(sm_mutex "ptr");
+#endif
+
     /* args: R1 = MVar, R2 = value */
     mvar = R1;
 
@@ -1558,6 +1599,9 @@ putMVarzh_fast
        StgTSO_block_info(CurrentTSO)  = mvar;
        StgMVar_tail(mvar) = CurrentTSO;
        
+#if defined(SMP)
+       foreign "C" RELEASE_LOCK(sm_mutex "ptr");
+#endif
        jump stg_block_putmvar;
     }
   
@@ -1583,6 +1627,9 @@ putMVarzh_fast
            StgMVar_tail(mvar) = stg_END_TSO_QUEUE_closure;
        }
 
+#if defined(SMP)
+       foreign "C" RELEASE_LOCK(sm_mutex "ptr");
+#endif
        jump %ENTRY_CODE(Sp(0));
     }
     else
@@ -1591,6 +1638,10 @@ putMVarzh_fast
        StgMVar_value(mvar) = R2;
        /* unlocks the MVar in the SMP case */
        SET_INFO(mvar,stg_FULL_MVAR_info);
+
+#if defined(SMP)
+       foreign "C" RELEASE_LOCK(sm_mutex "ptr");
+#endif
        jump %ENTRY_CODE(Sp(0));
     }
     
@@ -1602,12 +1653,19 @@ tryPutMVarzh_fast
 {
     W_ mvar, info, tso;
 
+#if defined(SMP)
+    foreign "C" ACQUIRE_LOCK(sm_mutex "ptr");
+#endif
+
     /* args: R1 = MVar, R2 = value */
     mvar = R1;
 
     info = GET_INFO(mvar);
 
     if (info == stg_FULL_MVAR_info) {
+#if defined(SMP)
+       foreign "C" RELEASE_LOCK(sm_mutex "ptr");
+#endif
        RET_N(0);
     }
   
@@ -1633,6 +1691,9 @@ tryPutMVarzh_fast
            StgMVar_tail(mvar) = stg_END_TSO_QUEUE_closure;
        }
 
+#if defined(SMP)
+       foreign "C" RELEASE_LOCK(sm_mutex "ptr");
+#endif
        jump %ENTRY_CODE(Sp(0));
     }
     else
@@ -1641,6 +1702,9 @@ tryPutMVarzh_fast
        StgMVar_value(mvar) = R2;
        /* unlocks the MVar in the SMP case */
        SET_INFO(mvar,stg_FULL_MVAR_info);
+#if defined(SMP)
+       foreign "C" RELEASE_LOCK(sm_mutex "ptr");
+#endif
        jump %ENTRY_CODE(Sp(0));
     }
     
@@ -1661,15 +1725,15 @@ makeStableNamezh_fast
     index = foreign "C" lookupStableName(R1 "ptr");
 
     /* Is there already a StableName for this heap object?
-     *  stable_ptr_table is an array of snEntry structs.
+     *  stable_ptr_table is a pointer to an array of snEntry structs.
      */
-    if ( snEntry_sn_obj(stable_ptr_table + index*SIZEOF_snEntry) == NULL ) {
+    if ( snEntry_sn_obj(W_[stable_ptr_table] + index*SIZEOF_snEntry) == NULL ) {
        sn_obj = Hp - SIZEOF_StgStableName + WDS(1);
        SET_HDR(sn_obj, stg_STABLE_NAME_info, W_[CCCS]);
        StgStableName_sn(sn_obj) = index;
-       snEntry_sn_obj(stable_ptr_table + index*SIZEOF_snEntry) = sn_obj;
+       snEntry_sn_obj(W_[stable_ptr_table] + index*SIZEOF_snEntry) = sn_obj;
     } else {
-       sn_obj = snEntry_sn_obj(stable_ptr_table + index*SIZEOF_snEntry);
+       sn_obj = snEntry_sn_obj(W_[stable_ptr_table] + index*SIZEOF_snEntry);
     }
     
     RET_P(sn_obj);
@@ -1690,7 +1754,7 @@ deRefStablePtrzh_fast
     /* Args: R1 = the stable ptr */
     W_ r, sp;
     sp = R1;
-    r = snEntry_addr(stable_ptr_table + sp*SIZEOF_snEntry);
+    r = snEntry_addr(W_[stable_ptr_table] + sp*SIZEOF_snEntry);
     RET_P(r);
 }
 
@@ -1816,7 +1880,7 @@ waitWritezh_fast
 STRING(stg_delayzh_malloc_str, "delayzh_fast")
 delayzh_fast
 {
-#ifdef mingw32_TARGET_OS
+#ifdef mingw32_HOST_OS
     W_ ares;
     CInt reqID;
 #else
@@ -1831,7 +1895,7 @@ delayzh_fast
     ASSERT(StgTSO_why_blocked(CurrentTSO) == NotBlocked::I16);
     StgTSO_why_blocked(CurrentTSO) = BlockedOnDelay::I16;
 
-#ifdef mingw32_TARGET_OS
+#ifdef mingw32_HOST_OS
 
     /* could probably allocate this on the heap instead */
     "ptr" ares = foreign "C" stgMallocBytes(SIZEOF_StgAsyncIOResult,
@@ -1878,7 +1942,7 @@ while:
 }
 
 
-#ifdef mingw32_TARGET_OS
+#ifdef mingw32_HOST_OS
 STRING(stg_asyncReadzh_malloc_str, "asyncReadzh_fast")
 asyncReadzh_fast
 {