summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorÖmer Sinan Ağacan <omer@well-typed.com>2019-02-05 00:39:03 -0500
committerBen Gamari <ben@smart-cactus.org>2019-02-21 20:00:01 -0500
commit213c28a7ff4b2e1cfb4b9c91ff6ede5a1909ba43 (patch)
tree6dff381ead0b87ff079069be01462284249ca933
parent1f81ed5a510acc4e6dbef566390e30cae96b8eb7 (diff)
downloadhaskell-213c28a7ff4b2e1cfb4b9c91ff6ede5a1909ba43.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 2f93ba8360..e9659acc13 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: