[project @ 2005-01-28 12:55:17 by simonmar]
[ghc-hetmet.git] / ghc / rts / PrimOps.cmm
index c2f8373..a7ba08a 100644 (file)
@@ -915,47 +915,17 @@ isCurrentThreadBoundzh_fast
 
 // Catch retry frame ------------------------------------------------------------
 
-
-#define CATCH_RETRY_FRAME_ENTRY_TEMPLATE(label,ret)                                       \
-   label                                                                                  \
-   {                                                                                      \
-      W_ r, frame, trec, outer;                                                           \
-      IF_NOT_REG_R1(W_ rval;  rval = Sp(0);  Sp_adj(1); )                                 \
-                                                                                          \
-      frame = Sp;                                                                         \
-      trec = StgTSO_trec(CurrentTSO);                                                     \
-      "ptr" outer = foreign "C" stmGetEnclosingTRec(trec "ptr");                          \
-      r = foreign "C" stmCommitTransaction(trec "ptr");                                   \
-      if (r) {                                                                            \
-        /* Succeeded (either first branch or second branch) */                            \
-        StgTSO_trec(CurrentTSO) = outer;                                                  \
-        Sp = Sp + SIZEOF_StgCatchRetryFrame;                                              \
-        IF_NOT_REG_R1(Sp_adj(-1); Sp(0) = rval;)                                          \
-        jump ret;                                                                         \
-      } else {                                                                            \
-        /* Did not commit: retry */                                                       \
-        W_ new_trec;                                                                      \
-        "ptr" new_trec = foreign "C" stmStartTransaction(outer "ptr");                    \
-        StgTSO_trec(CurrentTSO) = new_trec;                                               \
-        if (StgCatchRetryFrame_running_alt_code(frame)) {                                 \
-          R1 = StgCatchRetryFrame_alt_code(frame);                                        \
-        } else {                                                                          \
-          R1 = StgCatchRetryFrame_first_code(frame);                                      \
-          StgCatchRetryFrame_first_code_trec(frame) = new_trec;                           \
-        }                                                                                 \
-        Sp_adj(-1);                                                                       \
-        jump RET_LBL(stg_ap_v);                                                           \
-      }                                                                                   \
-   }
-
-CATCH_RETRY_FRAME_ENTRY_TEMPLATE(stg_catch_retry_frame_0_ret,%RET_VEC(Sp(SP_OFF),0))
-CATCH_RETRY_FRAME_ENTRY_TEMPLATE(stg_catch_retry_frame_1_ret,%RET_VEC(Sp(SP_OFF),1))
-CATCH_RETRY_FRAME_ENTRY_TEMPLATE(stg_catch_retry_frame_2_ret,%RET_VEC(Sp(SP_OFF),2))
-CATCH_RETRY_FRAME_ENTRY_TEMPLATE(stg_catch_retry_frame_3_ret,%RET_VEC(Sp(SP_OFF),3))
-CATCH_RETRY_FRAME_ENTRY_TEMPLATE(stg_catch_retry_frame_4_ret,%RET_VEC(Sp(SP_OFF),4))
-CATCH_RETRY_FRAME_ENTRY_TEMPLATE(stg_catch_retry_frame_5_ret,%RET_VEC(Sp(SP_OFF),5))
-CATCH_RETRY_FRAME_ENTRY_TEMPLATE(stg_catch_retry_frame_6_ret,%RET_VEC(Sp(SP_OFF),6))
-CATCH_RETRY_FRAME_ENTRY_TEMPLATE(stg_catch_retry_frame_7_ret,%RET_VEC(Sp(SP_OFF),7))
+#define CATCH_RETRY_FRAME_ERROR(label) \
+  label { foreign "C" barf("catch_retry_frame incorrectly entered!"); }
+
+CATCH_RETRY_FRAME_ERROR(stg_catch_retry_frame_0_ret)
+CATCH_RETRY_FRAME_ERROR(stg_catch_retry_frame_1_ret)
+CATCH_RETRY_FRAME_ERROR(stg_catch_retry_frame_2_ret)
+CATCH_RETRY_FRAME_ERROR(stg_catch_retry_frame_3_ret)
+CATCH_RETRY_FRAME_ERROR(stg_catch_retry_frame_4_ret)
+CATCH_RETRY_FRAME_ERROR(stg_catch_retry_frame_5_ret)
+CATCH_RETRY_FRAME_ERROR(stg_catch_retry_frame_6_ret)
+CATCH_RETRY_FRAME_ERROR(stg_catch_retry_frame_7_ret)
 
 #if MAX_VECTORED_RTN > 8
 #error MAX_VECTORED_RTN has changed: please modify stg_catch_retry_frame too.
