diff options
author | Ömer Sinan Ağacan <omer@well-typed.com> | 2019-02-05 00:39:03 -0500 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2019-03-05 22:28:45 -0500 |
commit | c19a401db45148873a7b6ba575384d2e77807647 (patch) | |
tree | a22629edd55286ba71a5f70156b320320f24b203 | |
parent | 23342e1f06204a4853a6b191bf0960d2c2baf457 (diff) | |
download | haskell-c19a401db45148873a7b6ba575384d2e77807647.tar.gz |
rts/Printer: Print forwarding pointers
-rw-r--r-- | rts/Printer.c | 11 |
1 files changed, 8 insertions, 3 deletions
diff --git a/rts/Printer.c b/rts/Printer.c index 38335aa963..f4d1111892 100644 --- a/rts/Printer.c +++ b/rts/Printer.c @@ -111,10 +111,15 @@ printThunkObject( StgThunk *obj, char* tag ) void printClosure( const StgClosure *obj ) { - const StgInfoTable *info; - + debugBelch("%p: ", obj); obj = UNTAG_CONST_CLOSURE(obj); - info = get_itbl(obj); + const StgInfoTable* info = get_itbl(obj); + + while (IS_FORWARDING_PTR(info)) { + obj = (StgClosure*)UN_FORWARDING_PTR(obj); + debugBelch("(forwarding to %p) ", (void*)obj); + info = get_itbl(obj); + } switch ( info->type ) { case INVALID_OBJECT: |