summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorBen Gamari <ben@smart-cactus.org>2022-04-14 16:15:34 -0400
committerBen Gamari <ben@smart-cactus.org>2022-04-14 17:02:57 -0400
commit219834d9c27a26ad1d00000c500a6124450ccf32 (patch)
treec549decc2e55d5a83a0cbe63af8d661ced6c2c7f
parent06690e1bece1115d83d8ffe11c2bb1db45f4ab52 (diff)
downloadhaskell-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.c8
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]);