X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=rts%2FRaiseAsync.c;h=73c4429048eb093a43b3200c36bdaf22d27a4117;hp=bb244d883d7a9bf4f28a94ba0e23eabf4a0115d8;hb=2fa5a66abb8c92a9eb2707317d3c8723e4768e7b;hpb=1ed01a871030f05905a9595e4837dfffc087ef64 diff --git a/rts/RaiseAsync.c b/rts/RaiseAsync.c index bb244d8..73c4429 100644 --- a/rts/RaiseAsync.c +++ b/rts/RaiseAsync.c @@ -17,6 +17,7 @@ #include "Updates.h" #include "STM.h" #include "Sanity.h" +#include "Profiling.h" #if defined(mingw32_HOST_OS) #include "win32/IOManager.h" #endif @@ -852,6 +853,18 @@ raiseAsync(Capability *cap, StgTSO *tso, StgClosure *exception, debugTrace(DEBUG_sched, "raising exception in thread %ld.", (long)tso->id); +#if defined(PROFILING) + /* + * Debugging tool: on raising an exception, show where we are. + * See also Exception.cmm:raisezh_fast. + * This wasn't done for asynchronous exceptions originally; see #1450 + */ + if (RtsFlags.ProfFlags.showCCSOnException) + { + fprintCCS_stderr(tso->prof.CCCS); + } +#endif + // mark it dirty; we're about to change its stack. dirtyTSO(tso);