diff options
| author | Simon Marlow <marlowsd@gmail.com> | 2008-07-09 13:53:37 +0000 |
|---|---|---|
| committer | Simon Marlow <marlowsd@gmail.com> | 2008-07-09 13:53:37 +0000 |
| commit | fb8c1b8048e55c161641c7d9797878f553700d1b (patch) | |
| tree | abb3a84e84b10f47656accfd22ce01f34b79bf2d | |
| parent | 80d2e6f711d54f59c4d698c7565f69d49d34d8b8 (diff) | |
| download | haskell-fb8c1b8048e55c161641c7d9797878f553700d1b.tar.gz | |
add new primop: asyncExceptionsBlocked# :: IO Bool
| -rw-r--r-- | compiler/prelude/primops.txt.pp | 5 | ||||
| -rw-r--r-- | includes/StgMiscClosures.h | 1 | ||||
| -rw-r--r-- | rts/Exception.cmm | 9 | ||||
| -rw-r--r-- | rts/Linker.c | 1 |
4 files changed, 16 insertions, 0 deletions
diff --git a/compiler/prelude/primops.txt.pp b/compiler/prelude/primops.txt.pp index f84e00f566..302640d581 100644 --- 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 59897bca2a..0aa0703d42 100644 --- 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 cba5d48d72..793c9ab149 100644 --- 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 27c580b67f..d1550e1eb5 100644 --- 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) \ |