[project @ 2005-04-24 21:50:26 by simonmar]

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

diff --git a/ghc/rts/PrimOps.cmm b/ghc/rts/PrimOps.cmm
index a7ba08a..2d306f6 100644 (file)
--- a/ghc/rts/PrimOps.cmm
+++ b/ghc/rts/PrimOps.cmm
@@ -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) {
+  if (%INFO_TYPE(%GET_STD_INFO(R1)) != HALF_W_(MUT_ARR_PTRS_FROZEN0)) {
        foreign "C" recordMutable(R1 "ptr");
   }
 
+  SET_INFO(R1,stg_MUT_ARR_PTRS_info);
+
   RET_P(R1);
 }
 
@@ -162,6 +166,10 @@ atomicModifyMutVarzh_fast
     W_ mv, z, x, y, r;
     /* Args: R1 :: MutVar#,  R2 :: a -> (a,b) */
 
+#if defined(SMP)
+    foreign "C" ACQUIRE_LOCK(sm_mutex "ptr");
+#endif
+
     /* If x is the current contents of the MutVar#, then 
        We want to make the new contents point to
 
@@ -179,18 +187,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
 
@@ -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" fprintf(W_[stderr] "ptr",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;
@@ -1661,15 +1673,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 +1702,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);
 }