diff options
author | Ömer Sinan Ağacan <omer@well-typed.com> | 2019-02-05 00:39:03 -0500 |
---|---|---|
committer | Ben Gamari <ben@smart-cactus.org> | 2019-02-21 20:00:01 -0500 |
commit | 213c28a7ff4b2e1cfb4b9c91ff6ede5a1909ba43 (patch) | |
tree | 6dff381ead0b87ff079069be01462284249ca933 | |
parent | 1f81ed5a510acc4e6dbef566390e30cae96b8eb7 (diff) | |
download | haskell-213c28a7ff4b2e1cfb4b9c91ff6ede5a1909ba43.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 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: |