@@ -980,64 +950,51 @@ INFO_TABLE_RET(stg_catch_retry_frame,
               stg_catch_retry_frame_5_ret,
               stg_catch_retry_frame_6_ret,
               stg_catch_retry_frame_7_ret)
-CATCH_RETRY_FRAME_ENTRY_TEMPLATE(,%ENTRY_CODE(Sp(SP_OFF)))
-
+{
+   W_ r, frame, trec, outer;
+   IF_NOT_REG_R1(W_ rval;  rval = Sp(0);  Sp_adj(1); )
+
+   frame = Sp;
+   trec = StgTSO_trec(CurrentTSO);
+   "ptr" outer = foreign "C" stmGetEnclosingTRec(trec "ptr");
+   r = foreign "C" stmCommitTransaction(trec "ptr");
+   if (r) {
+     /* Succeeded (either first branch or second branch) */
+     StgTSO_trec(CurrentTSO) = outer;
+     Sp = Sp + SIZEOF_StgCatchRetryFrame;
+     IF_NOT_REG_R1(Sp_adj(-1); Sp(0) = rval;)
+     jump %ENTRY_CODE(Sp(SP_OFF));
+   } else {
+     /* Did not commit: retry */
+     W_ new_trec;
+     "ptr" new_trec = foreign "C" stmStartTransaction(outer "ptr");
+     StgTSO_trec(CurrentTSO) = new_trec;
+     if (StgCatchRetryFrame_running_alt_code(frame)) {
+       R1 = StgCatchRetryFrame_alt_code(frame);
+     } else {
+       R1 = StgCatchRetryFrame_first_code(frame);
+       StgCatchRetryFrame_first_code_trec(frame) = new_trec;
+     }
+     Sp_adj(-1);
+     jump RET_LBL(stg_ap_v);
+   }
+}
 
 
 // Atomically frame -------------------------------------------------------------
 
-#define ATOMICALLY_FRAME_ENTRY_TEMPLATE(label,ret)                                       \
-   label                                                                                 \
-   {                                                                                     \
-      W_ frame, trec, valid;                                                             \
-      IF_NOT_REG_R1(W_ rval;  rval = Sp(0);  Sp_adj(1); )                                \
-                                                                                         \
-      frame = Sp;                                                                        \
-      trec = StgTSO_trec(CurrentTSO);                                                    \
-      if (StgAtomicallyFrame_waiting(frame)) {                                           \
-        /* The TSO is currently waiting: should we stop waiting? */                      \
-        valid = foreign "C" stmReWait(trec "ptr");                                       \
-        if (valid) {                                                                     \
-          /* Previous attempt is still valid: no point trying again yet */               \
-          IF_NOT_REG_R1(Sp_adj(-1); Sp(0) = rval;)                                       \
-          jump stg_block_noregs;                                                         \
-        } else {                                                                         \
-          /* Previous attempt is no longer valid: try again */                           \
-          "ptr" trec = foreign "C" stmStartTransaction(NO_TREC "ptr");                   \
-          StgTSO_trec(CurrentTSO) = trec;                                                \
-          StgAtomicallyFrame_waiting(frame) = 0 :: CInt; /* false; */                    \
-          R1 = StgAtomicallyFrame_code(frame);                                           \
-          Sp_adj(-1);                                                                    \
-          jump RET_LBL(stg_ap_v);                                                        \
-        }                                                                                \
-      } else {                                                                           \
-        /* The TSO is not currently waiting: try to commit the transaction */            \
-        valid = foreign "C" stmCommitTransaction(trec "ptr");                            \
-        if (valid) {                                                                     \
-          /* Transaction was valid: commit succeeded */                                  \
-          StgTSO_trec(CurrentTSO) = NO_TREC;                                             \
-          Sp = Sp + SIZEOF_StgAtomicallyFrame;                                           \
-          IF_NOT_REG_R1(Sp_adj(-1); Sp(0) = rval;)                                       \
-          jump ret;                                                                      \
-        } else {                                                                         \
-          /* Transaction was not valid: try again */                                     \
-          "ptr" trec = foreign "C" stmStartTransaction(NO_TREC "ptr");                   \
-          StgTSO_trec(CurrentTSO) = trec;                                                \
-          R1 = StgAtomicallyFrame_code(frame);                                           \
-          Sp_adj(-1);                                                                    \
-          jump RET_LBL(stg_ap_v);                                                        \
-        }                                                                                \
-      }                                                                                  \
-   }
 
