From fb8c1b8048e55c161641c7d9797878f553700d1b Mon Sep 17 00:00:00 2001 From: Simon Marlow Date: Wed, 9 Jul 2008 13:53:37 +0000 Subject: [PATCH] add new primop: asyncExceptionsBlocked# :: IO Bool --- compiler/prelude/primops.txt.pp | 5 +++++ includes/StgMiscClosures.h | 1 + rts/Exception.cmm | 9 +++++++++ rts/Linker.c | 1 + 4 files changed, 16 insertions(+) diff --git a/compiler/prelude/primops.txt.pp b/compiler/prelude/primops.txt.pp index f84e00f..302640d 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 59897bc..0aa0703 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 cba5d48..793c9ab 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 27c580b..d1550e1 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) \ -- 1.7.10.4