diff options
author | Ben Gamari <ben@smart-cactus.org> | 2022-04-14 16:15:34 -0400 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2022-04-15 13:56:34 -0400 |
commit | d8392f6a714b5646d43ed54eee0d028f714da717 (patch) | |
tree | 6763deb260416fb21fb6a9ecb77d4ce555302890 | |
parent | 96b9e5ea93f7a70b6481182652e4433f53cd244b (diff) | |
download | haskell-d8392f6a714b5646d43ed54eee0d028f714da717.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.
-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]); |