-ATOMICALLY_FRAME_ENTRY_TEMPLATE(stg_atomically_frame_0_ret,%RET_VEC(Sp(SP_OFF),0))
-ATOMICALLY_FRAME_ENTRY_TEMPLATE(stg_atomically_frame_1_ret,%RET_VEC(Sp(SP_OFF),1))
-ATOMICALLY_FRAME_ENTRY_TEMPLATE(stg_atomically_frame_2_ret,%RET_VEC(Sp(SP_OFF),2))
-ATOMICALLY_FRAME_ENTRY_TEMPLATE(stg_atomically_frame_3_ret,%RET_VEC(Sp(SP_OFF),3))
-ATOMICALLY_FRAME_ENTRY_TEMPLATE(stg_atomically_frame_4_ret,%RET_VEC(Sp(SP_OFF),4))
-ATOMICALLY_FRAME_ENTRY_TEMPLATE(stg_atomically_frame_5_ret,%RET_VEC(Sp(SP_OFF),5))
-ATOMICALLY_FRAME_ENTRY_TEMPLATE(stg_atomically_frame_6_ret,%RET_VEC(Sp(SP_OFF),6))
-ATOMICALLY_FRAME_ENTRY_TEMPLATE(stg_atomically_frame_7_ret,%RET_VEC(Sp(SP_OFF),7))
+#define ATOMICALLY_FRAME_ERROR(label) \
+  label { foreign "C" barf("atomically_frame incorrectly entered!"); }
+
+ATOMICALLY_FRAME_ERROR(stg_atomically_frame_0_ret)
+ATOMICALLY_FRAME_ERROR(stg_atomically_frame_1_ret)
+ATOMICALLY_FRAME_ERROR(stg_atomically_frame_2_ret)
+ATOMICALLY_FRAME_ERROR(stg_atomically_frame_3_ret)
+ATOMICALLY_FRAME_ERROR(stg_atomically_frame_4_ret)
+ATOMICALLY_FRAME_ERROR(stg_atomically_frame_5_ret)
+ATOMICALLY_FRAME_ERROR(stg_atomically_frame_6_ret)
+ATOMICALLY_FRAME_ERROR(stg_atomically_frame_7_ret)
 
 #if MAX_VECTORED_RTN > 8
 #error MAX_VECTORED_RTN has changed: please modify stg_atomically_frame too.
