From 709599a8485aad112c996ed8eb7cf3462525755d Mon Sep 17 00:00:00 2001 From: Simon Marlow Date: Wed, 17 Jan 2007 09:59:44 +0000 Subject: [PATCH] addition to "Eagerly raise a blocked exception" to fix unreg case --- rts/Exception.cmm | 19 +++++++++++++++++++ 1 file changed, 19 insertions(+) diff --git a/rts/Exception.cmm b/rts/Exception.cmm index bf5893e..a3f3dd0 100644 --- a/rts/Exception.cmm +++ b/rts/Exception.cmm @@ -68,6 +68,16 @@ INFO_TABLE_RET( stg_unblockAsyncExceptionszh_ret, * we are about to raise an async exception in the current * thread, which might result in the thread being killed. */ + +#ifndef REG_R1 + /* + * raiseAsync assumes that the stack is in ThreadRunGHC state, + * i.e. with a return address on the top. In unreg mode, the + * return value for IO is on top of the return address, so we + * need to make a small adjustment here. + */ + Sp_adj(1); +#endif SAVE_THREAD_STATE(); r = foreign "C" maybePerformBlockedException (MyCapability() "ptr", CurrentTSO "ptr") [R1]; @@ -82,6 +92,15 @@ INFO_TABLE_RET( stg_unblockAsyncExceptionszh_ret, jump %ENTRY_CODE(Sp(0)); } } +#ifndef REG_R1 + /* + * Readjust stack in unregisterised mode if we didn't raise an + * exception, see above + */ + else { + Sp_adj(-1); + } +#endif } #ifdef REG_R1 -- 1.7.10.4