diff options
author | Ben Gamari <ben@smart-cactus.org> | 2022-04-14 16:15:34 -0400 |
---|---|---|
committer | Ben Gamari <ben@smart-cactus.org> | 2022-04-14 17:02:57 -0400 |
commit | 219834d9c27a26ad1d00000c500a6124450ccf32 (patch) | |
tree | c549decc2e55d5a83a0cbe63af8d661ced6c2c7f | |
parent | 06690e1bece1115d83d8ffe11c2bb1db45f4ab52 (diff) | |
download | haskell-wip/T21390.tar.gz |
rts: Ensure that the interpreter doesn't disregard tagswip/T21390
Previously the interpreter's handling of `RET_BCO` stack frames would
throw away the tag of the returned closure. This resulted in #21390.
-rw-r--r-- | rts/Interpreter.c | 8 |
1 files changed, 4 insertions, 4 deletions
diff --git a/rts/Interpreter.c b/rts/Interpreter.c index 8c2195b6e9..e2b17075bc 100644 --- a/rts/Interpreter.c +++ b/rts/Interpreter.c @@ -626,9 +626,7 @@ do_return: // the stack, and start executing the BCO. INTERP_TICK(it_retto_BCO); Sp_subW(1); - SpW(0) = (W_)obj; - // NB. return the untagged object; the bytecode expects it to - // be untagged. XXX this doesn't seem right. + SpW(0) = (W_)tagged_obj; obj = (StgClosure*)SpW(2); ASSERT(get_itbl(obj)->type == BCO); goto run_BCO_return; @@ -1675,7 +1673,8 @@ run_BCO: Sp_subW(1); // No write barrier is needed here as this is a new allocation // visible only from our stack - SET_HDR(con, (StgInfoTable*)BCO_LIT(o_itbl), cap->r.rCCCS); + StgInfoTable *con_itbl = (StgInfoTable*) BCO_LIT(o_itbl); + SET_HDR(con, con_itbl, cap->r.rCCCS); // Note [Data constructor dynamic tags] // ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -2000,6 +1999,7 @@ run_BCO: // it might have moved during the call. Also reload the // pointers to the components of the BCO. obj = (StgClosure*)SpW(1); + // N.B. this is a BCO and therefore is by definition not tagged bco = (StgBCO*)obj; instrs = (StgWord16*)(bco->instrs->payload); literals = (StgWord*)(&bco->literals->payload[0]); |