@@ -1051,6 +1008,7 @@ ATOMICALLY_FRAME_ENTRY_TEMPLATE(stg_atomically_frame_7_ret,%RET_VEC(Sp(SP_OFF),7
 #define ATOMICALLY_FRAME_WORDS  2
 #endif
 
+
 INFO_TABLE_RET(stg_atomically_frame,
               ATOMICALLY_FRAME_WORDS, ATOMICALLY_FRAME_BITMAP,
               ATOMICALLY_FRAME,
@@ -1062,7 +1020,49 @@ INFO_TABLE_RET(stg_atomically_frame,
               stg_atomically_frame_5_ret,
               stg_atomically_frame_6_ret,
               stg_atomically_frame_7_ret)
-ATOMICALLY_FRAME_ENTRY_TEMPLATE(,%ENTRY_CODE(Sp(SP_OFF)))
+{
+   W_ frame, trec, valid;
+   IF_NOT_REG_R1(W_ rval;  rval = Sp(0);  Sp_adj(1); )
+
+   frame = Sp;
+   trec = StgTSO_trec(CurrentTSO);
+   if (StgAtomicallyFrame_waiting(frame)) {
+     /* The TSO is currently waiting: should we stop waiting? */
+     valid = foreign "C" stmReWait(CurrentTSO "ptr");
+     if (valid) {
+       /* Previous attempt is still valid: no point trying again yet */
+         IF_NOT_REG_R1(Sp_adj(-2);
+                       Sp(1) = stg_NO_FINALIZER_closure;
+                       Sp(0) = stg_ut_1_0_unreg_info;)
+       jump stg_block_noregs;
+     } else {
+       /* Previous attempt is no longer valid: try again */
+       "ptr" trec = foreign "C" stmStartTransaction(NO_TREC "ptr");
+       StgTSO_trec(CurrentTSO) = trec;
+       StgAtomicallyFrame_waiting(frame) = 0 :: CInt; /* false; */
+       R1 = StgAtomicallyFrame_code(frame);
+       Sp_adj(-1);
+       jump RET_LBL(stg_ap_v);
+     }
+   } else {
+     /* The TSO is not currently waiting: try to commit the transaction */
+     valid = foreign "C" stmCommitTransaction(trec "ptr");
+     if (valid) {
+       /* Transaction was valid: commit succeeded */
+       StgTSO_trec(CurrentTSO) = NO_TREC;
+       Sp = Sp + SIZEOF_StgAtomicallyFrame;
+       IF_NOT_REG_R1(Sp_adj(-1); Sp(0) = rval;)
+       jump %ENTRY_CODE(Sp(SP_OFF));
+     } else {
+       /* Transaction was not valid: try again */
+       "ptr" trec = foreign "C" stmStartTransaction(NO_TREC "ptr");
+       StgTSO_trec(CurrentTSO) = trec;
+       R1 = StgAtomicallyFrame_code(frame);
+       Sp_adj(-1);
+       jump RET_LBL(stg_ap_v);
+     }
+   }
+}
 
 
 // STM catch frame --------------------------------------------------------------
@@ -1212,7 +1212,7 @@ retryzh_fast
   W_ outer;
   W_ r;
 
-  MAYBE_GC (NO_PTRS, readTVarzh_fast); // STM operations may allocate
+  MAYBE_GC (NO_PTRS, retryzh_fast); // STM operations may allocate
 
   // Find the enclosing ATOMICALLY_FRAME or CATCH_RETRY_FRAME
 retry_pop_stack:
@@ -1240,9 +1240,11 @@ retry_pop_stack:
       other_trec = StgCatchRetryFrame_first_code_trec(frame);
       r = foreign "C" stmMergeForWaiting(trec "ptr", other_trec "ptr");
       if (r) {
+        r = foreign "C" stmCommitTransaction(trec "ptr");
+      }
+      if (r) {
         // Merge between siblings succeeded: commit it back to enclosing transaction
         // and then propagate the retry
-        r = foreign "C" stmCommitTransaction(trec "ptr");
         StgTSO_trec(CurrentTSO) = outer;
         Sp = Sp + SIZEOF_StgCatchRetryFrame;
         goto retry_pop_stack;
@@ -1267,6 +1269,10 @@ retry_pop_stack:
     // Transaction was valid: stmWait put us on the TVars' queues, we now block
     StgAtomicallyFrame_waiting(frame) = 1 :: CInt; // true
     Sp = frame;
+    // Fix up the stack in the unregisterised case: the return convention is different.
+    IF_NOT_REG_R1(Sp_adj(-2); 
+                 Sp(1) = stg_NO_FINALIZER_closure;
+                 Sp(0) = stg_ut_1_0_unreg_info;)
     jump stg_block_noregs;
   } else {
     // Transaction was not valid: retry immediately
@@ -1810,7 +1816,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
@@ -1825,7 +1831,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,
@@ -1872,7 +1878,7 @@ while:
 }
 
 
-#ifdef mingw32_TARGET_OS
+#ifdef mingw32_HOST_OS
 STRING(stg_asyncReadzh_malloc_str, "asyncReadzh_fast")
 asyncReadzh_fast
 {