summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorÖmer Sinan Ağacan <omer@well-typed.com>2019-02-05 00:39:03 -0500
committerMarge Bot <ben+marge-bot@smart-cactus.org>2019-03-05 22:28:45 -0500
commitc19a401db45148873a7b6ba575384d2e77807647 (patch)
treea22629edd55286ba71a5f70156b320320f24b203
parent23342e1f06204a4853a6b191bf0960d2c2baf457 (diff)
downloadhaskell-c19a401db45148873a7b6ba575384d2e77807647.tar.gz
rts/Printer: Print forwarding pointers
-rw-r--r--rts/Printer.c11
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: