diff options
| -rw-r--r-- | rts/Exception.cmm | 4 | ||||
| -rw-r--r-- | rts/Profiling.c | 24 | ||||
| -rw-r--r-- | rts/Profiling.h | 2 | ||||
| -rw-r--r-- | rts/RaiseAsync.c | 2 |
4 files changed, 27 insertions, 5 deletions
diff --git a/rts/Exception.cmm b/rts/Exception.cmm index 9f48f5d8f5..586086ebf3 100644 --- a/rts/Exception.cmm +++ b/rts/Exception.cmm @@ -427,7 +427,9 @@ stg_raisezh */ if (RtsFlags_ProfFlags_showCCSOnException(RtsFlags) != 0::I32) { SAVE_THREAD_STATE(); - foreign "C" fprintCCS_stderr(W_[CCCS] "ptr", CurrentTSO "ptr") []; + foreign "C" fprintCCS_stderr(W_[CCCS] "ptr", + exception "ptr", + CurrentTSO "ptr") []; LOAD_THREAD_STATE(); } #endif diff --git a/rts/Profiling.c b/rts/Profiling.c index c75a344c7f..38191ff4bd 100644 --- a/rts/Profiling.c +++ b/rts/Profiling.c @@ -17,6 +17,7 @@ #include "ProfHeap.h" #include "Arena.h" #include "RetainerProfile.h" +#include "Printer.h" #include <string.h> @@ -1001,7 +1002,7 @@ static rtsBool fprintCallStack (CostCentreStack *ccs) /* For calling from .cmm code, where we can't reliably refer to stderr */ void -fprintCCS_stderr (CostCentreStack *ccs, StgTSO *tso) +fprintCCS_stderr (CostCentreStack *ccs, StgClosure *exception, StgTSO *tso) { rtsBool is_caf; StgPtr frame; @@ -1010,7 +1011,26 @@ fprintCCS_stderr (CostCentreStack *ccs, StgTSO *tso) nat depth = 0; const nat MAX_DEPTH = 10; // don't print gigantic chains of stacks - fprintf(stderr, "*** Exception raised (reporting due to +RTS -xc), stack trace:\n "); + { + char *desc; + StgInfoTable *info; + info = get_itbl(exception); + switch (info->type) { + case CONSTR: + case CONSTR_1_0: + case CONSTR_0_1: + case CONSTR_2_0: + case CONSTR_1_1: + case CONSTR_0_2: + case CONSTR_STATIC: + case CONSTR_NOCAF_STATIC: + desc = GET_CON_DESC(itbl_to_con_itbl(info)); + default: + desc = closure_type_names[info->type]; + } + fprintf(stderr, "*** Exception (reporting due to +RTS -xc): (%s), stack trace: \n ", desc); + } + is_caf = fprintCallStack(ccs); // traverse the stack down to the enclosing update frame to diff --git a/rts/Profiling.h b/rts/Profiling.h index 2ee3311c81..8c365220fb 100644 --- a/rts/Profiling.h +++ b/rts/Profiling.h @@ -35,7 +35,7 @@ void reportCCSProfiling ( void ); void PrintNewStackDecls ( void ); void fprintCCS( FILE *f, CostCentreStack *ccs ); -void fprintCCS_stderr (CostCentreStack *ccs, StgTSO *tso); +void fprintCCS_stderr (CostCentreStack *ccs, StgClosure *exception, StgTSO *tso); #ifdef DEBUG void debugCCS( CostCentreStack *ccs ); diff --git a/rts/RaiseAsync.c b/rts/RaiseAsync.c index acc87b1938..c7b10b856e 100644 --- a/rts/RaiseAsync.c +++ b/rts/RaiseAsync.c @@ -739,7 +739,7 @@ raiseAsync(Capability *cap, StgTSO *tso, StgClosure *exception, */ if (RtsFlags.ProfFlags.showCCSOnException) { - fprintCCS_stderr(tso->prof.CCCS,tso); + fprintCCS_stderr(tso->prof.CCCS,exception,tso); } #endif // ASSUMES: the thread is not already complete or dead |