add new primop: asyncExceptionsBlocked# :: IO Bool

diff --git a/compiler/prelude/primops.txt.pp b/compiler/prelude/primops.txt.pp
index f84e00f..302640d 100644 (file)
--- a/compiler/prelude/primops.txt.pp
+++ b/compiler/prelude/primops.txt.pp
@@ -1279,6 +1279,11 @@ primop  UnblockAsyncExceptionsOp "unblockAsyncExceptions#" GenPrimOp
    with
    out_of_line = True
 
+primop  AsyncExceptionsBlockedOp "asyncExceptionsBlocked#" GenPrimOp
+        State# RealWorld -> (# State# RealWorld, Int# #)
+   with
+   out_of_line = True
+
 ------------------------------------------------------------------------
 section "STM-accessible Mutable Variables"
 ------------------------------------------------------------------------

diff --git a/includes/StgMiscClosures.h b/includes/StgMiscClosures.h
index 59897bc..0aa0703 100644 (file)
--- a/includes/StgMiscClosures.h
+++ b/includes/StgMiscClosures.h
@@ -579,6 +579,7 @@ RTS_FUN(forkzh_fast);
 RTS_FUN(forkOnzh_fast);
 RTS_FUN(yieldzh_fast);
 RTS_FUN(killThreadzh_fast);
+RTS_FUN(asyncExceptionsBlockedzh_fast);
 RTS_FUN(blockAsyncExceptionszh_fast);
 RTS_FUN(unblockAsyncExceptionszh_fast);
 RTS_FUN(myThreadIdzh_fast);

diff --git a/rts/Exception.cmm b/rts/Exception.cmm
index cba5d48..793c9ab 100644 (file)
--- a/rts/Exception.cmm
+++ b/rts/Exception.cmm
@@ -200,6 +200,15 @@ unblockAsyncExceptionszh_fast
     jump stg_ap_v_fast;
 }
 
+asyncExceptionsBlockedzh_fast
+{
+    /* args: none */
+    if ((TO_W_(StgTSO_flags(CurrentTSO)) & TSO_BLOCKEX) != 0) {
+        RET_N(1);
+    } else {
+        RET_N(0);
+    }
+}
 
 killThreadzh_fast
 {

diff --git a/rts/Linker.c b/rts/Linker.c
index 27c580b..d1550e1 100644 (file)
--- a/rts/Linker.c
+++ b/rts/Linker.c
@@ -547,6 +547,7 @@ typedef struct _RtsSymbolVal {
       SymX(barf)                               \
       SymX(debugBelch)                         \
       SymX(errorBelch)                         \
+      SymX(asyncExceptionsBlockedzh_fast)      \
       SymX(blockAsyncExceptionszh_fast)                \
       SymX(catchzh_fast)                       \
       SymX(catchRetryzh_fast)                  \