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-25 11:21:35 -0400 |
commit | 4e5596011c462f530ae0f0444c3aeab416e7bad5 (patch) | |
tree | 3417a8d7a6b9d5b066cd01fcb41f3dda3e764319 | |
parent | 5c373a304ae0ceca89913144ad063534f2f220bd (diff) | |
download | haskell-4e5596011c462f530ae0f0444c3aeab416e7bad5.tar.gz |
rts: Ensure that the interpreter doesn't disregard tags
Previously the interpreter's handling of `RET_BCO` stack frames would
throw away the tag of the returned closure. This resulted in #21390.
(cherry picked from commit 219834d9c27a26ad1d00000c500a6124450ccf32)
-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]); |